diff --git a/collects/mzlib/class.ss b/collects/mzlib/class.ss
index 55e0f0d..4e2e272 100644
--- a/collects/mzlib/class.ss
+++ b/collects/mzlib/class.ss
@@ -1,3 +1,3 @@
 (module class mzscheme
-  (require scheme/private/class-internal)
+  (require racket/private/class-internal)
   (provide-public-names))
diff --git a/collects/mzlib/contract.ss b/collects/mzlib/contract.ss
index 3c6ef88..8516d28 100644
--- a/collects/mzlib/contract.ss
+++ b/collects/mzlib/contract.ss
@@ -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
-         scheme/contract/private/misc
-         scheme/contract/private/provide
-         scheme/contract/private/guts
-         scheme/contract/private/ds
-         scheme/contract/private/opt
-         scheme/contract/private/basic-opters)
+(require racket/contract/private/base
+         racket/contract/private/misc
+         racket/contract/private/provide
+         racket/contract/private/guts
+         racket/contract/private/ds
+         racket/contract/private/opt
+         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 scheme/contract/private/provide)
- (except-out (all-from-out scheme/contract/private/misc)
+ (all-from-out racket/contract/private/base)
+ (all-from-out racket/contract/private/provide)
+ (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)
diff --git a/collects/mzlib/etc.ss b/collects/mzlib/etc.ss
index c9b28bb..9add9b9 100644
--- a/collects/mzlib/etc.ss
+++ b/collects/mzlib/etc.ss
@@ -1,8 +1,8 @@
 #lang mzscheme
 
 (require setup/main-collects
-         scheme/local
-         scheme/bool
+         racket/local
+         racket/bool
          (only scheme/base
                build-string
                build-list
diff --git a/collects/mzlib/list.ss b/collects/mzlib/list.ss
index c8b3a4d..ed658ee 100644
--- a/collects/mzlib/list.ss
+++ b/collects/mzlib/list.ss
@@ -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
-               foldl
-               foldr
-
-               remv
-               remq
-               remove
-               remv*
-               remq*
-               remove*
-
-               findf
-               memf
-               assf
-
-               filter
-
-               sort)
-         (only scheme/list
-               cons?
-               empty?
-               empty
-               last-pair))
+(require (only-in scheme/list
+                  cons?
+                  empty?
+                  empty
+                  last-pair))
 
 (provide first
          second
diff --git a/collects/mzlib/match.ss b/collects/mzlib/match.ss
index d38a78a..8362e9a 100644
--- a/collects/mzlib/match.ss
+++ b/collects/mzlib/match.ss
@@ -1,4 +1,4 @@
-#lang scheme/base
+#lang racket/base
 
-(require scheme/match/legacy-match)
-(provide (all-from-out scheme/match/legacy-match))
+(require racket/match/legacy-match)
+(provide (all-from-out racket/match/legacy-match))
diff --git a/collects/mzlib/plt-match.ss b/collects/mzlib/plt-match.ss
index 84e08e6..add845a 100644
--- a/collects/mzlib/plt-match.ss
+++ b/collects/mzlib/plt-match.ss
@@ -1,4 +1,4 @@
 #lang scheme/base
 
-(require scheme/match/match)
-(provide (all-from-out scheme/match/match))
+(require racket/match/match)
+(provide (all-from-out racket/match/match))
diff --git a/collects/mzlib/port.ss b/collects/mzlib/port.ss
index 56b1203..c588143 100644
--- a/collects/mzlib/port.ss
+++ b/collects/mzlib/port.ss
@@ -1,8 +1,7 @@
-#lang scheme/base
+#lang racket/base
 
-(require (for-syntax scheme/base)
-         mzlib/etc
-         scheme/contract/base
+(require (for-syntax racket/base)
+         racket/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
-                    [location-proc #f]
-                    [count-lines!-proc void]
-                    [init-position 1]
-                    [buffer-mode-proc #f]
-                    [buffering? #f]
-                    [on-consumed #f])
+  (lambda (name read fast-peek close
+                [location-proc #f]
+                [count-lines!-proc void]
+                [init-position 1]
+                [buffer-mode-proc #f]
+                [buffering? #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]
-                    [name (object-name port)]
-                    [newline-convert? #f]
-                    [decode-error (lambda (msg port)
-                                    (error 'reencode-input-port
-                                           (format "~a: ~e" msg)
-                                           port))])
+  (lambda (port encoding [error-bytes #f] [close? #f]
+                [name (object-name port)]
+                [newline-convert? #f]
+                [decode-error (lambda (msg port)
+                                (error 'reencode-input-port
+                                       (format "~a: ~e" msg)
+                                       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]
-                    [name (object-name port)]
-                    [convert-newlines-to #f]
-                    [decode-error (lambda (msg port)
-                                    (error 'reencode-input-port
-                                           (format "~a: ~e" msg)
-                                           port))])
+  (lambda (port encoding [error-bytes #f] [close? #f]
+                [name (object-name port)]
+                [convert-newlines-to #f]
+                [decode-error (lambda (msg port)
+                                (error 'reencode-input-port
+                                       (format "~a: ~e" msg)
+                                       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))
diff --git a/collects/mzlib/private/contract-arr-checks.ss b/collects/mzlib/private/contract-arr-checks.ss
index 5410d74..9bbb341 100644
--- a/collects/mzlib/private/contract-arr-checks.ss
+++ b/collects/mzlib/private/contract-arr-checks.ss
@@ -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->)
diff --git a/collects/mzlib/private/contract-arr-obj-helpers.ss b/collects/mzlib/private/contract-arr-obj-helpers.ss
index cb38466..5123ffd 100644
--- a/collects/mzlib/private/contract-arr-obj-helpers.ss
+++ b/collects/mzlib/private/contract-arr-obj-helpers.ss
@@ -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 
diff --git a/collects/mzlib/private/contract-arrow.ss b/collects/mzlib/private/contract-arrow.ss
index 2b13878..038951a 100644
--- a/collects/mzlib/private/contract-arrow.ss
+++ b/collects/mzlib/private/contract-arrow.ss
@@ -1,11 +1,11 @@
-#lang scheme/base
+#lang racket/base
 
-(require scheme/contract/private/guts
-         scheme/contract/private/opt
+(require racket/contract/private/guts
+         racket/contract/private/opt
          "contract-arr-checks.ss")
-(require (for-syntax scheme/base)
-         (for-syntax scheme/contract/private/opt-guts)
-         (for-syntax scheme/contract/private/helpers)
+(require (for-syntax racket/base)
+         (for-syntax racket/contract/private/opt-guts)
+         (for-syntax racket/contract/private/helpers)
          (for-syntax "contract-arr-obj-helpers.ss")
          (for-syntax syntax/stx)
          (for-syntax syntax/name))
diff --git a/collects/mzlib/private/contract-define.ss b/collects/mzlib/private/contract-define.ss
index 4cece1f..faad09a 100644
--- a/collects/mzlib/private/contract-define.ss
+++ b/collects/mzlib/private/contract-define.ss
@@ -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))
-         (only-in scheme/contract/private/base contract))
+                     (prefix-in a: racket/contract/private/helpers))
+         (only-in racket/contract/private/base contract))
 
 ;; First, we have the old define/contract implementation, which
 ;; is still used in mzlib/contract.
diff --git a/collects/mzlib/private/contract-object.ss b/collects/mzlib/private/contract-object.ss
index 7b7579f..66cc2c5 100644
--- a/collects/mzlib/private/contract-object.ss
+++ b/collects/mzlib/private/contract-object.ss
@@ -1,11 +1,11 @@
-#lang scheme/base
+#lang racket/base
 (require "contract-arrow.ss"
-         scheme/contract/private/guts
-         scheme/private/class-internal
+         racket/contract/private/guts
+         racket/private/class-internal
          "contract-arr-checks.ss")
 
-(require (for-syntax scheme/base
-                     scheme/contract/private/helpers
+(require (for-syntax racket/base
+                     racket/contract/private/helpers
                      "contract-arr-obj-helpers.ss"))
 
 (provide mixin-contract
diff --git a/collects/mzlib/serialize.ss b/collects/mzlib/serialize.ss
index ed816f9..e455013 100644
--- a/collects/mzlib/serialize.ss
+++ b/collects/mzlib/serialize.ss
@@ -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
diff --git a/collects/mzlib/unit.ss b/collects/mzlib/unit.ss
index 5a0d8b5..119774a 100644
--- a/collects/mzlib/unit.ss
+++ b/collects/mzlib/unit.ss
@@ -16,7 +16,7 @@
                      "private/unit-syntax.ss"))
   
 (require mzlib/etc
-         scheme/contract/base
+         racket/contract/base
          scheme/stxparam
          unstable/location
          "private/unit-contract.ss"
@@ -142,19 +142,22 @@
                                (syntax-case stx ()
                                  [(_ arg ...) (datum->syntax
                                                stx
-                                               (cons (self-name-struct-info-id me)
+                                               (cons ((self-name-struct-info-id me))
                                                      #'(arg ...))
                                                stx
                                                stx)]
-                                 [_ (let ([id (self-name-struct-info-id me)])
+                                 [_ (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 type-as-ctr?)
+(define-for-syntax (do-struct~ stx extra-make?)
   (syntax-case stx ()
     ((_ name (field ...) opt ...)
      (begin
@@ -175,53 +178,85 @@
                                             stx
                                             field)])))
                  (syntax->list #'(field ...)))
-       (let-values ([(no-ctr? mutable? no-stx? no-rt?)
-                     (let loop ([opts (syntax->list #'(opt ...))]
-                                [no-ctr? #f]
-                                [mutable? #f]
-                                [no-stx? #f]
-                                [no-rt? #f])
-                       (if (null? opts)
-                           (values no-ctr? mutable? no-stx? no-rt?)
-                           (let ([opt (car opts)])
-                             (case (syntax-e opt)
-                               [(#:omit-constructor)
-                                (if no-ctr?
-                                    (raise-syntax-error #f
-                                                        "redundant option"
-                                                        stx
-                                                        opt)
-                                    (loop (cdr opts) #t mutable? no-stx? no-rt?))]
-                               [(#:mutable)
-                                (if mutable?
-                                    (raise-syntax-error #f
-                                                        "redundant option"
-                                                        stx
-                                                        opt)
-                                    (loop (cdr opts) no-ctr? #t no-stx? no-rt?))]
-                               [(#:omit-define-syntaxes)
-                                (if no-stx?
-                                    (raise-syntax-error #f
-                                                        "redundant option"
-                                                        stx
-                                                        opt)
-                                    (loop (cdr opts) no-ctr? mutable? #t no-rt?))]
-                               [(#:omit-define-values)
-                                (if no-rt?
-                                    (raise-syntax-error #f
-                                                        "redundant option"
-                                                        stx
-                                                        opt)
-                                    (loop (cdr opts) no-ctr? mutable? no-stx? #t))]
-                               [else
-                                (raise-syntax-error #f
-                                                    (string-append
-                                                     "expected a keyword to specify option: "
-                                                     "#:mutable, #:omit-constructor, #:omit-define-syntaxes, or #:omit-define-values")
-                                                    stx
-                                                    opt)]))))]
-                    [(tmp-name) (and type-as-ctr?
-                                     (car (generate-temporaries #'(name))))])
+       (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
@@ -229,19 +264,19 @@
                           #f (not mutable?)
                           #f '(#f) '(#f)
                           #:omit-constructor? no-ctr?
-                          #:constructor-name (and type-as-ctr? (cons #'name tmp-name)))])
-                  (if type-as-ctr?
+                          #:constructor-name def-cname)])
+                  (if self-ctr?
                       #`(make-self-name-struct-info 
                          (lambda () #,e)
-                         (quote-syntax #,tmp-name))
+                         (lambda () (quote-syntax #,def-cname)))
                       e)))
           (let ([names (build-struct-names #'name (syntax->list #'(field ...))
                                            #f (not mutable?)
-                                           #:constructor-name (and type-as-ctr? 
-                                                                   (cons #'name tmp-name)))])
+                                           #:constructor-name def-cname)])
             (cond
              [no-ctr? (cons (car names) (cddr names))]
-             [tmp-name (cons #`(define-values-for-export (#,tmp-name) name) names)]
+             [self-ctr? (cons #`(define-values-for-export (#,def-cname) name) 
+                              names)]
              [else names]))))))
     ((_ name fields opt ...)
      (raise-syntax-error #f
@@ -258,9 +293,9 @@
                          stx))))
 
 (define-signature-form (struct~s stx)
-  (do-struct~ stx #f))
-(define-signature-form (struct~r 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))
@@ -347,7 +382,7 @@
        (raise-stx-err "missing name and fields")))))
 
 ;; Replacement struct/ctc form for `scheme/unit':
-(define-for-syntax (do-struct~/ctc stx type-as-ctr?)
+(define-for-syntax (do-struct~/ctc stx extra-make?)
   (syntax-case stx ()
     ((_ name ([field ctc] ...) opt ...)
      (begin
@@ -368,53 +403,85 @@
                                             stx
                                             field)])))
                  (syntax->list #'(field ...)))
-       (let-values ([(no-ctr? mutable? no-stx? no-rt?)
-                     (let loop ([opts (syntax->list #'(opt ...))]
-                                [no-ctr? #f]
-                                [mutable? #f]
-                                [no-stx? #f]
-                                [no-rt? #f])
-                       (if (null? opts)
-                           (values no-ctr? mutable? no-stx? no-rt?)
-                           (let ([opt (car opts)])
-                             (case (syntax-e opt)
-                               [(#:omit-constructor)
-                                (if no-ctr?
-                                    (raise-syntax-error #f
-                                                        "redundant option"
-                                                        stx
-                                                        opt)
-                                    (loop (cdr opts) #t mutable? no-stx? no-rt?))]
-                               [(#:mutable)
-                                (if mutable?
-                                    (raise-syntax-error #f
-                                                        "redundant option"
-                                                        stx
-                                                        opt)
-                                    (loop (cdr opts) no-ctr? #t no-stx? no-rt?))]
-                               [(#:omit-define-syntaxes)
-                                (if no-stx?
-                                    (raise-syntax-error #f
-                                                        "redundant option"
-                                                        stx
-                                                        opt)
-                                    (loop (cdr opts) no-ctr? mutable? #t no-rt?))]
-                               [(#:omit-define-values)
-                                (if no-rt?
-                                    (raise-syntax-error #f
-                                                        "redundant option"
-                                                        stx
-                                                        opt)
-                                    (loop (cdr opts) no-ctr? mutable? no-stx? #t))]
-                               [else
-                                (raise-syntax-error #f
-                                                    (string-append
-                                                     "expected a keyword to specify option: "
-                                                     "#:mutable, #:omit-constructor, #:omit-define-syntaxes, or #:omit-define-values")
-                                                    stx
-                                                    opt)]))))]
-                    [(tmp-name) (and type-as-ctr?
-                                     (car (generate-temporaries #'(name))))])
+       (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)]
@@ -435,20 +502,29 @@
                     (map list (cdddr l) field-ctcs))))
          (cons
           #`(define-syntaxes (name)
-              #,(build-struct-expand-info
-                 #'name (syntax->list #'(field ...))
-                 #f (not mutable?)
-                 #f '(#f) '(#f)
-                 #:omit-constructor? no-ctr?
-                 #:constructor-name (and type-as-ctr? (cons #'name tmp-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 (and type-as-ctr? 
-                                                                     (cons #'name tmp-name))))]
+                                             #:constructor-name def-cname))]
                  [cpairs (cons 'contracted
-                               (if no-ctr? (cddr names) (cdr names)))])
-            (list (car names) cpairs))))))
+                               (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"
@@ -464,9 +540,9 @@
                          stx))))
 
 (define-signature-form (struct~s/ctc stx)
-  (do-struct~/ctc stx #f))
-(define-signature-form (struct~r/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)
diff --git a/collects/scheme/mpair.ss b/collects/racket/mpair.rkt
similarity index 100%
rename from collects/scheme/mpair.ss
rename to collects/racket/mpair.rkt
diff --git a/collects/scheme/package.ss b/collects/racket/package.rkt
similarity index 100%
rename from collects/scheme/package.ss
rename to collects/racket/package.rkt
diff --git a/collects/scheme/private/old-ds.ss b/collects/racket/private/old-ds.rkt
similarity index 100%
rename from collects/scheme/private/old-ds.ss
rename to collects/racket/private/old-ds.rkt
diff --git a/collects/scheme/private/old-if.ss b/collects/racket/private/old-if.rkt
similarity index 100%
rename from collects/scheme/private/old-if.ss
rename to collects/racket/private/old-if.rkt
diff --git a/collects/scheme/private/old-procs.ss b/collects/racket/private/old-procs.rkt
similarity index 96%
rename from collects/scheme/private/old-procs.ss
rename to collects/racket/private/old-procs.rkt
index 7a074fd..632acb6 100644
--- a/collects/scheme/private/old-procs.ss
+++ b/collects/racket/private/old-procs.rkt
@@ -1,10 +1,10 @@
 
 (module old-procs '#%kernel
-  (#%require "small-scheme.ss"
-             "more-scheme.ss"
-             "misc.ss"
-             "stxmz-body.ss"
-             "define.ss")
+  (#%require "small-scheme.rkt"
+             "more-scheme.rkt"
+             "misc.rkt"
+             "stxmz-body.rkt"
+             "define.rkt")
 
   (#%provide make-namespace
              free-identifier=?*
diff --git a/collects/scheme/private/old-rp.ss b/collects/racket/private/old-rp.rkt
similarity index 96%
rename from collects/scheme/private/old-rp.ss
rename to collects/racket/private/old-rp.rkt
index 2634ece..74f1554 100644
--- a/collects/scheme/private/old-rp.ss
+++ b/collects/racket/private/old-rp.rkt
@@ -1,6 +1,6 @@
 
 (module old-rp '#%kernel
-  (#%require (for-syntax '#%kernel "stx.ss" "small-scheme.ss" "stxcase-scheme.ss"))
+  (#%require (for-syntax '#%kernel "stx.rkt" "small-scheme.rkt" "stxcase-scheme.rkt"))
 
   (#%provide require require-for-syntax require-for-template require-for-label
              provide provide-for-syntax provide-for-label)
diff --git a/collects/scheme/private/stxmz-body.ss b/collects/racket/private/stxmz-body.rkt
similarity index 91%
rename from collects/scheme/private/stxmz-body.ss
rename to collects/racket/private/stxmz-body.rkt
index 8ae50ce..20e1984 100644
--- a/collects/scheme/private/stxmz-body.ss
+++ b/collects/racket/private/stxmz-body.rkt
@@ -2,8 +2,8 @@
 ;; mzscheme's `#%module-begin'
 
 (module stxmz-body '#%kernel
-  (#%require "stxcase-scheme.ss" "define.ss"
-             (for-syntax '#%kernel "stx.ss"))
+  (#%require "stxcase-scheme.rkt" "define.rkt"
+             (for-syntax '#%kernel "stx.rkt"))
 
   ;; So that expansions print the way the MzScheme programmer expects:
   (#%require (rename '#%kernel #%plain-module-begin #%module-begin))
diff --git a/collects/scheme/mpair.rkt b/collects/scheme/mpair.rkt
new file mode 100644
index 0000000..fd74621
--- /dev/null
+++ b/collects/scheme/mpair.rkt
@@ -0,0 +1,2 @@
+#lang scheme/private/provider
+racket/mpair
diff --git a/collects/scheme/package.rkt b/collects/scheme/package.rkt
new file mode 100644
index 0000000..332c173
--- /dev/null
+++ b/collects/scheme/package.rkt
@@ -0,0 +1,2 @@
+#lang scheme/private/provider
+racket/package
diff --git a/collects/tests/mzscheme/unit.ss b/collects/tests/mzscheme/unit.ss
index 2769308..fce4877 100644
--- a/collects/tests/mzscheme/unit.ss
+++ b/collects/tests/mzscheme/unit.ss
@@ -231,7 +231,7 @@
     (export)))
 
   (test (string-append "(5 #<a> #<struct-type:a> (proc: y)"
-		       " (proc: make-x) (proc: x?)"
+		       " (proc: x) (proc: x?)"
 		       " (proc: x-z) (proc: both))"
 		       "(5 #t #<a> #t #f #<x> #t #t #f #t)")
 	get-output-string p))
diff --git a/collects/tests/mzscheme/unitsig.ss b/collects/tests/mzscheme/unitsig.ss
index 57b3539..faf879e 100644
--- a/collects/tests/mzscheme/unitsig.ss
+++ b/collects/tests/mzscheme/unitsig.ss
@@ -334,7 +334,7 @@
 		      M@)])
       (export)))
     (test (string-append "(5 #(struct:a 5 6) #<struct-type:a> (proc: y)"
-			 " (proc: make-x) (proc: x?)"
+			 " (proc: x) (proc: x?)"
 			 " (proc: x-z) (proc: both) (proc: a?))"
 			 "(5 #t #(struct:a 5 6) #t #f #(struct:x 1 2 ...) #t #t #f #t)")
 	  get-output-string p)))