* Helper for reproviding stuff from srfi/N/... subdirectories

* Switch srfi/1 and a few other packages (and optionals.ss) to
  scheme/base
* Make srfi/1 etc reprovide `filter' from scheme/private/list
* Organize a few modules that were unnecessarily providing a full
  language.
* srfi/45 reprovides stuff from scheme/promise (see comments in
  "srfi/45/lazy.ss")

svn: r8999

collects/srfi/1.ss

@@ -1,14 +1,2 @@
 ;; module loader for SRFI-1
-(module |1| mzscheme
+#lang s-exp srfi/provider srfi/1/list #:unprefix s:
-  
-  (require srfi/1/list)
-  
-  (provide (all-from-except srfi/1/list
-                            s:map s:for-each
-                            s:member
-                            s:assoc)
-	   (rename s:map map)
-	   (rename s:for-each for-each)
-	   (rename s:member member)
-	   (rename s:assoc assoc)))
-			    

collects/srfi/1/filter.ss

@@ -36,7 +36,8 @@
 
 (require srfi/optional "predicate.ss")
 
-(provide (rename-out [my-filter filter] [my-filter filter!])
+(provide filter (rename-out [filter filter!])
+         (rename-out [my-filter filter-with-sharing]) ; see comment below
          partition (rename-out [partition partition!])
          (rename-out [my-remove remove] [my-remove remove!]))
 
@@ -45,6 +46,13 @@
 ;; FILTER, REMOVE, PARTITION and their destructive counterparts do not
 ;; disorder the elements of their argument.
 
+;; The following version of filter is not really needed, so we reprovide the
+;; one from "scheme/private/list.ss".  That one does not keep the longest tail,
+;; but running a few benchmarks (on v3.99.0.18) shows that on long lists the
+;; code below is slower, and on short lists it is a little faster, but not by
+;; much.  However, seems that "lset.ss" relies on tail-sharing, so it is
+;; provided under an alternative name above.
+
 ;; This FILTER shares the longest tail of L that has no deleted
 ;; elements.  If Scheme had multi-continuation calls, they could be
 ;; made more efficient.

collects/srfi/1/list.ss

@@ -220,7 +220,7 @@
          "misc.ss"
          (rename-in "fold.ss" [map s:map] [for-each s:for-each])
          (rename-in "search.ss" [member s:member])
-         (rename-in "filter.ss" [filter s:filter] [remove s:remove])
+         (rename-in "filter.ss" [remove s:remove])
          "delete.ss"
          (rename-in "alist.ss" [assoc s:assoc])
          "lset.ss")
@@ -231,8 +231,7 @@
          (all-from-out "misc.ss")
          (all-from-out "fold.ss")
          (all-from-out "search.ss")
-         (except-out (all-from-out "filter.ss") s:filter)
+         (all-from-out "filter.ss")
-         (rename-out [s:filter filter])
          (all-from-out "delete.ss")
          (all-from-out "alist.ss")
          (all-from-out "lset.ss"))

collects/srfi/1/lset.ss

@@ -39,7 +39,7 @@
          (except-in "fold.ss" map for-each)
          "delete.ss"
          "predicate.ss"
-         (except-in "filter.ss" remove filter))
+         (only-in "filter.ss" [filter-with-sharing s:filter] partition))
 
 (provide lset<=
          lset=

collects/srfi/11.ss

@@ -1,3 +1,3 @@
 ;; Supported by core PLT:
-(module |11| mzscheme
+#lang scheme/base
-  (provide let-values let*-values))
+(provide let-values let*-values)

collects/srfi/13.ss

@@ -1,10 +1,2 @@
 ;; module loader for SRFI-13
-(module |13| mzscheme
+#lang s-exp srfi/provider srfi/13/string #:unprefix s:
-  (require srfi/13/string)
-  (provide (all-from-except srfi/13/string
-			    s:string-upcase s:string-downcase s:string-titlecase)
-	   (rename s:string-upcase string-upcase)
-	   (rename s:string-downcase string-downcase)
-	   (rename s:string-titlecase string-titlecase)))
-
-

collects/srfi/14.ss

@@ -1,4 +1,2 @@
 ;; module loader for SRFI-14
-(module |14| mzscheme
+#lang s-exp srfi/provider srfi/14/char-set
-  (require srfi/14/char-set)
-  (provide (all-from srfi/14/char-set)))

collects/srfi/16.ss

@@ -1,3 +1,3 @@
 ;; Supported by core PLT:
-(module |16| mzscheme
+#lang scheme/base
-  (provide case-lambda))
+(provide case-lambda)

collects/srfi/17.ss

@@ -1,6 +1,2 @@
 ;; module loader for SRFI-17
-(module |17| mzscheme
+#lang s-exp srfi/provider srfi/17/set #:unprefix s:
-  (require (all-except srfi/17/set set!)
-	   (rename srfi/17/set my-set! set!))
-  (provide (all-from-except srfi/17/set my-set!)
-	   (rename my-set! set!)))

collects/srfi/17/set.ss

@@ -7,8 +7,8 @@
 ;;;
 ;;; Based on the implementation for Scheme48.
 
-(module set mzscheme
+#lang scheme/base
-  (provide (rename my-set! set!)
+(provide (rename-out [my-set! s:set!])
          setter
          set-setter!
          getter-with-setter)
@@ -93,4 +93,3 @@
         (cons cddddr (cdr-setter cdddr))
 |#
         ))
-  )

collects/srfi/18.ss

@@ -1,4 +1,3 @@
 ;; Supported by core PLT:
-(module |18| mzscheme
+#lang scheme/base
 (provide thread)
-  )

collects/srfi/19.ss

@@ -1,23 +1,2 @@
 ;; module loader for SRFI-19
-(module |19| mzscheme
+#lang s-exp srfi/provider srfi/19/time #:unprefix srfi:
-  (require srfi/19/time)
-  (provide (all-from-except srfi/19/time
-                            make-srfi:date srfi:date?
-                            srfi:date-second 
-                            srfi:date-minute 
-                            srfi:date-hour 
-                            srfi:date-day 
-                            srfi:date-month
-                            srfi:date-year 
-                            srfi:date-year-day
-                            srfi:date-week-day)
-           (rename make-srfi:date make-date)
-           (rename srfi:date? date?)
-           (rename srfi:date-second date-second)
-           (rename srfi:date-minute date-minute)
-           (rename srfi:date-hour date-hour)
-           (rename srfi:date-day date-day)
-           (rename srfi:date-month date-month)
-           (rename srfi:date-year date-year)
-           (rename srfi:date-year-day date-year-day)
-           (rename srfi:date-week-day date-week-day)))

collects/srfi/19/tests.ss

@@ -97,33 +97,33 @@
      (test-case
       "TAI-Date Conversions"
       (check tm:date= (time-tai->date (make-time time-tai 0 (+ 915148800 29)) 0)
-             (make-srfi:date 0 58 59 23 31 12 1998 0))
+             (srfi:make-date 0 58 59 23 31 12 1998 0))
       (check tm:date= (time-tai->date (make-time time-tai 0 (+ 915148800 30)) 0)
-             (make-srfi:date 0 59 59 23 31 12 1998 0))
+             (srfi:make-date 0 59 59 23 31 12 1998 0))
       (check tm:date= (time-tai->date (make-time time-tai 0 (+ 915148800 31)) 0)
-             (make-srfi:date 0 60 59 23 31 12 1998 0))
+             (srfi:make-date 0 60 59 23 31 12 1998 0))
       (check tm:date= (time-tai->date (make-time time-tai 0 (+ 915148800 32)) 0)
-             (make-srfi:date 0 0 0 0 1 1 1999 0)))
+             (srfi:make-date 0 0 0 0 1 1 1999 0)))
 
      (test-case 
       "Date-UTC Conversions"
       (check time=? (make-time time-utc 0 (- 915148800 2))
-             (date->time-utc (make-srfi:date 0 58 59 23 31 12 1998 0)))
+             (date->time-utc (srfi:make-date 0 58 59 23 31 12 1998 0)))
       (check time=? (make-time time-utc 0 (- 915148800 1))
-             (date->time-utc (make-srfi:date 0 59 59 23 31 12 1998 0)))
+             (date->time-utc (srfi:make-date 0 59 59 23 31 12 1998 0)))
       ;; yes, I think this is actually right.
       (check time=? (make-time time-utc 0 (- 915148800 0))
-             (date->time-utc (make-srfi:date 0 60 59 23 31 12 1998 0)))
+             (date->time-utc (srfi:make-date 0 60 59 23 31 12 1998 0)))
       (check time=? (make-time time-utc 0 (- 915148800 0))
-             (date->time-utc (make-srfi:date 0 0 0 0 1 1 1999 0)))
+             (date->time-utc (srfi:make-date 0 0 0 0 1 1 1999 0)))
       (check time=? (make-time time-utc 0 (+ 915148800 1))
-             (date->time-utc (make-srfi:date 0 1 0 0 1 1 1999 0))))
+             (date->time-utc (srfi:make-date 0 1 0 0 1 1 1999 0))))
 
      (test-case 
       "TZ Offset conversions"
       (let ((ct-utc (make-time time-utc 6320000 1045944859))
             (ct-tai (make-time time-tai 6320000 1045944891))
-            (cd (make-srfi:date 6320000 19 14 15 22 2 2003 -18000)))
+            (cd (srfi:make-date 6320000 19 14 15 22 2 2003 -18000)))
         (check time=? ct-utc (date->time-utc cd))
         (check time=? ct-tai (date->time-tai cd))))
 
@@ -132,7 +132,7 @@
      ;; to change the test case to match the implementation...
      (test-case
       "date->string conversions"
-      (check-equal? (date->string (make-srfi:date 1000 2 3 4 5 6 2007 (* 60 -120))
+      (check-equal? (date->string (srfi:make-date 1000 2 3 4 5 6 2007 (* 60 -120))
                                   "~~ @ ~a @ ~A @ ~b @ ~B @ ~c @ ~d @ ~D @ ~e @ ~f @ ~h @ ~H")
                     "~ @ Tue @ Tuesday @ Jun @ June @ Tue Jun 05 04:03:02-0200 2007 @ 05 @ 06/05/07 @  5 @ 02.000001 @ Jun @ 04"))
      
@@ -140,49 +140,49 @@
 
      (test-case
       "[DJG] date->string conversions of dates with nanosecond components"
-      (check-equal? (date->string (make-srfi:date 123456789 2 3 4 5 6 2007 0) "~N") "123456789")
+      (check-equal? (date->string (srfi:make-date 123456789 2 3 4 5 6 2007 0) "~N") "123456789")
-      (check-equal? (date->string (make-srfi:date 12345678  2 3 4 5 6 2007 0) "~N") "012345678")
+      (check-equal? (date->string (srfi:make-date 12345678  2 3 4 5 6 2007 0) "~N") "012345678")
-      (check-equal? (date->string (make-srfi:date 1234567   2 3 4 5 6 2007 0) "~N") "001234567")
+      (check-equal? (date->string (srfi:make-date 1234567   2 3 4 5 6 2007 0) "~N") "001234567")
-      (check-equal? (date->string (make-srfi:date 123456    2 3 4 5 6 2007 0) "~N") "000123456")
+      (check-equal? (date->string (srfi:make-date 123456    2 3 4 5 6 2007 0) "~N") "000123456")
-      (check-equal? (date->string (make-srfi:date 12345     2 3 4 5 6 2007 0) "~N") "000012345")
+      (check-equal? (date->string (srfi:make-date 12345     2 3 4 5 6 2007 0) "~N") "000012345")
-      (check-equal? (date->string (make-srfi:date 1234      2 3 4 5 6 2007 0) "~N") "000001234")
+      (check-equal? (date->string (srfi:make-date 1234      2 3 4 5 6 2007 0) "~N") "000001234")
-      (check-equal? (date->string (make-srfi:date 123       2 3 4 5 6 2007 0) "~N") "000000123")
+      (check-equal? (date->string (srfi:make-date 123       2 3 4 5 6 2007 0) "~N") "000000123")
-      (check-equal? (date->string (make-srfi:date 12        2 3 4 5 6 2007 0) "~N") "000000012")
+      (check-equal? (date->string (srfi:make-date 12        2 3 4 5 6 2007 0) "~N") "000000012")
-      (check-equal? (date->string (make-srfi:date 1         2 3 4 5 6 2007 0) "~N") "000000001"))
+      (check-equal? (date->string (srfi:make-date 1         2 3 4 5 6 2007 0) "~N") "000000001"))
       
       (test-case
       "[DJG] string->date conversions of dates with nanosecond components"
-      (check-equal? (string->date "12:00:00.123456789" "~H:~M:~S.~N") (make-srfi:date 123456789 0 0 12 #t #t #t 0) "check 1")
+      (check-equal? (string->date "12:00:00.123456789" "~H:~M:~S.~N") (srfi:make-date 123456789 0 0 12 #t #t #t 0) "check 1")
-      (check-equal? (string->date "12:00:00.12345678"  "~H:~M:~S.~N") (make-srfi:date 123456780 0 0 12 #t #t #t 0) "check 2")
+      (check-equal? (string->date "12:00:00.12345678"  "~H:~M:~S.~N") (srfi:make-date 123456780 0 0 12 #t #t #t 0) "check 2")
-      (check-equal? (string->date "12:00:00.1234567"   "~H:~M:~S.~N") (make-srfi:date 123456700 0 0 12 #t #t #t 0) "check 3")
+      (check-equal? (string->date "12:00:00.1234567"   "~H:~M:~S.~N") (srfi:make-date 123456700 0 0 12 #t #t #t 0) "check 3")
-      (check-equal? (string->date "12:00:00.123456"    "~H:~M:~S.~N") (make-srfi:date 123456000 0 0 12 #t #t #t 0) "check 4")
+      (check-equal? (string->date "12:00:00.123456"    "~H:~M:~S.~N") (srfi:make-date 123456000 0 0 12 #t #t #t 0) "check 4")
-      (check-equal? (string->date "12:00:00.12345"     "~H:~M:~S.~N") (make-srfi:date 123450000 0 0 12 #t #t #t 0) "check 5")
+      (check-equal? (string->date "12:00:00.12345"     "~H:~M:~S.~N") (srfi:make-date 123450000 0 0 12 #t #t #t 0) "check 5")
-      (check-equal? (string->date "12:00:00.1234"      "~H:~M:~S.~N") (make-srfi:date 123400000 0 0 12 #t #t #t 0) "check 6")
+      (check-equal? (string->date "12:00:00.1234"      "~H:~M:~S.~N") (srfi:make-date 123400000 0 0 12 #t #t #t 0) "check 6")
-      (check-equal? (string->date "12:00:00.123"       "~H:~M:~S.~N") (make-srfi:date 123000000 0 0 12 #t #t #t 0) "check 7")
+      (check-equal? (string->date "12:00:00.123"       "~H:~M:~S.~N") (srfi:make-date 123000000 0 0 12 #t #t #t 0) "check 7")
-      (check-equal? (string->date "12:00:00.12"        "~H:~M:~S.~N") (make-srfi:date 120000000 0 0 12 #t #t #t 0) "check 8")
+      (check-equal? (string->date "12:00:00.12"        "~H:~M:~S.~N") (srfi:make-date 120000000 0 0 12 #t #t #t 0) "check 8")
-      (check-equal? (string->date "12:00:00.1"         "~H:~M:~S.~N") (make-srfi:date 100000000 0 0 12 #t #t #t 0) "check 9")
+      (check-equal? (string->date "12:00:00.1"         "~H:~M:~S.~N") (srfi:make-date 100000000 0 0 12 #t #t #t 0) "check 9")
-      (check-equal? (string->date "12:00:00.123456789" "~H:~M:~S.~N") (make-srfi:date 123456789 0 0 12 #t #t #t 0) "check 10")
+      (check-equal? (string->date "12:00:00.123456789" "~H:~M:~S.~N") (srfi:make-date 123456789 0 0 12 #t #t #t 0) "check 10")
-      (check-equal? (string->date "12:00:00.012345678" "~H:~M:~S.~N") (make-srfi:date 12345678  0 0 12 #t #t #t 0) "check 11")
+      (check-equal? (string->date "12:00:00.012345678" "~H:~M:~S.~N") (srfi:make-date 12345678  0 0 12 #t #t #t 0) "check 11")
-      (check-equal? (string->date "12:00:00.001234567" "~H:~M:~S.~N") (make-srfi:date 1234567   0 0 12 #t #t #t 0) "check 12")
+      (check-equal? (string->date "12:00:00.001234567" "~H:~M:~S.~N") (srfi:make-date 1234567   0 0 12 #t #t #t 0) "check 12")
-      (check-equal? (string->date "12:00:00.000123456" "~H:~M:~S.~N") (make-srfi:date 123456    0 0 12 #t #t #t 0) "check 13")
+      (check-equal? (string->date "12:00:00.000123456" "~H:~M:~S.~N") (srfi:make-date 123456    0 0 12 #t #t #t 0) "check 13")
-      (check-equal? (string->date "12:00:00.000012345" "~H:~M:~S.~N") (make-srfi:date 12345     0 0 12 #t #t #t 0) "check 14")
+      (check-equal? (string->date "12:00:00.000012345" "~H:~M:~S.~N") (srfi:make-date 12345     0 0 12 #t #t #t 0) "check 14")
-      (check-equal? (string->date "12:00:00.000001234" "~H:~M:~S.~N") (make-srfi:date 1234      0 0 12 #t #t #t 0) "check 15")
+      (check-equal? (string->date "12:00:00.000001234" "~H:~M:~S.~N") (srfi:make-date 1234      0 0 12 #t #t #t 0) "check 15")
-      (check-equal? (string->date "12:00:00.000000123" "~H:~M:~S.~N") (make-srfi:date 123       0 0 12 #t #t #t 0) "check 16")
+      (check-equal? (string->date "12:00:00.000000123" "~H:~M:~S.~N") (srfi:make-date 123       0 0 12 #t #t #t 0) "check 16")
-      (check-equal? (string->date "12:00:00.000000012" "~H:~M:~S.~N") (make-srfi:date 12        0 0 12 #t #t #t 0) "check 17")
+      (check-equal? (string->date "12:00:00.000000012" "~H:~M:~S.~N") (srfi:make-date 12        0 0 12 #t #t #t 0) "check 17")
-      (check-equal? (string->date "12:00:00.000000001" "~H:~M:~S.~N") (make-srfi:date 1         0 0 12 #t #t #t 0) "check 18"))
+      (check-equal? (string->date "12:00:00.000000001" "~H:~M:~S.~N") (srfi:make-date 1         0 0 12 #t #t #t 0) "check 18"))
       
      (test-case
       "date<->julian-day conversion"
-      (check = 365 (- (date->julian-day (make-srfi:date 0 0 0 0 1 1 2004 0))
+      (check = 365 (- (date->julian-day (srfi:make-date 0 0 0 0 1 1 2004 0))
-                      (date->julian-day (make-srfi:date 0 0 0 0 1 1 2003 0))))
+                      (date->julian-day (srfi:make-date 0 0 0 0 1 1 2003 0))))
-      (let ([test-date (make-srfi:date 0 0 0 0 1 1 2003 -7200)])
+      (let ([test-date (srfi:make-date 0 0 0 0 1 1 2003 -7200)])
         (check tm:date= test-date (julian-day->date (date->julian-day test-date) -7200))))
 
      (test-case
       "date->modified-julian-day conversion"
-      (check = 365 (- (date->modified-julian-day (make-srfi:date 0 0 0 0 1 1 2004 0))
+      (check = 365 (- (date->modified-julian-day (srfi:make-date 0 0 0 0 1 1 2004 0))
-                      (date->modified-julian-day (make-srfi:date 0 0 0 0 1 1 2003 0))))
+                      (date->modified-julian-day (srfi:make-date 0 0 0 0 1 1 2003 0))))
-      (let ([test-date (make-srfi:date 0 0 0 0 1 1 2003 -7200)])
+      (let ([test-date (srfi:make-date 0 0 0 0 1 1 2003 -7200)])
         (check tm:date= test-date (modified-julian-day->date (date->modified-julian-day test-date) -7200))))
 
      ))

collects/srfi/19/time.ss

@@ -74,7 +74,7 @@
 	   time-difference time-difference! add-duration add-duration! subtract-duration subtract-duration!
            ;; Date object and accessors
 	   ;; date structure is provided by core PLT Scheme, we just extended tu support miliseconds:
-           make-srfi:date srfi:date?
+           srfi:make-date srfi:date?
 	   date-nanosecond srfi:date-second srfi:date-minute srfi:date-hour srfi:date-day srfi:date-month
            srfi:date-year date-zone-offset
 	   ;; This are not part of the date structure (as they are in the original PLT Scheme's date)
@@ -582,7 +582,7 @@
     time-in)
   
   ;; -- Date Structures
-  (define-values (tm:date make-srfi:date srfi:date? tm:date-ref tm:date-set!)
+  (define-values (tm:date srfi:make-date srfi:date? tm:date-ref tm:date-set!)
     (make-struct-type 
      'tm:date #f 8 0 #f null (make-inspector) #f null))
   ;; PLT Scheme date structure has the following:
@@ -702,7 +702,7 @@
 		       (rem      (remainder secs (* 60 60)))
 		       (minutes  (quotient rem 60))
 		       (seconds  (remainder rem 60)) )
-		 (make-srfi:date (time-nanosecond time)
+		 (srfi:make-date (time-nanosecond time)
                                  seconds
                                  minutes
                                  hours
@@ -794,7 +794,7 @@
     (tm:week-day (srfi:date-day date) (srfi:date-month date) (srfi:date-year date)))
   
   (define (tm:days-before-first-week date day-of-week-starting-week)
-    (let* ( (first-day (make-srfi:date 0 0 0 0
+    (let* ( (first-day (srfi:make-date 0 0 0 0
                                        1
                                        1
                                        (srfi:date-year date)
@@ -1480,7 +1480,7 @@
 	   (srfi:date-month date)
 	   (srfi:date-year date)
 	   (date-zone-offset date)))
-    (let ( (newdate (make-srfi:date 0 0 0 0 #t #t #t (tm:local-tz-offset))) )
+    (let ( (newdate (srfi:make-date 0 0 0 0 #t #t #t (tm:local-tz-offset))) )
       (tm:string->date newdate
 		       0
 		       template-string

collects/srfi/2.ss

@@ -1,4 +1,2 @@
 ;; module loader for SRFI-2
-(module |2| mzscheme
+#lang s-exp srfi/provider srfi/2/and-let
-  (require srfi/2/and-let)
-  (provide (all-from srfi/2/and-let)))

collects/srfi/23.ss

@@ -1,3 +1,3 @@
 ;; Supported by core PLT:
-(module |23| mzscheme
+#lang scheme/base
-  (provide error))
+(provide error)

collects/srfi/25.ss

@@ -1,4 +1,2 @@
 ;; module loader for SRFI-25
-(module |25| mzscheme
+#lang s-exp srfi/provider srfi/25/array
-  (require srfi/25/array)
-  (provide (all-from srfi/25/array)))

collects/srfi/26.ss

@@ -1,5 +1,2 @@
 ;; module loader for SRFI-26
-#lang scheme/base
+#lang s-exp srfi/provider srfi/26/cut
-
-(require srfi/26/cut)
-(provide (all-from-out srfi/26/cut))

collects/srfi/27.ss

@@ -1,3 +1,2 @@
-(module |27| mzscheme
+;; module loader for SRFI-27
-  (require srfi/27/random-bits)
+#lang s-exp srfi/provider srfi/27/random-bits
-  (provide (all-from srfi/27/random-bits)))

collects/srfi/28.ss

@@ -1,3 +1,3 @@
 ;; Supported by core PLT:
-(module |28| mzscheme
+#lang scheme/base
-  (provide format))
+(provide format)

collects/srfi/29.ss

@@ -1,4 +1,2 @@
 ;; module loader for SRFI-29
-(module |29| mzscheme
+#lang s-exp srfi/provider srfi/29/localization
-  (require srfi/29/localization)
-  (provide (all-from srfi/29/localization)))

collects/srfi/30.ss

@@ -1,2 +1,2 @@
-;; Supported by core PLT:
+;; Supported by core PLT, nothing to provide:
-(module |30| mzscheme)
+#lang scheme/base

collects/srfi/31.ss

@@ -1,4 +1,2 @@
-;; SRFI 31: A special form rec for recursive evaluation
+;; module loader for SRFI-31: A special form rec for recursive evaluation
-(module |31| mzscheme
+#lang s-exp srfi/provider srfi/31/rec
-  (require srfi/31/rec)
-  (provide rec))

collects/srfi/32.ss

@@ -1,3 +1,2 @@
-(module |32| mzscheme
+;; module loader for SRFI-32
-  (require (lib "srfi/32/sort.scm"))
+#lang s-exp srfi/provider "32/sort.scm"
-  (provide (all-from (lib "srfi/32/sort.scm"))))

collects/srfi/34.ss

@@ -1,4 +1,2 @@
 ;; module loader for SRFI-34
-(module |34| mzscheme
+#lang s-exp srfi/provider srfi/34/exception
-  (require srfi/34/exception)
-  (provide (all-from srfi/34/exception)))

collects/srfi/35.ss

@@ -1,4 +1,2 @@
 ;; module loader for SRFI-35
-(module |35| mzscheme
+#lang s-exp srfi/provider srfi/35/condition
-  (require srfi/35/condition)
-  (provide (all-from srfi/35/condition)))

collects/srfi/38.ss

@@ -1,4 +1,2 @@
-;; Supported by core PLT:
+;; module loader for SRFI-38
-(module |38| mzscheme
+#lang s-exp srfi/provider srfi/38/38 #:unprefix s:
-  (provide (rename write write-with-shared-structure)
-           (rename read read-with-shared-structure)))

collects/srfi/38/38.ss

@@ -0,0 +1,8 @@
+#lang scheme/base
+
+(provide s:read s:write)
+
+(define (s:write . args)
+  (parameterize ([print-graph #t]) (apply write args)))
+(define (s:read . args)
+  (parameterize ([read-accept-graph #t]) (apply read args)))

collects/srfi/39.ss

@@ -1,3 +1,3 @@
 ;; Supported by core PLT:
-(module |39| mzscheme
+#lang scheme/base
-  (provide make-parameter parameterize))
+(provide make-parameter parameterize)

collects/srfi/40.ss

@@ -1,4 +1,2 @@
 ;; module loader for SRFI-40
-(module |40| mzscheme
+#lang s-exp srfi/provider srfi/40/stream
-  (require srfi/40/stream)
-  (provide (all-from srfi/40/stream)))

collects/srfi/42.ss

@@ -1,4 +1,2 @@
 ;; module loader for SRFI-42
-(module |42| mzscheme
+#lang s-exp srfi/provider srfi/42/comprehensions
-  (require srfi/42/comprehensions)
-  (provide (all-from srfi/42/comprehensions)))

collects/srfi/43.ss

@@ -1,8 +1,2 @@
 ;; module loader for SRFI-43
-(module |43| mzscheme
+#lang s-exp srfi/provider srfi/43/vector-lib #:unprefix s:
-  (require srfi/43/vector-lib)
-  (provide (all-from-except srfi/43/vector-lib
-                            s:vector-fill!
-                            s:vector->list)
-           (rename s:vector-fill! vector-fill!)
-           (rename s:vector->list vector->list)))

collects/srfi/45.ss

@@ -1,10 +1,2 @@
 ;; module loader for SRFI-45
-(module |45| mzscheme
+#lang s-exp srfi/provider srfi/45/lazy
-  (require srfi/45/lazy)
-  (provide (all-from-except srfi/45/lazy
-                            s:delay
-                            s:force
-                            srfi-45-promise?)
-           (rename s:delay delay)
-           (rename s:force force)
-           (rename srfi-45-promise? promise?)))

collects/srfi/45/lazy.ss

@@ -1,38 +1,12 @@
-; SRFI 45
+#lang scheme/base
-; Zhu Chongkai   mrmathematica@yahoo.com
-; 25-May-2005
-(module lazy mzscheme
 
-  (provide lazy
+;; scheme/promise has srfi-45-style primitives
-           eager
+(require scheme/promise)
-           s:delay
+(provide (all-from-out scheme/promise))
-           s:force
-           srfi-45-promise?)
 
-  (define-struct srfi-45-promise (content))
+;; TODO: there is a small difference between the primitives in srfi-45 and the
-  
+;; ones provided by scheme/promise (the latter is a bit more permissive).  See
-  (define-syntax lazy
+;; "library approach" in scheme/promise and see the post-finalization
-    (syntax-rules ()
+;; discussion on the srfi-45 list.  I (Eli) showed at some point how the
-      ((_ exp)
+;; "language approach" primitives can be used to implement the other, and this
-       (make-srfi-45-promise (mcons #f (lambda () exp))))))
+;; needs to be done here too.
-  
-  (define (eager x)
-    (make-srfi-45-promise (mcons #t x)))
-  
-  (define-syntax s:delay
-    (syntax-rules ()
-      ((_ exp) (lazy (eager exp)))))
-  
-  (define (s:force promise)
-    (if (srfi-45-promise? promise)
-        (let ((content (srfi-45-promise-content promise)))
-          (if (mcar content)
-              (mcdr content)
-              (let* ((promise* ((mcdr content)))
-                     (content (srfi-45-promise-content promise)))
-                (unless (mcar content)
-                  (set-mcar! content (mcar (srfi-45-promise-content promise*)))
-                  (set-mcdr! content (mcdr (srfi-45-promise-content promise*)))
-                  (set-srfi-45-promise-content! promise* content))
-                (s:force promise))))
-        (raise-type-error 'force "srfi-45-promise" promise))))

collects/srfi/48.ss

@@ -1,4 +1,2 @@
 ;; module loader for SRFI-48
-(module |48| mzscheme
+#lang s-exp srfi/provider srfi/48/format
-  (require srfi/48/format)
-  (provide (rename s:format format)))

collects/srfi/5.ss

@@ -1,4 +1,2 @@
 ;; module loader for SRFI-5
-(module |5| mzscheme
+#lang s-exp srfi/provider srfi/5/let #:unprefix s:
-  (require (rename srfi/5/let my-let let))
-  (provide (rename my-let let)))

collects/srfi/5/let.ss

@@ -10,28 +10,29 @@
 ;;; Copyright (C) Andy Gaynor (1999-2003)
 ;;;
 ;;; The version of my-let here was cleaned up by: Paul Schlie <schlie@attbi.com>.
+;;; Renamed to s:let by Eli Barzilay
 
-(module let mzscheme
+#lang scheme/base
-  (provide (rename my-let let))
+(provide s:let)
 
-  (define-syntax my-let
+(define-syntax s:let
   (syntax-rules ()
     ;; standard
-      ((my-let () body ...)
+    ((s:let () body ...)
      (let () body ...))
-      ((my-let ((var val) ...) body ...)
+    ((s:let ((var val) ...) body ...)
      (let ((var val) ...) body ...))
 
     ;; rest style
-      ((my-let ((var val) . bindings) body ...)
+    ((s:let ((var val) . bindings) body ...)
      (let-loop #f bindings (var) (val) (body ...)))
 
     ;; signature style
-      ((my-let (name bindings ...) body ...)
+    ((s:let (name bindings ...) body ...)
      (let-loop name (bindings ...) () () (body ...)))
 
     ;; standard named style
-      ((my-let name (bindings ...) body ...)
+    ((s:let name (bindings ...) body ...)
      (let-loop name (bindings ...) () () (body ...)))
 
     ))
@@ -41,46 +42,45 @@
 (define-syntax let-loop
   (syntax-rules ()
 
-     ; No more bindings - make a LETREC.
+    ;; No more bindings - make a LETREC.
     ((let-loop name () (vars ...) (vals ...) body)
      ((letrec ((name (lambda (vars ...) . body)))
         name)
       vals ...))
 
-     ; Rest binding, no name
+    ;; Rest binding, no name
     ((let-loop #f (rest-var rest-val ...) (var ...) (val ...) body)
      (let ((var val) ... (rest-var (list rest-val ...))) . body))
 
-     ; Process a (var val) pair.
+    ;; Process a (var val) pair.
     ((let-loop name ((var val) more ...) (vars ...)     (vals ...)     body)
      (let-loop name (more ...)           (vars ... var) (vals ... val) body))
 
-     ; End with a rest variable - make a LETREC.
+    ;; End with a rest variable - make a LETREC.
     ((let-loop name (rest-var rest-vals ...) (vars ...) (vals ...) body)
      ((letrec ((name (lambda (vars ... . rest-var) . body)))
         name)
       vals ... rest-vals ...))))
 
-; Four loops - normal and `signature-style', each with and without a rest
+;; Four loops - normal and `signature-style', each with and without a rest
-; binding.
+;; binding.
-;
+;;
-;(let fibonacci ((n 10) (i 0) (f0 0) (f1 1))
+;;(let fibonacci ((n 10) (i 0) (f0 0) (f1 1))
-;  (if (= i n)
+;;  (if (= i n)
-;      f0
+;;      f0
-;      (fibonacci n (+ i 1) f1 (+ f0 f1))))
+;;      (fibonacci n (+ i 1) f1 (+ f0 f1))))
-;
+;;
-;(let (fibonacci (n 10) (i 0) (f0 0) (f1 1))
+;;(let (fibonacci (n 10) (i 0) (f0 0) (f1 1))
-;  (if (= i n)
+;;  (if (= i n)
-;      f0
+;;      f0
-;      (fibonacci n (+ i 1) f1 (+ f0 f1))))
+;;      (fibonacci n (+ i 1) f1 (+ f0 f1))))
-;
+;;
-;(let fibonacci ((n 10) (i 0) . (f 0 1))
+;;(let fibonacci ((n 10) (i 0) . (f 0 1))
-;  (if (= i n)
+;;  (if (= i n)
-;      (car f)
+;;      (car f)
-;      (fibonacci n (+ i 1) (cadr f) (+ (car f) (cadr f)))))
+;;      (fibonacci n (+ i 1) (cadr f) (+ (car f) (cadr f)))))
-;
+;;
-;(let (fibonacci (n 10) (i 0) . (f 0 1))
+;;(let (fibonacci (n 10) (i 0) . (f 0 1))
-;  (if (= i n)
+;;  (if (= i n)
-;      (car f)
+;;      (car f)
-;      (fibonacci n (+ i 1) (cadr f) (+ (car f) (cadr f)))))
+;;      (fibonacci n (+ i 1) (cadr f) (+ (car f) (cadr f)))))
-  )

collects/srfi/54.ss

@@ -1,4 +1,2 @@
 ;; module loader for SRFI-54
-(module |54| mzscheme
+#lang s-exp srfi/provider srfi/54/cat
-  (require srfi/54/cat)
-  (provide (all-from srfi/54/cat)))

collects/srfi/54/cat.ss

@@ -1,9 +1,12 @@
 ;; based on soo's (the author of the SRFI) R6RS implemenations
-(module cat mzscheme
+#lang scheme/base
 
 (provide cat)
 
-  (require (only mzlib/string expr->string))
+(define (expr->string v writer)
+  (let ([port (open-output-string)])
+    (writer v port)
+    (get-output-string port)))
 
 (define (take-both-end str take)
   (let ((left (car take)))
@@ -946,4 +949,3 @@
                  (if port
                    (display str port)
                    str)))))
-  )

collects/srfi/57.ss

@@ -1,4 +1,2 @@
 ;; module loader for SRFI-57
-(module |57| mzscheme
+#lang s-exp srfi/provider srfi/57/records
-  (require srfi/57/records)
-  (provide (all-from srfi/57/records)))

collects/srfi/59.ss

@@ -1,4 +1,2 @@
 ;; module loader for SRFI-59
-(module |59| mzscheme
+#lang s-exp srfi/provider srfi/59/vicinity
-  (require srfi/59/vicinity)
-  (provide (all-from srfi/59/vicinity)))

collects/srfi/6.ss

@@ -1,3 +1,3 @@
 ;; Supported by core PLT:
-(module |6| mzscheme
+#lang scheme/base
-  (provide get-output-string open-input-string open-output-string))
+(provide get-output-string open-input-string open-output-string)

collects/srfi/60.ss

@@ -1,5 +1 @@
-(module |60| mzscheme
+#lang s-exp srfi/provider srfi/60/60
-
-  (require srfi/60/60)
-  (provide (all-from srfi/60/60))
-  )

collects/srfi/61.ss

@@ -1,4 +1,2 @@
 ;; module loader for SRFI-61
-(module |61| mzscheme
+#lang s-exp srfi/provider srfi/61/cond #:unprefix srfi:
-  (require srfi/61/cond)
-  (provide (rename srfi:cond cond)))

collects/srfi/63.ss

@@ -1,4 +1,2 @@
-(module |63| mzscheme
+;; module loader for SRFI-1
-  (require srfi/63/63)
+#lang s-exp srfi/provider srfi/63/63 #:unprefix s:
-  (provide (all-from-except srfi/63/63 s:equal?)
-           (rename s:equal? equal?)))

collects/srfi/64.ss

@@ -1,4 +1,2 @@
 ;; module loader for SRFI-64
-(module |64| mzscheme
+#lang s-exp srfi/provider srfi/64/testing
-  (require srfi/64/testing)
-  (provide (all-from srfi/64/testing)))

collects/srfi/67.ss

@@ -1,3 +1,2 @@
-(module |67| mzscheme
+;; module loader for SRFI-67
-  (require srfi/67/compare)
+#lang s-exp srfi/provider srfi/67/compare
-  (provide (all-from srfi/67/compare)))

collects/srfi/69.ss

@@ -1,10 +1,2 @@
 ;; module loader for SRFI-69
-(module |69| mzscheme
+#lang s-exp srfi/provider srfi/69/hash #:unprefix s:
-  (require srfi/69/hash)
-  (provide (all-from-except srfi/69/hash
-                            s:make-hash-table
-                            s:hash-table?
-                            s:hash-table-copy)
-           (rename s:make-hash-table make-hash-table)
-           (rename s:hash-table? hash-table?)
-           (rename s:hash-table-copy hash-table-copy)))

collects/srfi/7.ss

@@ -1,4 +1,2 @@
 ;; module loader for SRFI-7
-(module |7| mzscheme
+#lang s-exp srfi/provider srfi/7/program
-  (require srfi/7/program)
-  (provide (all-from srfi/7/program)))

collects/srfi/71.ss

@@ -1,14 +1,2 @@
 ;; module loader for SRFI-71
-(module |71| mzscheme
+#lang s-exp srfi/provider srfi/71/letvalues #:unprefix srfi-
-  (require srfi/71/letvalues)
-  (provide (all-from-except srfi/71/letvalues
-                            let
-                            let*
-                            letrec
-                            srfi-let
-                            srfi-let*
-                            srfi-letrec))
-  (provide (rename srfi-let    let)
-           (rename srfi-let*   let*)
-           (rename srfi-letrec letrec)
-           (rename srfi-letrec letrec*)))

collects/srfi/71/letvalues.ss

@@ -1,9 +1,7 @@
 ; Reference implementation of SRFI-71 using PLT 208's modules
 ; Sebastian.Egner@philips.com, 29-Apr-2005
 
-(module letvalues mzscheme
+#lang scheme/base
-  
-  (provide (all-from mzscheme))
 
 (provide srfi-let
          srfi-let*
@@ -228,5 +226,3 @@
      (call-with-values (lambda () x) vector))))
 
 ; --- textual copy of 'letvalues.scm' ends here ---
-  
-  ) ; module letvalues

collects/srfi/74.ss

@@ -1,3 +1,2 @@
-(module |74| mzscheme
+;; module loader for SRFI-13
-  (require srfi/74/74)
+#lang s-exp srfi/provider srfi/74/74
-  (provide (all-from srfi/74/74)))

collects/srfi/78.ss

@@ -1,3 +1,2 @@
-(module |78| mzscheme
+;; module loader for SRFI-78
-  (require srfi/78/check)
+#lang s-exp srfi/provider srfi/78/check
-  (provide (all-from srfi/78/check)))

collects/srfi/78/check-reference.scm

@@ -99,10 +99,10 @@
 
 (define (check:report-correct cases)
   (display "correct")
-  (if (not (= cases 1))
+  (unless (= cases 1)
-      (begin (display " (")
+    (display " (")
     (display cases)
-             (display " cases checked)")))
+    (display " cases checked)"))
   (newline))
 
 (define (check:report-failed expected-result)
@@ -113,8 +113,7 @@
   (newline))
 
 (define (check-report)
-  (if (>= check:mode 1)
+  (when (>= check:mode 1)
-      (begin
     (newline)
     (display "; *** checks *** : ")
     (display check:correct)
@@ -131,7 +130,7 @@
         (newline)
         (check:report-expression expression)
         (check:report-actual-result actual-result)
-              (check:report-failed expected-result))))))
+        (check:report-failed expected-result)))))
 
 (define (check-passed? expected-total-count)
   (and (= (length check:failed) 0)
@@ -168,14 +167,14 @@
 				     actual-result 
 				     expected-result)))))
     (else (error "unrecognized check:mode" check:mode)))
-  (if #f #f))
+  (void))
 
 (define-syntax check
   (syntax-rules (=>)
     ((check expr => expected)
      (check expr (=> equal?) expected))
     ((check expr (=> equal) expected)
-     (if (>= check:mode 1)
+     (when (>= check:mode 1)
        (check:proc 'expr (lambda () expr) equal expected)))))
 
 ; -- parametric checks --
@@ -187,15 +186,15 @@
         (expected-result (cadddr w))
 	(cases (car (cddddr w))))
     (if correct?
-        (begin (if (>= check:mode 100)
+        (begin (when (>= check:mode 100)
-                   (begin (check:report-expression expression)
+                 (check:report-expression expression)
                  (check:report-actual-result actual-result)
-                          (check:report-correct cases)))
+                 (check:report-correct cases))
                (check:add-correct!))
-        (begin (if (>= check:mode 10)
+        (begin (when (>= check:mode 10)
-                   (begin (check:report-expression expression)
+                 (check:report-expression expression)
                  (check:report-actual-result actual-result)
-                          (check:report-failed expected-result)))
+                 (check:report-failed expected-result))
                (check:add-failed! expression
 				  actual-result
 				  expected-result)))))
@@ -203,7 +202,7 @@
 (define-syntax check-ec:make
   (syntax-rules (=>)
     ((check-ec:make qualifiers expr (=> equal) expected (arg ...))
-     (if (>= check:mode 1)
+     (when (>= check:mode 1)
        (check:proc-ec
         (let ((cases 0))
           (let ((w (first-ec
@@ -226,8 +225,8 @@
                     '(check-ec qualifiers
                                expr (=> equal)
                                expected (arg ...))
-			(if #f #f)
+                    (void)
-		        (if #f #f)
+                    (void)
                     cases)))))))))
 
 ; (*) is a compile-time check that (arg ...) is a list

collects/srfi/78/check.ss

@@ -1,4 +1,4 @@
-(module check mzscheme
+#lang scheme/base
 (require mzlib/include
          srfi/23
          srfi/42
@@ -11,4 +11,4 @@
          check-report
          check-set-mode!
          check-reset!
-	   check-passed?))
+         check-passed?)

collects/srfi/8.ss

@@ -1,4 +1,2 @@
 ;; module loader for SRFI-8
-(module |8| mzscheme
+#lang s-exp srfi/provider srfi/8/receive
-  (require srfi/8/receive)
-  (provide (all-from srfi/8/receive)))

collects/srfi/86.ss

@@ -1,4 +1,2 @@
-(module |86| mzscheme
+;; module loader for SRFI-86
-  (require srfi/86/86)
+#lang s-exp srfi/provider srfi/86/86
-  (provide (all-from srfi/86/86))
-  )

collects/srfi/86/86.ss

@@ -1,9 +1,6 @@
-(module |86| mzscheme
+#lang mzscheme
 
-  (provide (all-from mzscheme))
+(provide mu nu alet alet*)
-  
-  (provide mu nu
-           alet alet*)
 
 ;;; mu & nu
 (define-syntax mu
@@ -51,7 +48,8 @@
             (bn ...) bd ...))
     ((%alet "dot" (p ...) (nv ...) (values t ...) (() c) (bn ...) bd ...)
      (call-with-values (lambda () c)
-                         (lambda (t ...) (%alet (p ...) (nv ...) (bn ...) bd ...))))
+                       (lambda (t ...)
+                         (%alet (p ...) (nv ...) (bn ...) bd ...))))
     ((%alet "dot" (p ...) (nv ...) (values t ...) (() c ...) (bn ...) bd ...)
      ((lambda (t ...) (%alet (p ...) (nv ...) (bn ...) bd ...)) c ...))
     ((%alet "dot" (p ...) (nv ...) (values t ...) (b c) (bn ...) bd ...)
@@ -184,7 +182,8 @@
             (bn ...) bd ...))
     ((%alet "not" (p ...) (nv ...) (values t ...) (z) (bn ...) bd ...)
      (call-with-values (lambda () z)
-                         (lambda (t ...) (%alet (p ...) (nv ...) (bn ...) bd ...))))
+                       (lambda (t ...)
+                         (%alet (p ...) (nv ...) (bn ...) bd ...))))
 
     ((%alet (p ...) (nv ...) ((a b c ...) bn ...) bd ...)
      (%alet "not" (p ...) (nv ... (a t)) (t) (b c ...) (bn ...) bd ...))
@@ -305,10 +304,12 @@
      (%alet* "one" (p ...) (n ... a) (values r ... a) (b c) (bn ...) bd ...))
     ((%alet* "one" (p ...) (n ...) (values r ...) (() c) (bn ...) bd ...)
      (call-with-values (lambda () c)
-                         (lambda* (r ...) (%alet* (p ...) (n ...) (bn ...) bd ...))))
+                       (lambda* (r ...)
+                         (%alet* (p ...) (n ...) (bn ...) bd ...))))
     ((%alet* "one" (p ...) (n ...) (values r ...) (b c) (bn ...) bd ...)
      (call-with-values (lambda () c)
-                         (lambda* (r ... . b) (%alet* (p ...) (n ... b) (bn ...) bd ...))))
+                       (lambda* (r ... . b)
+                         (%alet* (p ...) (n ... b) (bn ...) bd ...))))
 
     ((%alet* (p ...) (n ...) (((values . b) c d ...) bn ...) bd ...)
      (%alet* "dot" (p ...) (n ...) (b c d ...) (bn ...) bd ...))
@@ -1135,4 +1136,3 @@
        (error "alet*: too many arguments" z)))
     ((%alet-key* z (o ...) () e (kk ...) bd ...)
      (let ((e z)) bd ...))))
-  )

collects/srfi/87.ss

@@ -1,3 +1,2 @@
-(module |87| mzscheme
+;; module loader for SRFI-87
-  (require srfi/87/case)
+#lang s-exp srfi/provider srfi/87/case #:unprefix srfi:
-  (provide (rename srfi:case case)))

collects/srfi/9.ss

@@ -1,4 +1,2 @@
 ;; module loader for SRFI-9
-(module |9| mzscheme
+#lang s-exp srfi/provider srfi/9/record
-  (require srfi/9/record)
-  (provide (all-from srfi/9/record)))

collects/srfi/features.ss

@@ -1,20 +1,15 @@
-(module features mzscheme
+#lang scheme/base
-  (provide feature-present?
+
-	   feature->require-clause)
+(provide feature-present? feature->require-clause)
 
 (define *feature-alist*
   '())
 
 (define (srfi-id? id)
-    (let ((string-id (symbol->string id)))
+  (regexp-match? #rx"^srfi-[0-9]+$" (symbol->string id)))
-      (and (> (string-length string-id) 5)
-	   (string=? "srfi-"
-		     (substring string-id 0 5)))))
 
 (define (srfi-id->filename srfi-id)
-    (let ((string-id (symbol->string srfi-id)))
+  (regexp-replace #rx"^srfi-([0-9]+)$" (symbol->string srfi-id) "\\1/\\1.ss"))
-      (string-append (substring string-id 5 (string-length string-id))
-		     ".ss")))
 
 (define (srfi-id-present? srfi-id)
   (file-exists? (build-path (collection-path "srfi")
@@ -25,6 +20,9 @@
       (and (assq id *feature-alist*) #t)))
 
 (define (feature->require-clause id)
-    (if (and (srfi-id? id) (srfi-id-present? id))
+  (cond [(and (srfi-id? id) (srfi-id-present? id))
-	(cons 'lib (list (srfi-id->filename id) "srfi"))
+         (string->symbol (regexp-replace #rx"^srfi-([0-9]+)$"
-	(cdr (assq id *feature-alist*)))))
+                                         (symbol->string id)
+                                         "srfi/\\1/\\1"))]
+        [(assq id *feature-alist*) => cdr]
+        [else (error 'feature->require-clause "unknown feature: ~e" id)]))

collects/srfi/optional.ss

@@ -45,18 +45,17 @@
 ;; macros. :-)
 ;;
 
-#lang mzscheme
+#lang scheme/base
-(provide :optional
+
-         let-optionals*
+(require (for-syntax scheme/base))
-         check-arg
+
-         )
+(provide :optional let-optionals* check-arg)
 
 ;; (function (check-arg predicate value caller))
 ;;
 ;;
 ;; Checks parameter values.
-(define check-arg
+(define (check-arg pred val caller)
-  (lambda (pred val caller)
   (if (not (pred val))
     (let ([expected-string
            (cond [(eq? pred number? ) "expected number, "]
@@ -67,7 +66,7 @@
                  [(eq? pred vector?) "expected vector, "]
                  [else ""])])
       (error caller (string-append expected-string "given ~s") val))
-      val)))
+    val))
 
 
 

collects/srfi/provider.ss

@@ -0,0 +1,53 @@
+#lang scheme/base
+
+(require (for-syntax scheme/base scheme/provide-transform))
+
+;; This is a utility for many srfi/N.ss files that simply reprovide stuff from
+;; some other file.  It is used as a module, for example, the "srfi/1.ss"
+;; loader has:
+;;   #lang s-exp srfi/provider srfi/1/list #:unprefix s:
+;; which makes it require `srfi/1/list', then reprovide everything from there,
+;; removing any `s:' prefixes that it uses (since `srfi/1/list' does not
+;; collide with `scheme/base').  It is used in most files here, and the
+;; unprefix facility is used in a few similar situations.  You can add a
+;; `#:debug' flag to have the unprefixer print its renamings, to check that you
+;; get the right bindings.
+
+(provide (rename-out [module-begin #%module-begin]))
+(define-syntax (module-begin stx)
+  (syntax-case stx ()
+    [(_ srfi-req . more)
+     (let ([pfx #f] [debug #f])
+       (let loop ([more #'more])
+         (syntax-case more ()
+           [(#:unprefix pfx-id . more) (set! pfx #'pfx-id) (loop #'more)]
+           [(#:debug . more) (set! debug #t) (loop #'more)]
+           [() (void)]))
+       #`(#%module-begin
+          (require srfi-req)
+          (provide (all-from-unprefix-out #,pfx srfi-req #,debug))))]))
+
+(define-syntax all-from-unprefix-out
+  (make-provide-transformer
+   (lambda (stx modes)
+     (syntax-case stx ()
+       [(_ pfx spec debug?)
+        (map (if (identifier? #'pfx)
+               (let ([rx (string-append
+                          "^"
+                          (regexp-quote (symbol->string (syntax-e #'pfx))))]
+                     [debug? (syntax-e #'debug?)])
+                 (lambda (e)
+                   (let* ([s (symbol->string (export-out-sym e))]
+                          [m (regexp-match-positions rx s)])
+                     (when (and m debug?)
+                       (printf "Renaming: ~a -> ~a\n" s (substring s (cdar m))))
+                     (if m
+                       (make-export (export-local-id e)
+                                    (string->symbol  (substring s (cdar m)))
+                                    (export-mode     e)
+                                    (export-protect? e)
+                                    (export-orig-stx e))
+                       e))))
+               values)
+             (expand-export #'(all-from-out spec) modes))]))))