A lot of "MzScheme" -> "Racket"s.

original commit: 2d9601089d1d127374238fdbe41a344ca88ca52f

collects/mzlib/class.rkt

@@ -1,3 +1,3 @@
 (module class mzscheme
-  (require scheme/private/class-internal)
+  (require racket/private/class-internal)
   (provide-public-names))

collects/mzlib/contract.rkt

@@ -1,4 +1,4 @@
-#lang scheme/base
+#lang racket/base
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
@@ -25,37 +25,37 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
-;; provide everything from the scheme/ implementation
+;; provide everything from the racket/ implementation
 ;; except the arrow contracts
 ;;
 
-(require scheme/contract/private/base
+(require racket/contract/private/base
-         scheme/contract/private/misc
+         racket/contract/private/misc
-         scheme/contract/private/provide
+         racket/contract/private/provide
-         scheme/contract/private/guts
+         racket/contract/private/guts
-         scheme/contract/private/ds
+         racket/contract/private/ds
-         scheme/contract/private/opt
+         racket/contract/private/opt
-         scheme/contract/private/basic-opters)
+         racket/contract/private/basic-opters)
 
 (provide 
  opt/c define-opt/c ;(all-from "private/contract-opt.ss")
- (except-out (all-from-out scheme/contract/private/ds)
+ (except-out (all-from-out racket/contract/private/ds)
              lazy-depth-to-look)
  
- (all-from-out scheme/contract/private/base)
+ (all-from-out racket/contract/private/base)
- (all-from-out scheme/contract/private/provide)
+ (all-from-out racket/contract/private/provide)
- (except-out (all-from-out scheme/contract/private/misc)
+ (except-out (all-from-out racket/contract/private/misc)
              check-between/c
              string-len/c
              check-unary-between/c)
  (rename-out [or/c union])
  (rename-out [string-len/c string/len])
- (except-out (all-from-out scheme/contract/private/guts)
+ (except-out (all-from-out racket/contract/private/guts)
              check-flat-contract
              check-flat-named-contract))
 
 
-;; copied here because not provided by scheme/contract anymore
+;; copied here because not provided by racket/contract anymore
 (define (flat-contract/predicate? pred)
   (or (flat-contract? pred)
       (and (procedure? pred)

collects/mzlib/etc.rkt

@@ -1,8 +1,9 @@
 #lang mzscheme
 
 (require setup/main-collects
-         scheme/local
+         racket/local
-         scheme/bool
+         racket/bool 
+         racket/block
          (only scheme/base
                build-string
                build-list
@@ -46,7 +47,7 @@
 
          hash-table
 
-         begin-with-definitions
+         (rename block begin-with-definitions)
 
          begin-lifted)
 
@@ -349,80 +350,6 @@
                 ht)))]
          [_else (raise-syntax-error 'hash-table "bad syntax" stx)]))]))
 
-(define-syntax (begin-with-definitions stx)
-  ;; Body can have mixed exprs and defns. Wrap expressions with
-  ;; `(define-values () ... (values))' as needed, and add a (void)
-  ;; at the end if needed.
-  (let* ([def-ctx (syntax-local-make-definition-context)]
-         [ctx (list (gensym 'intdef))]
-         [kernel-forms (kernel-form-identifier-list)]
-         [init-exprs (let ([v (syntax->list stx)])
-                       (unless v
-                         (raise-syntax-error #f "bad syntax" stx))
-                       (cdr v))]
-         [exprs (let loop ([exprs init-exprs])
-                  (apply
-                   append
-                   (map (lambda (expr)
-                          (let ([expr (local-expand expr ctx kernel-forms def-ctx)])
-                            (syntax-case expr (begin define-syntaxes define-values)
-                              [(begin . rest)
-                               (loop (syntax->list #'rest))]
-                              [(define-syntaxes (id ...) rhs)
-                               (andmap identifier? (syntax->list #'(id ...)))
-                               (with-syntax ([rhs (local-transformer-expand
-                                                   #'rhs
-                                                   'expression
-                                                   null)])
-                                 (syntax-local-bind-syntaxes
-                                  (syntax->list #'(id ...))
-                                  #'rhs def-ctx)
-                                 (list #'(define-syntaxes (id ...) rhs)))]
-                              [(define-values (id ...) rhs)
-                               (andmap identifier? (syntax->list #'(id ...)))
-                               (let ([ids (syntax->list #'(id ...))])
-                                 (syntax-local-bind-syntaxes ids #f def-ctx)
-                                 (list expr))]
-                              [else
-                               (list expr)])))
-                        exprs)))])
-    (internal-definition-context-seal def-ctx)
-    (let loop ([exprs exprs]
-               [prev-stx-defns null]
-               [prev-defns null]
-               [prev-exprs null])
-      (cond
-        [(null? exprs)
-         #`(letrec-syntaxes+values
-            #,(map stx-cdr (reverse prev-stx-defns))
-            #,(map stx-cdr (reverse prev-defns))
-            #,@(if (null? prev-exprs)
-                 (list #'(void))
-                 (reverse prev-exprs)))]
-        [(and (stx-pair? (car exprs))
-              (identifier? (stx-car (car exprs)))
-              (module-identifier=? #'define-syntaxes (stx-car (car exprs))))
-         (loop (cdr exprs)
-               (cons (car exprs) prev-stx-defns)
-               prev-defns
-               prev-exprs)]
-        [(and (stx-pair? (car exprs))
-              (identifier? (stx-car (car exprs)))
-              (module-identifier=? #'define-values (stx-car (car exprs))))
-         (loop (cdr exprs)
-               prev-stx-defns
-               (cons (car exprs)
-                     (append
-                      (map (lambda (expr)
-                             #`(define-values () (begin #,expr (values))))
-                           prev-exprs)
-                      prev-defns))
-               null)]
-        [else (loop (cdr exprs)
-                    prev-stx-defns
-                    prev-defns
-                    (cons (car exprs) prev-exprs))]))))
-
 (define-syntax (begin-lifted stx)
   (syntax-case stx ()
     [(_ expr0 expr ...)

collects/mzlib/include.rkt

@@ -0,0 +1,216 @@
+
+(module include mzscheme
+  (require-for-syntax syntax/stx
+		      "private/increader.ss"
+		      "cm-accomplice.ss")
+  (require mzlib/etc)
+
+  (define-for-syntax (resolve-path-spec fn loc stx build-path-stx)
+    (let ([file
+	   (syntax-case* fn (lib) module-or-top-identifier=?
+	     [_
+	      (string? (syntax-e fn))
+	      (let ([s (syntax-e fn)])
+		(unless (or (relative-path? s)
+			    (absolute-path? s))
+		  (raise-syntax-error
+		   #f
+		   "bad pathname string"
+		   stx
+		   fn))
+		(string->path s))]
+	     [(-build-path elem ...)
+	      (module-or-top-identifier=? #'-build-path build-path-stx)
+	      (let ([l (syntax-object->datum (syntax (elem ...)))])
+		(when (null? l)
+		  (raise-syntax-error
+		   #f
+		   "`build-path' keyword is not followed by at least one string"
+		   stx
+		   fn))
+		(apply build-path l))]
+	     [(lib filename ...)
+	      (let ([l (syntax-object->datum (syntax (filename ...)))])
+		(unless (or (andmap string? l)
+			    (pair? l))
+		  (raise-syntax-error
+		   #f
+		   "`lib' keyword is not followed by a sequence of string datums"
+		   stx
+		   fn))
+		(build-path (if (null? (cdr l))
+				(collection-path "mzlib")
+				(apply collection-path (cdr l)))
+			    (car l)))]
+	     [else
+	      (raise-syntax-error
+	       #f
+	       "not a pathname string, `build-path' form, or `lib' form for file"
+	       stx
+	       fn)])])
+      (if (complete-path? file)
+	  file
+	  (path->complete-path
+	   file
+	   (cond
+	    ;; Src of include expression is a path?
+	    [(and (path? (syntax-source loc))
+		  (complete-path? (syntax-source loc)))
+	     (let-values ([(base name dir?) 
+			   (split-path (syntax-source loc))])
+	       (if dir?
+		   (syntax-source loc)
+		   base))]
+	    ;; Load relative?
+	    [(current-load-relative-directory)]
+	    ;; Current directory
+	    [(current-directory)])))))
+
+  (define-syntax-set (do-include ; private
+		      include-at/relative-to
+		      include
+		      include-at/relative-to/reader
+		      include/reader)
+
+    (define (do-include/proc stx)
+      (syntax-case stx ()
+	[(_ orig-stx ctx loc fn reader)
+	 ;; Parse the file name
+	 (let ([orig-c-file (resolve-path-spec (syntax fn) (syntax loc) (syntax orig-stx) #'build-path)]
+	       [ctx (syntax ctx)]
+	       [loc (syntax loc)]
+	       [reader (syntax reader)]
+	       [orig-stx (syntax orig-stx)]
+               [rkt->ss (lambda (p)
+                          (let ([b (path->bytes p)])
+                            (if (regexp-match? #rx#"[.]rkt$" b)
+                                (path-replace-suffix p #".ss")
+                                p)))])
+	   
+           (let ([c-file (if (file-exists? orig-c-file)
+                         orig-c-file
+                         (let ([p2 (rkt->ss orig-c-file)])
+                           (if (file-exists? p2)
+                               p2
+                               orig-c-file)))])
+             (register-external-file c-file)
+
+             (let ([read-syntax (if (syntax-e reader)
+                                    (reader-val
+                                     (let loop ([e (syntax-object->datum
+                                                    (local-expand reader 'expression null))])
+                                       (cond
+                                        [(reader? e) e]
+                                        [(pair? e) (or (loop (car e))
+                                                       (loop (cdr e)))]
+                                        [else #f])))
+                                    read-syntax)])
+               (unless (and (procedure? read-syntax)
+                            (procedure-arity-includes? read-syntax 2))
+                 (raise-syntax-error
+                  #f
+                  "reader is not a procedure of two arguments"
+                  orig-stx))
+
+               ;; Open the included file
+               (let ([p (with-handlers ([exn:fail?
+                                         (lambda (exn)
+                                           (raise-syntax-error
+                                            #f
+                                            (format
+                                             "can't open include file (~a)"
+                                             (if (exn? exn)
+                                                 (exn-message exn)
+                                                 exn))
+                                            orig-stx
+                                            c-file))])
+                          (open-input-file c-file))])
+                 (port-count-lines! p)
+                 ;; Read expressions from file
+                 (let ([content
+                        (let loop ()
+                          (let ([r (with-handlers ([exn:fail?
+                                                    (lambda (exn)
+                                                      (close-input-port p)
+                                                      (raise-syntax-error
+                                                       #f
+                                                       (format
+                                                        "read error (~a)"
+                                                        (if (exn? exn)
+                                                            (exn-message exn)
+                                                            exn))
+                                                       orig-stx))])
+                                     (read-syntax c-file p))])
+                            (if (eof-object? r)
+                                null
+                                (cons r (loop)))))])
+                   (close-input-port p)
+                   ;; Preserve src info for content, but set its
+                   ;; lexical context to be that of the include expression
+                   (let ([lexed-content
+                          (let loop ([content content])
+                            (cond
+                             [(pair? content)
+                              (cons (loop (car content))
+                                    (loop (cdr content)))]
+                             [(null? content) null]
+                             [else
+                              (let ([v (syntax-e content)])
+                                (datum->syntax-object
+                                 ctx
+                                 (cond
+                                  [(pair? v) 
+                                   (loop v)]
+                                  [(vector? v)
+                                   (list->vector (loop (vector->list v)))]
+                                  [(box? v)
+                                   (box (loop (unbox v)))]
+                                  [else
+                                   v])
+                                 content))]))])
+                     (datum->syntax-object
+                      (quote-syntax here)
+                      `(begin ,@lexed-content)
+                      orig-stx)))))))]))
+    
+    (define (include/proc stx)
+      (syntax-case stx ()
+	[(_ fn)
+	 (with-syntax ([_stx stx])
+	   (syntax/loc stx (do-include _stx _stx _stx fn #f)))]))
+
+    (define (include-at/relative-to/proc stx)
+      (syntax-case stx ()
+	[(_ ctx loc fn)
+	 (with-syntax ([_stx stx])
+	   (syntax/loc stx (do-include _stx ctx loc fn #f)))]))
+      
+    (define (include/reader/proc stx)
+      (syntax-case stx ()
+	[(_ fn reader)
+	 ;; Expand to do-include:
+	 (with-syntax ([_stx stx])
+	   (syntax/loc stx 
+	     (do-include _stx _stx _stx fn 
+			 (letrec-syntax ([the-reader (lambda (stx)
+						       (datum->syntax-object
+							#'here
+							(make-reader reader)))])
+			   the-reader))))]))
+    
+    (define (include-at/relative-to/reader/proc stx)
+      (syntax-case stx ()
+	[(_ ctx loc fn reader)
+	 (with-syntax ([_stx stx])
+	   (syntax/loc stx 
+	     (do-include _stx ctx loc fn 
+			 (letrec-syntax ([the-reader (lambda (stx)
+						       (datum->syntax-object
+							#'here
+							(make-reader reader)))])
+			   the-reader))))])))
+  
+  (provide include
+	   include-at/relative-to
+	   include/reader
+	   include-at/relative-to/reader))

collects/mzlib/include.ss

@@ -1,205 +0,0 @@
-
-(module include mzscheme
-  (require-for-syntax syntax/stx
-		      "private/increader.ss"
-		      "cm-accomplice.ss")
-  (require mzlib/etc)
-
-  (define-for-syntax (resolve-path-spec fn loc stx build-path-stx)
-    (let ([file
-	   (syntax-case* fn (lib) module-or-top-identifier=?
-	     [_
-	      (string? (syntax-e fn))
-	      (let ([s (syntax-e fn)])
-		(unless (or (relative-path? s)
-			    (absolute-path? s))
-		  (raise-syntax-error
-		   #f
-		   "bad pathname string"
-		   stx
-		   fn))
-		(string->path s))]
-	     [(-build-path elem ...)
-	      (module-or-top-identifier=? #'-build-path build-path-stx)
-	      (let ([l (syntax-object->datum (syntax (elem ...)))])
-		(when (null? l)
-		  (raise-syntax-error
-		   #f
-		   "`build-path' keyword is not followed by at least one string"
-		   stx
-		   fn))
-		(apply build-path l))]
-	     [(lib filename ...)
-	      (let ([l (syntax-object->datum (syntax (filename ...)))])
-		(unless (or (andmap string? l)
-			    (pair? l))
-		  (raise-syntax-error
-		   #f
-		   "`lib' keyword is not followed by a sequence of string datums"
-		   stx
-		   fn))
-		(build-path (if (null? (cdr l))
-				(collection-path "mzlib")
-				(apply collection-path (cdr l)))
-			    (car l)))]
-	     [else
-	      (raise-syntax-error
-	       #f
-	       "not a pathname string, `build-path' form, or `lib' form for file"
-	       stx
-	       fn)])])
-      (if (complete-path? file)
-	  file
-	  (path->complete-path
-	   file
-	   (cond
-	    ;; Src of include expression is a path?
-	    [(and (path? (syntax-source loc))
-		  (complete-path? (syntax-source loc)))
-	     (let-values ([(base name dir?) 
-			   (split-path (syntax-source loc))])
-	       (if dir?
-		   (syntax-source loc)
-		   base))]
-	    ;; Load relative?
-	    [(current-load-relative-directory)]
-	    ;; Current directory
-	    [(current-directory)])))))
-
-  (define-syntax-set (do-include ; private
-		      include-at/relative-to
-		      include
-		      include-at/relative-to/reader
-		      include/reader)
-
-    (define (do-include/proc stx)
-      (syntax-case stx ()
-	[(_ orig-stx ctx loc fn reader)
-	 ;; Parse the file name
-	 (let ([c-file (resolve-path-spec (syntax fn) (syntax loc) (syntax orig-stx) #'build-path)]
-	       [ctx (syntax ctx)]
-	       [loc (syntax loc)]
-	       [reader (syntax reader)]
-	       [orig-stx (syntax orig-stx)])
-	   
-	   (register-external-file c-file)
-
-	   (let ([read-syntax (if (syntax-e reader)
-                                  (reader-val
-                                   (let loop ([e (syntax-object->datum
-                                                  (local-expand reader 'expression null))])
-                                     (cond
-                                       [(reader? e) e]
-                                       [(pair? e) (or (loop (car e))
-                                                      (loop (cdr e)))]
-                                       [else #f])))
-				  read-syntax)])
-	     (unless (and (procedure? read-syntax)
-			  (procedure-arity-includes? read-syntax 2))
-	       (raise-syntax-error
-		#f
-		"reader is not a procedure of two arguments"
-		orig-stx))
-
-	     ;; Open the included file
-	     (let ([p (with-handlers ([exn:fail?
-				       (lambda (exn)
-					 (raise-syntax-error
-					  #f
-					  (format
-					   "can't open include file (~a)"
-					   (if (exn? exn)
-					       (exn-message exn)
-					       exn))
-					  orig-stx
-					  c-file))])
-			(open-input-file c-file))])
-	       (port-count-lines! p)
-	       ;; Read expressions from file
-	       (let ([content
-		      (let loop ()
-			(let ([r (with-handlers ([exn:fail?
-						  (lambda (exn)
-						    (close-input-port p)
-						    (raise-syntax-error
-						     #f
-						     (format
-						      "read error (~a)"
-						      (if (exn? exn)
-							  (exn-message exn)
-							  exn))
-						     orig-stx))])
-				   (read-syntax c-file p))])
-			  (if (eof-object? r)
-			      null
-			      (cons r (loop)))))])
-		 (close-input-port p)
-		 ;; Preserve src info for content, but set its
-		 ;; lexical context to be that of the include expression
-		 (let ([lexed-content
-			(let loop ([content content])
-			  (cond
-			   [(pair? content)
-			    (cons (loop (car content))
-				  (loop (cdr content)))]
-			   [(null? content) null]
-			   [else
-			    (let ([v (syntax-e content)])
-			      (datum->syntax-object
-			       ctx
-			       (cond
-				[(pair? v) 
-				 (loop v)]
-				[(vector? v)
-				 (list->vector (loop (vector->list v)))]
-				[(box? v)
-				 (box (loop (unbox v)))]
-				[else
-				 v])
-			       content))]))])
-		   (datum->syntax-object
-		    (quote-syntax here)
-		    `(begin ,@lexed-content)
-		    orig-stx))))))]))
-    
-    (define (include/proc stx)
-      (syntax-case stx ()
-	[(_ fn)
-	 (with-syntax ([_stx stx])
-	   (syntax/loc stx (do-include _stx _stx _stx fn #f)))]))
-
-    (define (include-at/relative-to/proc stx)
-      (syntax-case stx ()
-	[(_ ctx loc fn)
-	 (with-syntax ([_stx stx])
-	   (syntax/loc stx (do-include _stx ctx loc fn #f)))]))
-      
-    (define (include/reader/proc stx)
-      (syntax-case stx ()
-	[(_ fn reader)
-	 ;; Expand to do-include:
-	 (with-syntax ([_stx stx])
-	   (syntax/loc stx 
-	     (do-include _stx _stx _stx fn 
-			 (letrec-syntax ([the-reader (lambda (stx)
-						       (datum->syntax-object
-							#'here
-							(make-reader reader)))])
-			   the-reader))))]))
-    
-    (define (include-at/relative-to/reader/proc stx)
-      (syntax-case stx ()
-	[(_ ctx loc fn reader)
-	 (with-syntax ([_stx stx])
-	   (syntax/loc stx 
-	     (do-include _stx ctx loc fn 
-			 (letrec-syntax ([the-reader (lambda (stx)
-						       (datum->syntax-object
-							#'here
-							(make-reader reader)))])
-			   the-reader))))])))
-  
-  (provide include
-	   include-at/relative-to
-	   include/reader
-	   include-at/relative-to/reader))

collects/mzlib/list.rkt

@@ -1,31 +1,13 @@
-#lang mzscheme
+#lang scheme/base
 
 ;; The `first', etc. operations in this library
 ;;  work on pairs, not lists.
 
-(require (only scheme/base
+(require (only-in scheme/list
-               foldl
+                  cons?
-               foldr
+                  empty?
-
+                  empty
-               remv
+                  last-pair))
-               remq
-               remove
-               remv*
-               remq*
-               remove*
-
-               findf
-               memf
-               assf
-
-               filter
-
-               sort)
-         (only scheme/list
-               cons?
-               empty?
-               empty
-               last-pair))
 
 (provide first
          second

collects/mzlib/match.rkt

@@ -0,0 +1,4 @@
+#lang racket/base
+
+(require racket/match/legacy-match)
+(provide (all-from-out racket/match/legacy-match))

collects/mzlib/match.ss

@@ -1,4 +0,0 @@
-#lang scheme/base
-
-(require scheme/match/legacy-match)
-(provide (all-from-out scheme/match/legacy-match))

collects/mzlib/plt-match.rkt

@@ -0,0 +1,4 @@
+#lang scheme/base
+
+(require racket/match/match)
+(provide (all-from-out racket/match/match))

collects/mzlib/plt-match.ss

@@ -1,4 +0,0 @@
-#lang scheme/base
-
-(require scheme/match/match)
-(provide (all-from-out scheme/match/match))

collects/mzlib/port.rkt

@@ -1,8 +1,7 @@
-#lang scheme/base
+#lang racket/base
 
-(require (for-syntax scheme/base)
+(require (for-syntax racket/base)
-         mzlib/etc
+         racket/contract/base
-         scheme/contract/base
          mzlib/list
          "private/port.ss")
 
@@ -118,13 +117,13 @@
 ;;  0 always (which implies that the `read' proc must not return
 ;;  a pipe input port).
 (define make-input-port/read-to-peek
-  (opt-lambda (name read fast-peek close
+  (lambda (name read fast-peek close
-                    [location-proc #f]
+                [location-proc #f]
-                    [count-lines!-proc void]
+                [count-lines!-proc void]
-                    [init-position 1]
+                [init-position 1]
-                    [buffer-mode-proc #f]
+                [buffer-mode-proc #f]
-                    [buffering? #f]
+                [buffering? #f]
-                    [on-consumed #f])
+                [on-consumed #f])
     (define lock-semaphore (make-semaphore 1))
     (define commit-semaphore (make-semaphore 1))
     (define-values (peeked-r peeked-w) (make-pipe))
@@ -440,7 +439,7 @@
              (buffer-mode-proc mode)])))))
 
 (define peeking-input-port
-  (opt-lambda (orig-in [name (object-name orig-in)] [delta 0])
+  (lambda (orig-in [name (object-name orig-in)] [delta 0])
     (make-input-port/read-to-peek
      name
      (lambda (s)
@@ -452,11 +451,11 @@
      void)))
 
 (define relocate-input-port
-  (opt-lambda (p line col pos [close? #t])
+  (lambda (p line col pos [close? #t])
     (transplant-to-relocate transplant-input-port p line col pos close?)))
 
 (define transplant-input-port
-  (opt-lambda (p location-proc pos [close? #t] [count-lines!-proc void])
+  (lambda (p location-proc pos [close? #t] [count-lines!-proc void])
     (make-input-port
      (object-name p)
      (lambda (s)
@@ -486,7 +485,7 @@
   ;; thread when write evts are active; otherwise, we use a lock semaphore.
   ;; (Actually, the lock semaphore has to be used all the time, to guard
   ;; the flag indicating whether the manager thread is running.)
-  (opt-lambda ([limit (expt 2 64)] [in-name 'pipe] [out-name 'pipe])
+  (lambda ([limit (expt 2 64)] [in-name 'pipe] [out-name 'pipe])
     (let-values ([(r w) (make-pipe limit)]
                  [(more) null]
                  [(more-last) #f]
@@ -724,7 +723,7 @@
       (values in out))))
 
 (define input-port-append
-  (opt-lambda (close-orig? . ports)
+  (lambda (close-orig? . ports)
     (make-input-port
      (map object-name ports)
      (lambda (str)
@@ -815,7 +814,7 @@
             (loop half skip)))))))
 
 (define make-limited-input-port
-  (opt-lambda (port limit [close-orig? #t])
+  (lambda (port limit [close-orig? #t])
     (let ([got 0])
       (make-input-port
        (object-name port)
@@ -1208,13 +1207,13 @@
               (loop (add1 i) (add1 j))]))))]))
 
 (define reencode-input-port
-  (opt-lambda (port encoding [error-bytes #f] [close? #f]
+  (lambda (port encoding [error-bytes #f] [close? #f]
-                    [name (object-name port)]
+                [name (object-name port)]
-                    [newline-convert? #f]
+                [newline-convert? #f]
-                    [decode-error (lambda (msg port)
+                [decode-error (lambda (msg port)
-                                    (error 'reencode-input-port
+                                (error 'reencode-input-port
-                                           (format "~a: ~e" msg)
+                                       (format "~a: ~e" msg)
-                                           port))])
+                                       port))])
     (let ([c (let ([c (bytes-open-converter encoding "UTF-8")])
                (if newline-convert? (mcons c #f) c))]
           [ready-bytes (make-bytes 1024)]
@@ -1345,13 +1344,13 @@
 ;; --------------------------------------------------
 
 (define reencode-output-port
-  (opt-lambda (port encoding [error-bytes #f] [close? #f]
+  (lambda (port encoding [error-bytes #f] [close? #f]
-                    [name (object-name port)]
+                [name (object-name port)]
-                    [convert-newlines-to #f]
+                [convert-newlines-to #f]
-                    [decode-error (lambda (msg port)
+                [decode-error (lambda (msg port)
-                                    (error 'reencode-input-port
+                                (error 'reencode-input-port
-                                           (format "~a: ~e" msg)
+                                       (format "~a: ~e" msg)
-                                           port))])
+                                       port))])
     (let ([c (bytes-open-converter "UTF-8" encoding)]
           [ready-bytes (make-bytes 1024)]
           [ready-start 0]
@@ -1664,7 +1663,7 @@
 ;; ----------------------------------------
 
 (define dup-output-port
-  (opt-lambda (p [close? #f])
+  (lambda (p [close? #f])
     (let ([new (transplant-output-port
                 p
                 (lambda () (port-next-location p))
@@ -1677,7 +1676,7 @@
       new)))
 
 (define dup-input-port
-  (opt-lambda (p [close? #f])
+  (lambda (p [close? #f])
     (let ([new (transplant-input-port
                 p
                 (lambda () (port-next-location p))

collects/mzlib/pregexp.rkt

@@ -3,7 +3,7 @@
 ;;   ;Portable regular expressions for Scheme
 ;;   ;Dorai Sitaram
 ;;   ;http://www.ccs.neu.edu/~dorai/pregexp/pregexp.html
-;; but `pregexp' functionality is now built into MzScheme, so
+;; but `pregexp' functionality is now built into Racket, so
 ;; this is mostly a wrapper module.
 
 (module pregexp mzscheme

collects/mzlib/private/contract-arr-checks.rkt

@@ -1,7 +1,7 @@
-#lang scheme/base
+#lang racket/base
 
 (provide (all-defined-out))
-(require scheme/contract/private/guts)
+(require racket/contract/private/guts)
 
 (define empty-case-lambda/c
   (flat-named-contract '(case->)

collects/mzlib/private/contract-arr-obj-helpers.rkt

@@ -4,7 +4,7 @@
 
 (require (for-syntax scheme/base))
 (require (for-template scheme/base)
-         (for-template scheme/contract/private/guts)
+         (for-template racket/contract/private/guts)
          (for-template "contract-arr-checks.ss"))
 
 (provide make-/proc ->/h ->*/h ->d/h ->d*/h ->r/h 

collects/mzlib/private/contract-arrow.rkt

@@ -1,11 +1,11 @@
-#lang scheme/base
+#lang racket/base
 
-(require scheme/contract/private/guts
+(require racket/contract/private/guts
-         scheme/contract/private/opt
+         racket/contract/private/opt
          "contract-arr-checks.ss")
-(require (for-syntax scheme/base)
+(require (for-syntax racket/base)
-         (for-syntax scheme/contract/private/opt-guts)
+         (for-syntax racket/contract/private/opt-guts)
-         (for-syntax scheme/contract/private/helpers)
+         (for-syntax racket/contract/private/helpers)
          (for-syntax "contract-arr-obj-helpers.ss")
          (for-syntax syntax/stx)
          (for-syntax syntax/name))

collects/mzlib/private/contract-define.rkt

@@ -1,11 +1,11 @@
-#lang scheme/base
+#lang racket/base
 
 (provide define/contract)
 
-(require (for-syntax scheme/base
+(require (for-syntax racket/base
                      unstable/srcloc
-                     (prefix-in a: scheme/contract/private/helpers))
+                     (prefix-in a: racket/contract/private/helpers))
-         (only-in scheme/contract/private/base contract))
+         (only-in racket/contract/private/base contract))
 
 ;; First, we have the old define/contract implementation, which
 ;; is still used in mzlib/contract.

collects/mzlib/private/contract-object.rkt

@@ -1,11 +1,11 @@
-#lang scheme/base
+#lang racket/base
 (require "contract-arrow.ss"
-         scheme/contract/private/guts
+         racket/contract/private/guts
-         scheme/private/class-internal
+         racket/private/class-internal
          "contract-arr-checks.ss")
 
-(require (for-syntax scheme/base
+(require (for-syntax racket/base
-                     scheme/contract/private/helpers
+                     racket/contract/private/helpers
                      "contract-arr-obj-helpers.ss"))
 
 (provide mixin-contract

collects/mzlib/serialize.rkt

@@ -4,13 +4,13 @@
 	   mzlib/etc
 	   mzlib/list
            ;; core [de]serializer:
-           scheme/private/serialize)
+           racket/private/serialize)
 
   (provide define-serializable-struct
 	   define-serializable-struct/versions
 
            ;; core [de]serializer:
-           (all-from scheme/private/serialize))
+           (all-from racket/private/serialize))
 
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;; define-serializable-struct

collects/mzlib/shared.rkt

@@ -16,4 +16,4 @@
     (define make-check-cdr #f)
     ;; Include the implementation.
     ;; See private/shared-body.ss.
-    (include "private/shared-body.ss")))
+    (include "private/shared-body.rkt")))

collects/mzlib/unit.rkt

@@ -8,6 +8,7 @@
                      syntax/name
                      syntax/parse
                      syntax/struct
+                     scheme/struct-info
                      syntax/stx
                      unstable/location
                      "private/unit-contract-syntax.ss"
@@ -15,17 +16,19 @@
                      "private/unit-syntax.ss"))
   
 (require mzlib/etc
-         scheme/contract/base
+         racket/contract/base
          scheme/stxparam
          unstable/location
          "private/unit-contract.ss"
          "private/unit-keywords.ss"
          "private/unit-runtime.ss"
-         "private/unit-utils.ss")
+         "private/unit-utils.ss"
+         (rename-in racket/private/struct [struct struct~]))
 
 (provide define-signature-form struct struct/ctc open
          define-signature provide-signature-elements
          only except rename import export prefix link tag init-depend extends contracted
+         define-values-for-export
          unit?
          (rename-out [:unit unit]) define-unit 
          compound-unit define-compound-unit compound-unit/infer define-compound-unit/infer
@@ -35,7 +38,9 @@
          define-unit-binding
          unit/new-import-export define-unit/new-import-export
          unit/s define-unit/s
-         unit/c define-unit/contract)
+         unit/c define-unit/contract
+         struct~s struct~s/ctc
+         struct~r struct~r/ctc)
 
 (define-syntax/err-param (define-signature-form stx)
   (syntax-case stx ()
@@ -130,6 +135,168 @@
       ((_)
        (raise-stx-err "missing name and fields")))))
 
+(begin-for-syntax
+ (define-struct self-name-struct-info (id)
+   #:super struct:struct-info
+   #:property prop:procedure (lambda (me stx)
+                               (syntax-case stx ()
+                                 [(_ arg ...) (datum->syntax
+                                               stx
+                                               (cons ((self-name-struct-info-id me))
+                                                     #'(arg ...))
+                                               stx
+                                               stx)]
+                                 [_ (let ([id ((self-name-struct-info-id me))])
+                                      (datum->syntax id
+                                                      (syntax-e id)
+                                                      stx
+                                                      stx))]))
+   #:omit-define-syntaxes))
+
+(define-for-syntax option-keywords
+  "#:mutable, #:constructor-name, #:extra-constructor-name, #:omit-constructor, #:omit-define-syntaxes, or #:omit-define-values")
+
+;; Replacement `struct' signature form for `scheme/unit':
+(define-for-syntax (do-struct~ stx extra-make?)
+  (syntax-case stx ()
+    ((_ name (field ...) opt ...)
+     (begin
+       (unless (identifier? #'name)
+         (raise-syntax-error #f
+                             "expected an identifier to name the structure type"
+                             stx
+                             #'name))
+       (for-each (lambda (field)
+                   (unless (identifier? field)
+                     (syntax-case field ()
+                       [(id #:mutable)
+                        (identifier? #'id)
+                        'ok]
+                       [_
+                        (raise-syntax-error #f
+                                            "bad field specification"
+                                            stx
+                                            field)])))
+                 (syntax->list #'(field ...)))
+       (let*-values ([(no-ctr? mutable? no-stx? no-rt? opt-cname)
+                      (let loop ([opts (syntax->list #'(opt ...))]
+                                 [no-ctr? #f]
+                                 [mutable? #f]
+                                 [no-stx? #f]
+                                 [no-rt? #f]
+                                 [cname #f])
+                        (if (null? opts)
+                            (values no-ctr? mutable? no-stx? no-rt? cname)
+                            (let ([opt (car opts)])
+                              (case (syntax-e opt)
+                                [(#:constructor-name #:extra-constructor-name)
+                                 (if cname
+                                     (raise-syntax-error #f
+                                                         "redundant option"
+                                                         stx
+                                                         opt)
+                                     (if (null? (cdr opts))
+                                         (raise-syntax-error #f
+                                                             "missing identifier after option"
+                                                             stx
+                                                             opt)
+                                         (if (identifier? (cadr opts))
+                                             (loop (cddr opts) #f mutable? no-stx? no-rt?
+                                                   (if (eq? (syntax-e opt) '#:extra-constructor-name)
+                                                       (list (cadr opts))
+                                                       (cadr opts)))
+                                             (raise-syntax-error #f
+                                                                 "not an identifier for a constructor name"
+                                                                 stx
+                                                                 (cadr opts)))))]
+                                [(#:omit-constructor)
+                                 (if no-ctr?
+                                     (raise-syntax-error #f
+                                                         "redundant option"
+                                                         stx
+                                                         opt)
+                                     (loop (cdr opts) #t mutable? no-stx? no-rt? cname))]
+                                [(#:mutable)
+                                 (if mutable?
+                                     (raise-syntax-error #f
+                                                         "redundant option"
+                                                         stx
+                                                         opt)
+                                     (loop (cdr opts) no-ctr? #t no-stx? no-rt? cname))]
+                                [(#:omit-define-syntaxes)
+                                 (if no-stx?
+                                     (raise-syntax-error #f
+                                                         "redundant option"
+                                                         stx
+                                                         opt)
+                                     (loop (cdr opts) no-ctr? mutable? #t no-rt? cname))]
+                                [(#:omit-define-values)
+                                 (if no-rt?
+                                     (raise-syntax-error #f
+                                                         "redundant option"
+                                                         stx
+                                                         opt)
+                                     (loop (cdr opts) no-ctr? mutable? no-stx? #t cname))]
+                                [else
+                                 (raise-syntax-error #f
+                                                     (string-append
+                                                      "expected a keyword to specify option: "
+                                                      option-keywords)
+                                                     stx
+                                                     opt)]))))]
+                     [(def-cname) (cond
+                                   [opt-cname (if (pair? opt-cname)
+                                                  (car opt-cname)
+                                                  opt-cname)]
+                                   [extra-make? #f]
+                                   [else (car (generate-temporaries #'(name)))])]
+                     [(cname) (cond
+                               [opt-cname (if (pair? opt-cname)
+                                              (cons def-cname #'name)
+                                              (cons opt-cname opt-cname))]
+                               [extra-make? #f]
+                               [else (cons def-cname #'name)])]
+                     [(self-ctr?) (and cname (bound-identifier=? #'name (cdr cname)))])
+         (cons
+          #`(define-syntaxes (name)
+              #,(let ([e (build-struct-expand-info
+                          #'name (syntax->list #'(field ...))
+                          #f (not mutable?)
+                          #f '(#f) '(#f)
+                          #:omit-constructor? no-ctr?
+                          #:constructor-name def-cname)])
+                  (if self-ctr?
+                      #`(make-self-name-struct-info 
+                         (lambda () #,e)
+                         (lambda () (quote-syntax #,def-cname)))
+                      e)))
+          (let ([names (build-struct-names #'name (syntax->list #'(field ...))
+                                           #f (not mutable?)
+                                           #:constructor-name def-cname)])
+            (cond
+             [no-ctr? (cons (car names) (cddr names))]
+             [self-ctr? (cons #`(define-values-for-export (#,def-cname) name) 
+                              names)]
+             [else names]))))))
+    ((_ name fields opt ...)
+     (raise-syntax-error #f
+                         "bad syntax; expected a parenthesized sequence of fields"
+                         stx
+                         #'fields))
+    ((_ name)
+     (raise-syntax-error #f
+                         "bad syntax; missing fields"
+                         stx))
+    ((_)
+     (raise-syntax-error #f
+                         "missing name and fields"
+                         stx))))
+
+(define-signature-form (struct~s stx)
+  (do-struct~ stx #t))
+(define-signature-form (struct~r stx)
+  (do-struct~ stx #f))
+
 (define-signature-form (struct/ctc stx)
   (parameterize ((error-syntax stx))
     (syntax-case stx ()
@@ -214,28 +381,205 @@
       ((_)
        (raise-stx-err "missing name and fields")))))
 
+;; Replacement struct/ctc form for `scheme/unit':
+(define-for-syntax (do-struct~/ctc stx extra-make?)
+  (syntax-case stx ()
+    ((_ name ([field ctc] ...) opt ...)
+     (begin
+       (unless (identifier? #'name)
+         (raise-syntax-error #f
+                             "expected an identifier to name the structure type"
+                             stx
+                             #'name))
+       (for-each (lambda (field)
+                   (unless (identifier? field)
+                     (syntax-case field ()
+                       [(id #:mutable)
+                        (identifier? #'id)
+                        'ok]
+                       [_
+                        (raise-syntax-error #f
+                                            "bad field specification"
+                                            stx
+                                            field)])))
+                 (syntax->list #'(field ...)))
+       (let*-values ([(no-ctr? mutable? no-stx? no-rt? opt-cname)
+                      (let loop ([opts (syntax->list #'(opt ...))]
+                                 [no-ctr? #f]
+                                 [mutable? #f]
+                                 [no-stx? #f]
+                                 [no-rt? #f]
+                                 [cname #f])
+                        (if (null? opts)
+                            (values no-ctr? mutable? no-stx? no-rt? cname)
+                            (let ([opt (car opts)])
+                              (case (syntax-e opt)
+                                [(#:constructor-name #:extra-constructor-name)
+                                 (if cname
+                                     (raise-syntax-error #f
+                                                         "redundant option"
+                                                         stx
+                                                         opt)
+                                     (if (null? (cdr opts))
+                                         (raise-syntax-error #f
+                                                             "missing identifier after option"
+                                                             stx
+                                                             opt)
+                                         (if (identifier? (cadr opts))
+                                             (loop (cddr opts) #f mutable? no-stx? no-rt?
+                                                   (if (eq? (syntax-e opt) '#:extra-constructor-name)
+                                                       (list (cadr opts))
+                                                       (cadr opts)))
+                                             (raise-syntax-error #f
+                                                                 "not an identifier for a constructor name"
+                                                                 stx
+                                                                 (cadr opts)))))]
+                                [(#:omit-constructor)
+                                 (if no-ctr?
+                                     (raise-syntax-error #f
+                                                         "redundant option"
+                                                         stx
+                                                         opt)
+                                     (loop (cdr opts) #t mutable? no-stx? no-rt? cname))]
+                                [(#:mutable)
+                                 (if mutable?
+                                     (raise-syntax-error #f
+                                                         "redundant option"
+                                                         stx
+                                                         opt)
+                                     (loop (cdr opts) no-ctr? #t no-stx? no-rt? cname))]
+                                [(#:omit-define-syntaxes)
+                                 (if no-stx?
+                                     (raise-syntax-error #f
+                                                         "redundant option"
+                                                         stx
+                                                         opt)
+                                     (loop (cdr opts) no-ctr? mutable? #t no-rt? cname))]
+                                [(#:omit-define-values)
+                                 (if no-rt?
+                                     (raise-syntax-error #f
+                                                         "redundant option"
+                                                         stx
+                                                         opt)
+                                     (loop (cdr opts) no-ctr? mutable? no-stx? #t cname))]
+                                [else
+                                 (raise-syntax-error #f
+                                                     (string-append
+                                                      "expected a keyword to specify option: "
+                                                      option-keywords)
+                                                     stx
+                                                     opt)]))))]
+                     [(def-cname) (cond
+                                   [opt-cname (if (pair? opt-cname)
+                                                  (car opt-cname)
+                                                  opt-cname)]
+                                   [extra-make? #f]
+                                   [else (car (generate-temporaries #'(name)))])]
+                     [(cname) (cond
+                               [opt-cname (if (pair? opt-cname)
+                                              (cons def-cname #'name)
+                                              (cons def-cname def-cname))]
+                               [extra-make? #f]
+                               [else (cons def-cname #'name)])]
+                     [(self-ctr?) (and cname (bound-identifier=? #'name (cdr cname)))])
+         (define (add-contracts l)
+           (let* ([pred (caddr l)]
+                  [ctor-ctc #`(-> ctc ... #,pred)]
+                  [pred-ctc #'(-> any/c boolean?)]
+                  [field-ctcs
+                   (apply append
+                          (map (λ (f c)
+                                  (cons #`(-> #,pred #,c)
+                                        (if (and (not mutable?)
+                                                 (not (pair? (syntax-e f))))
+                                            null
+                                            #`(-> #,pred #,c void?))))
+                               (syntax->list #'(field ...))
+                               (syntax->list #'(ctc ...))))])
+             (list* (car l)
+                    (list (cadr l) ctor-ctc)
+                    (list pred pred-ctc)
+                    (map list (cdddr l) field-ctcs))))
+         (cons
+          #`(define-syntaxes (name)
+              #,(let ([e (build-struct-expand-info
+                          #'name (syntax->list #'(field ...))
+                          #f (not mutable?)
+                          #f '(#f) '(#f)
+                          #:omit-constructor? no-ctr?
+                          #:constructor-name def-cname)])
+                  (if self-ctr?
+                      #`(make-self-name-struct-info 
+                         (lambda () #,e)
+                         (lambda () (quote-syntax #,def-cname)))
+                      e)))
+          (let* ([names (add-contracts
+                         (build-struct-names #'name (syntax->list #'(field ...))
+                                             #f (not mutable?)
+                                             #:constructor-name def-cname))]
+                 [cpairs (cons 'contracted
+                               (cond
+                                [no-ctr? (cddr names)]
+                                [else (cdr names)]))]
+                 [l (list (car names) cpairs)])
+            (if self-ctr?
+                (cons #`(define-values-for-export (#,def-cname) name) l)
+                l))))))
+    ((_ name fields opt ...)
+     (raise-syntax-error #f
+                         "bad syntax; expected a parenthesized sequence of fields"
+                         stx
+                         #'fields))
+    ((_ name)
+     (raise-syntax-error #f
+                         "bad syntax; missing fields"
+                         stx))
+    ((_)
+     (raise-syntax-error #f
+                         "missing name and fields"
+                         stx))))
+
+(define-signature-form (struct~s/ctc stx)
+  (do-struct~/ctc stx #t))
+(define-signature-form (struct~r/ctc stx)
+  (do-struct~/ctc stx #f))
 
 ;; build-val+macro-defs : sig -> (list syntax-object^3)
 (define-for-syntax (build-val+macro-defs sig)
   (with-syntax ([(((int-ivar . ext-ivar) ...)
                   ((((int-vid . ext-vid) ...) . vbody) ...)
                   ((((int-sid . ext-sid) ...) . sbody) ...)
-                  (cbody ...))
+                  _
+                  _)
                  (map-sig (lambda (x) x)
                           (make-syntax-introducer)
                           sig)])
     (list
      #'((ext-ivar ... ext-vid ... ... ext-sid ... ...)
         (values
-         (make-rename-transformer 
+         (make-rename-transformer (quote-syntax int-ivar)) ...
-          (quote-syntax int-ivar)) ...
+         (make-rename-transformer (quote-syntax int-vid)) ... ...
-                                   (make-rename-transformer
+         (make-rename-transformer (quote-syntax int-sid)) ... ...))
-                                    (quote-syntax int-vid)) ... ...
-                                                            (make-rename-transformer
-                                                             (quote-syntax int-sid)) ... ...))
      #'(((int-sid ...) sbody) ...)
      #'(((int-vid ...) vbody) ...))))
 
+;; build-post-val-defs : sig -> (list syntax-object)
+(define-for-syntax (build-post-val-defs sig)
+  (with-syntax ([(((int-ivar . ext-ivar) ...)
+                  ((((int-vid . ext-vid) ...) . _) ...)
+                  ((((int-sid . ext-sid) ...) . _) ...)
+                  _
+                  (((post-id ...) . post-rhs) ...))
+                 (map-sig (lambda (x) x)
+                          (make-syntax-introducer)
+                          sig)])
+    (list
+     #'((ext-ivar ... ext-vid ... ... ext-sid ... ...)
+        (values
+         (make-rename-transformer (quote-syntax int-ivar)) ...
+         (make-rename-transformer (quote-syntax int-vid)) ... ...
+         (make-rename-transformer (quote-syntax int-sid)) ... ...))
+     #'(post-rhs ...))))
 
 (define-signature-form (open stx)
   (define (build-sig-elems sig)
@@ -261,7 +605,9 @@
       (_
        (raise-stx-err (format "must match (~a export-spec)"
                               (syntax-e (stx-car stx))))))))
-  
+
+(define-signature-form (define-values-for-export stx)
+  (raise-syntax-error #f "internal error" stx))
 
 (define-for-syntax (introduce-def d)
   (cons (map syntax-local-introduce (car d))
@@ -273,7 +619,8 @@
     (raise-stx-err "expected syntax matching (sig-expr ...)" sig-exprs))
   (let ([ses (checked-syntax->list sig-exprs)])
     (define-values (super-names super-ctimes super-rtimes super-bindings
-                                super-val-defs super-stx-defs super-ctcs)
+                                super-val-defs super-stx-defs super-post-val-defs 
+                                super-ctcs)
       (if super-sigid
           (let* ([super-sig (lookup-signature super-sigid)]
                  [super-siginfo (signature-siginfo super-sig)])
@@ -284,22 +631,25 @@
                     (map syntax-local-introduce (signature-vars super-sig))
                     (map introduce-def (signature-val-defs super-sig))
                     (map introduce-def (signature-stx-defs super-sig))
+                    (map introduce-def (signature-post-val-defs super-sig))
                     (map (lambda (ctc)
                            (if ctc
                                (syntax-local-introduce ctc)
                                ctc))
                          (signature-ctcs super-sig))))
-          (values '() '() '() '() '() '() '())))
+          (values '() '() '() '() '() '() '() '())))
     (let loop ((sig-exprs ses)
                (bindings null)
                (val-defs null)
                (stx-defs null)
+               (post-val-defs null)
                (ctcs null))
       (cond
         ((null? sig-exprs)
          (let* ([all-bindings (append super-bindings (reverse bindings))]
                 [all-val-defs (append super-val-defs (reverse val-defs))]
                 [all-stx-defs (append super-stx-defs (reverse stx-defs))]
+                [all-post-val-defs (append super-post-val-defs (reverse post-val-defs))]
                 [all-ctcs (append super-ctcs (reverse ctcs))]
                 [dup
                  (check-duplicate-identifier
@@ -313,7 +663,8 @@
                          ((var ...) all-bindings)
                          ((ctc ...) all-ctcs)
                          ((((vid ...) . vbody) ...) all-val-defs)
-                         ((((sid ...) . sbody) ...) all-stx-defs))
+                         ((((sid ...) . sbody) ...) all-stx-defs)
+                         ((((pvid ...) . pvbody) ...) all-post-val-defs))
              #`(begin
                  (define signature-tag (gensym))
                  (define-syntax #,sigid
@@ -332,6 +683,10 @@
                                  ((syntax-local-certifier)
                                   (quote-syntax sbody)))
                            ...)
+                     (list (cons (list (quote-syntax pvid) ...)
+                                 ((syntax-local-certifier)
+                                  (quote-syntax pvbody)))
+                           ...)
                      (list #,@(map (lambda (c) 
                                      (if c
                                          #`((syntax-local-certifier)
@@ -351,7 +706,7 @@
          (syntax-case (car sig-exprs) (define-values define-syntaxes contracted)
            (x
             (identifier? #'x)
-            (loop (cdr sig-exprs) (cons #'x bindings) val-defs stx-defs (cons #f ctcs)))
+            (loop (cdr sig-exprs) (cons #'x bindings) val-defs stx-defs post-val-defs (cons #f ctcs)))
            ((x (y z) ...)
             (and (identifier? #'x)
                  (free-identifier=? #'x #'contracted)
@@ -360,6 +715,7 @@
                   (append (syntax->list #'(y ...)) bindings)
                   val-defs
                   stx-defs
+                  post-val-defs
                   (append (syntax->list #'(z ...)) ctcs)))
            ((x . z)
             (and (identifier? #'x)
@@ -371,7 +727,8 @@
            ((x . y)
             (and (identifier? #'x)
                  (or (free-identifier=? #'x #'define-values)
-                     (free-identifier=? #'x #'define-syntaxes)))
+                     (free-identifier=? #'x #'define-syntaxes)
+                     (free-identifier=? #'x #'define-values-for-export)))
             (begin
               (check-def-syntax (car sig-exprs))
               (syntax-case #'y ()
@@ -390,12 +747,19 @@
                                (cons (cons (syntax->list #'(name ...)) b)
                                      stx-defs)
                                stx-defs)
+                           (if (free-identifier=? #'x #'define-values-for-export)
+                               (cons (cons (syntax->list #'(name ...)) b)
+                                     post-val-defs)
+                               post-val-defs)
                            ctcs)))))))
            ((x . y)
             (let ((trans 
                    (set!-trans-extract
                     (syntax-local-value
-                     (syntax-local-introduce #'x)
+                     ;; redirect struct~ to struct~r
+                     (if (free-identifier=? #'x #'struct~)
+                         #'struct~r
+                         (syntax-local-introduce #'x))
                      (lambda ()
                        (raise-stx-err "unknown signature form" #'x))))))
               (unless (signature-form? trans)
@@ -409,6 +773,7 @@
                       bindings
                       val-defs
                       stx-defs
+                      post-val-defs
                       ctcs))))
            (x (raise-stx-err 
                "expected either an identifier or signature form"
@@ -532,6 +897,8 @@
                       (map build-val+macro-defs import-sigs)]
                      [(((int-ivar . ext-ivar) ...) ...) (map car import-sigs)]
                      [(((int-evar . ext-evar) ...) ...) (map car export-sigs)]
+                     [((((e-post-id ...) . _) ...) ...) (map (lambda (s) (list-ref s 4)) export-sigs)]
+                     [((post-renames (e-post-rhs ...)) ...) (map build-post-val-defs export-sigs)]
                      [((iloc ...) ...)
                       (map (lambda (x) (generate-temporaries (car x))) import-sigs)]
                      [((eloc ...) ...)
@@ -602,7 +969,10 @@
                                                       (int-evar ... ...)
                                                       (eloc ... ...)
                                                       (ectc ... ...)
-                                                      . body)))))
+                                                      (begin . body)
+                                                      (define-values (e-post-id ...) 
+                                                        (letrec-syntaxes+values (post-renames ...) ()
+                                                          e-post-rhs)) ... ...)))))
                     (unit-export ((export-key ...) (vector-immutable (λ () (unbox eloc)) ...)) ...)))))))
           import-tagged-sigids
           export-tagged-sigids

collects/mzlib/zip.rkt

@@ -249,7 +249,7 @@
   (define/kw (zip->output files #:optional [out (current-output-port)])
     (parameterize ([current-output-port out])
       (let* ([seekable? (seekable-port? (current-output-port))]
-             [headers ; note: MzScheme's `map' is always left-to-right
+             [headers ; note: Racket's `map' is always left-to-right
               (map (lambda (file)
                      (zip-one-entry (build-metadata file) seekable?))
                    files)])

collects/net/cgi-unit.rkt

@@ -68,9 +68,9 @@
                ""
                "<html>"
                "<!-- The form was processed, and this document was generated,"
-               "     using the CGI utilities for MzScheme.  For more information"
+               "     using the CGI utilities for Racket.  For more information"
-               "     on MzScheme, see"
+               "     on Racket, see"
-               "      http://www.plt-scheme.org/software/mzscheme/"
+               "       http://racket-lang.org/"
                "     and for the CGI utilities, contact"
                "     (sk@cs.brown.edu). -->"
                "<head>"

collects/net/cookie-unit.rkt

@@ -255,7 +255,7 @@
 ;; appear as a block to be legal, and " may only appear as \"
 (define (rfc2068:quoted-string? s)
   (and (regexp-match?
-        #rx"^\"([^\"#\u0000-#\u001F]| |#\return#\newline|#\tab|\\\\\")*\"$"
+        #rx"^\"([^\"\u0000-\u001F]| |\r\n|\t|\\\\\")*\"$"
         s)
        s))
 

collects/net/sendmail-unit.rkt

@@ -88,7 +88,7 @@
         (unless (null? cc-recipients)
           (write-recipient-header "CC" cc-recipients)))
       (fprintf writer "Subject: ~a\n" subject)
-      (fprintf writer "X-Mailer: MzScheme: see www.plt-scheme.org\n")
+      (fprintf writer "X-Mailer: Racket (racket-lang.org)\n")
       (for-each (lambda (s)
                   (display s writer)
                   (newline writer))