diff --git a/collects/mzlib/private/contract.ss b/collects/mzlib/private/contract.ss
index 0da0cdb386..365af906fe 100644
--- a/collects/mzlib/private/contract.ss
+++ b/collects/mzlib/private/contract.ss
@@ -256,6 +256,14 @@ add struct contracts for immutable structs?
            (let* ([struct-name (syntax-case struct-name-position ()
                                  [(a b) (syntax a)]
                                  [else struct-name-position])]
+                  [super-id (syntax-case struct-name-position ()
+                                [(a b) (syntax b)]
+                                [else #t])]
+                  [struct-info (extract-struct-info struct-name-position)]
+                  [constructor-id (list-ref struct-info 1)]
+                  [predicate-id (list-ref struct-info 2)]
+                  [selector-ids (reverse (list-ref struct-info 3))]
+                  [mutator-ids (reverse (list-ref struct-info 4))]
                   [parent-struct-count (let ([parent-info (extract-parent-struct-info struct-name-position)])
                                          (and parent-info
                                               (let ([fields (cadddr parent-info)])
@@ -274,69 +282,105 @@ add struct contracts for immutable structs?
                                                           field-name
                                                           struct-name))
                                            field-names)]
-                  [selector-ids (map (lambda (field-name) 
-                                       (build-selector-id struct-name field-name))
-                                     field-names)]
-                  [mutator-ids (map (lambda (field-name) 
-                                      (build-mutator-id struct-name field-name))
-                                    field-names)]
-                  [predicate-id (build-predicate-id struct-name)]
-                  [constructor-id (build-constructor-id struct-name)])
-             (with-syntax ([(selector-codes ...)
+                  [struct:struct-name
+                   (datum->syntax-object
+                    struct-name
+                    (string->symbol
+                     (string-append
+                      "struct:"
+                      (symbol->string (syntax-e struct-name)))))])
+             
+             (let ([unknown-info
+                    (λ (what)
+                      (raise-syntax-error
+                       'provide/contract
+                       (format "cannot determine ~a" what)
+                       provide-stx
+                       struct-name))])
+               (unless constructor-id (unknown-info "constructor"))
+               (unless predicate-id (unknown-info "predicate"))
+               (unless (andmap values selector-ids) (unknown-info "selectors"))
+               (unless (andmap values mutator-ids) (unknown-info "mutators")))
+             
+             (with-syntax ([((selector-codes selector-new-names) ...)
                             (filter
                              (lambda (x) x)
                              (map/count (lambda (selector-id field-contract-id index)
                                           (if (or (not parent-struct-count)
                                                   (parent-struct-count . <= . index))
-                                              (code-for-one-id stx
-                                                               selector-id
-                                                               (build-selector-contract struct-name 
-                                                                                        predicate-id
-                                                                                        field-contract-id)
-                                                               #f)
+                                              (code-for-one-id/new-name
+                                               stx
+                                               selector-id
+                                               (build-selector-contract struct-name 
+                                                                        predicate-id
+                                                                        field-contract-id)
+                                               #f)
                                               #f))
                                         selector-ids
                                         field-contract-ids))]
-                           [(mutator-codes ...)
+                           [((mutator-codes mutator-new-names) ...)
                             (filter
                              (lambda (x) x)
                              (map/count (lambda (mutator-id field-contract-id index)
                                           (if (or (not parent-struct-count)
                                                   (parent-struct-count . <= . index))
-                                              (code-for-one-id stx
-                                                               mutator-id 
-                                                               (build-mutator-contract struct-name 
-                                                                                       predicate-id
-                                                                                       field-contract-id)
-                                                               #f)
+                                              (code-for-one-id/new-name stx
+                                                                        mutator-id 
+                                                                        (build-mutator-contract struct-name 
+                                                                                                predicate-id
+                                                                                                field-contract-id)
+                                                                        #f)
                                               #f))
                                         mutator-ids
                                         field-contract-ids))]
-                           [predicate-code (code-for-one-id stx predicate-id (syntax (-> any/c boolean?)) #f)]
-                           [constructor-code (code-for-one-id
-                                              stx
-                                              constructor-id
-                                              (build-constructor-contract stx
-                                                                          field-contract-ids 
-                                                                          predicate-id)
-                                              #f)]
+                           [(predicate-code predicate-new-name)
+                            (code-for-one-id/new-name stx predicate-id (syntax (-> any/c boolean?)) #f)]
+                           [(constructor-code constructor-new-name)
+                            (code-for-one-id/new-name
+                             stx
+                             constructor-id
+                             (build-constructor-contract stx
+                                                         field-contract-ids 
+                                                         predicate-id)
+                             #f)]
                            [(field-contracts ...) field-contracts]
-                           [(field-contract-ids ...) field-contract-ids]
-                           [struct-name struct-name]
-                           [struct:struct-name (datum->syntax-object
-                                                struct-name
-                                                (string->symbol
-                                                 (string-append
-                                                  "struct:"
-                                                  (symbol->string (syntax-e struct-name)))))])
-               (syntax/loc stx
-                (begin
-                  (define field-contract-ids field-contracts) ...
-                  selector-codes ...
-                  mutator-codes ...
-                  predicate-code
-                  constructor-code
-                  (provide struct-name struct:struct-name))))))
+                           [(field-contract-ids ...) field-contract-ids])
+               (with-syntax ([struct-code 
+                              (with-syntax ([id-rename (a:mangle-id provide-stx 
+                                                                    "provide/contract-struct-expandsion-info-id"
+                                                                    struct-name)]
+                                            [struct-name struct-name]
+                                            [struct:struct-name struct:struct-name]
+                                            ;[(selector-id ...) selector-ids]
+                                            ;[(mutator-id ...) mutator-ids]
+                                            ;[predicate-id predicate-id]
+                                            ;[constructor-id constructor-id]
+                                            [super-id (if (boolean? super-id)
+                                                          super-id
+                                                          (with-syntax ([super-id super-id])
+                                                            (syntax #'super-id)))])
+                                (syntax (begin
+                                          #;
+                                          (provide struct-name)
+                                          
+                                          (provide (rename id-rename struct-name))
+                                          (define-syntax id-rename
+                                            (list-immutable #'struct:struct-name
+                                                            #'constructor-new-name
+                                                            #'predicate-new-name
+                                                            (list-immutable #'selector-new-names ...)
+                                                            (list-immutable #'mutator-new-names ...)
+                                                            super-id)))))]
+                             [struct:struct-name struct:struct-name])
+                 (syntax/loc stx
+                   (begin
+                     struct-code
+                     (define field-contract-ids field-contracts) ...
+                     selector-codes ...
+                     mutator-codes ...
+                     predicate-code
+                     constructor-code
+                     (provide struct:struct-name)))))))
  
          ;; map/count : (X Y int -> Z) (listof X) (listof Y) -> (listof Z)
          (define (map/count f l1 l2)
@@ -364,6 +408,19 @@ add struct contracts for immutable structs?
                                      (syntax b))))]
              [a #f]))
          
+         ;; extract-struct-info : syntax -> (union #f (list syntax syntax (listof syntax) ...))
+         (define (extract-struct-info stx)
+           (let ([id (syntax-case stx ()
+                       [(a b) (syntax a)]
+                       [_ stx])])
+             (syntax-local-value 
+              id
+              (lambda ()
+                (raise-syntax-error 'provide/contract
+                                    "expected a struct name" 
+                                    provide-stx
+                                    id)))))
+         
          ;; build-constructor-contract : syntax (listof syntax) syntax -> syntax
          (define (build-constructor-contract stx field-contract-ids predicate-id)
            (with-syntax ([(field-contract-ids ...) field-contract-ids]
@@ -393,103 +450,66 @@ add struct contracts for immutable structs?
                       . -> .
                       void?))))
          
-         ;; build-constructor-id : syntax -> syntax
-         ;; constructs the name of the selector for a particular field of a struct
-         (define (build-constructor-id struct-name)
-           (datum->syntax-object
-            struct-name
-            (string->symbol
-             (string-append
-              "make-"
-              (symbol->string (syntax-object->datum struct-name))))))
-         
-         ;; build-predicate-id : syntax -> syntax
-         ;; constructs the name of the selector for a particular field of a struct
-         (define (build-predicate-id struct-name)
-           (datum->syntax-object
-            struct-name
-            (string->symbol
-             (string-append
-              (symbol->string (syntax-object->datum struct-name))
-              "?"))))
-         
-         ;; build-selector-id : syntax syntax -> syntax
-         ;; constructs the name of the selector for a particular field of a struct
-         (define (build-selector-id struct-name field-name)
-           (datum->syntax-object
-            struct-name
-            (string->symbol
-             (string-append
-              (symbol->string (syntax-object->datum struct-name))
-              "-"
-              (symbol->string (syntax-object->datum field-name))))))
-         
-         ;; build-mutator-id : syntax syntax -> syntax
-         ;; constructs the name of the selector for a particular field of a struct
-         (define (build-mutator-id struct-name field-name)
-           (datum->syntax-object
-            struct-name
-            (string->symbol
-             (string-append
-              "set-"
-              (symbol->string (syntax-object->datum struct-name))
-              "-"
-              (symbol->string (syntax-object->datum field-name))
-              "!"))))
-         
          ;; code-for-one-id : syntax syntax syntax (union syntax #f) -> syntax
          ;; given the syntax for an identifier and a contract,
          ;; builds a begin expression for the entire contract and provide
          ;; the first syntax object is used for source locations
          (define (code-for-one-id stx id ctrct user-rename-id)
+           (with-syntax ([(code id) (code-for-one-id/new-name stx id ctrct user-rename-id)])
+             (syntax code)))
+         
+         ;; code-for-one-id/new-name : syntax syntax syntax (union syntax #f) -> (values syntax syntax)
+         ;; given the syntax for an identifier and a contract,
+         ;; builds a begin expression for the entire contract and provide
+         ;; the first syntax object is used for source locations
+         (define (code-for-one-id/new-name stx id ctrct user-rename-id)
            (with-syntax ([id-rename (a:mangle-id provide-stx "provide/contract-id" id)]
                          [contract-id (a:mangle-id provide-stx "provide/contract-contract-id" id)]
                          [pos-module-source (a:mangle-id provide-stx "provide/contract-pos-module-source" id)]
                          [pos-stx (datum->syntax-object provide-stx 'here)]
                          [id id]
-                         [ctrct ctrct])
-             (with-syntax ([provide-clause (if user-rename-id
-                                               (with-syntax ([user-rename-id user-rename-id])
-                                                 (syntax (provide (rename id-rename user-rename-id))))
-                                               (syntax (provide (rename id-rename id))))])
-               (syntax/loc stx
-                 (begin
-                   provide-clause
-                   
-                   ;; unbound id check
-                   (if #f id)
-                   
-                   (define pos-module-source (module-source-as-symbol #'pos-stx))
-                   (define contract-id (let ([id ctrct]) id))
-                   (define-syntax id-rename
-                     (make-set!-transformer
-                      (lambda (stx)
-                        (with-syntax ([neg-stx (datum->syntax-object stx 'here)])
-                          (syntax-case stx (set!)
-                            [(set! _ body) (raise-syntax-error
-                                            #f 
-                                            "cannot set! provide/contract identifier"
-                                            stx
-                                            (syntax _))]
-                            [(_ arg (... ...))
-                             (syntax 
-                              ((begin-lifted
-				(-contract contract-id
-					   id
-					   pos-module-source
-					   (module-source-as-symbol #'neg-stx)
-					   (quote-syntax _)))
-                               arg
-                               (... ...)))]
-                            [_
-                             (identifier? (syntax _))
-                             (syntax 
-                              (begin-lifted
-			       (-contract contract-id
-					  id  
-					  pos-module-source 
-					  (module-source-as-symbol #'neg-stx)
-					  (quote-syntax _))))]))))))))))
+                         [ctrct ctrct]
+                         [external-name (or user-rename-id id)])
+             (with-syntax ([code
+                            (syntax/loc stx
+                              (begin
+                                (provide (rename id-rename external-name))
+                                
+                                ;; unbound id check
+                                (if #f id)
+                                
+                                (define pos-module-source (module-source-as-symbol #'pos-stx))
+                                (define contract-id (let ([id ctrct]) id))
+                                (define-syntax id-rename
+                                  (make-set!-transformer
+                                   (lambda (stx)
+                                     (with-syntax ([neg-stx (datum->syntax-object stx 'here)])
+                                       (syntax-case stx (set!)
+                                         [(set! _ body) (raise-syntax-error
+                                                         #f 
+                                                         "cannot set! provide/contract identifier"
+                                                         stx
+                                                         (syntax _))]
+                                         [(_ arg (... ...))
+                                          (syntax 
+                                           ((begin-lifted
+                                              (-contract contract-id
+                                                         id
+                                                         pos-module-source
+                                                         (module-source-as-symbol #'neg-stx)
+                                                         (quote-syntax _)))
+                                            arg
+                                            (... ...)))]
+                                         [_
+                                          (identifier? (syntax _))
+                                          (syntax 
+                                           (begin-lifted
+                                             (-contract contract-id
+                                                        id  
+                                                        pos-module-source 
+                                                        (module-source-as-symbol #'neg-stx)
+                                                        (quote-syntax _))))])))))))])
+               (syntax (code id-rename)))))
          
          (with-syntax ([(bodies ...) (code-for-each-clause (syntax->list (syntax (p/c-ele ...))))])
            (syntax 
diff --git a/collects/tests/mzscheme/contract-test.ss b/collects/tests/mzscheme/contract-test.ss
index 1e51ea98d2..993b30772c 100644
--- a/collects/tests/mzscheme/contract-test.ss
+++ b/collects/tests/mzscheme/contract-test.ss
@@ -1318,26 +1318,44 @@
   
   (test/spec-passed
    'provide/contract4
-   '(let ()
+   '(parameterize ([current-namespace (make-namespace)])
       (eval '(module contract-test-suite4 mzscheme
                (require (lib "contract.ss"))
-               (provide/contract (struct s ((a any/c))))
-               (define-struct s (a))))
+               (define-struct s (a))
+               (provide/contract (struct s ((a any/c))))))
       (eval '(require contract-test-suite4))
       (eval '(list (make-s 1)
                    (s-a (make-s 1))
                    (s? (make-s 1))
                    (set-s-a! (make-s 1) 2)))))
   
+  (test/spec-passed/result
+   'provide/contract4-b
+   '(parameterize ([current-namespace (make-namespace)])
+      (eval '(module contract-test-suite4-b mzscheme
+               (require (lib "contract.ss"))
+               (define-struct s (a b))
+               (provide/contract (struct s ((a any/c) (b any/c))))))
+      (eval '(require contract-test-suite4-b))
+      (eval '(let ([an-s (make-s 1 2)])
+               (list (s-a an-s)
+                     (s-b an-s)
+                     (begin (set-s-a! an-s 3)
+                            (s-a an-s))
+                     (begin (set-s-b! an-s 4)
+                            (s-b an-s))))))
+   
+   (list 1 2 3 4))
+  
   (test/spec-passed
    'provide/contract5
-   '(let ()
+   '(parameterize ([current-namespace (make-namespace)])
       (eval '(module contract-test-suite5 mzscheme
                (require (lib "contract.ss"))
-               (provide/contract (struct s ((a any/c)))
-                                 (struct t ((a any/c))))
                (define-struct s (a))
-               (define-struct t (a))))
+               (define-struct t (a))
+               (provide/contract (struct s ((a any/c)))
+                                 (struct t ((a any/c))))))
       (eval '(require contract-test-suite5))
       (eval '(list (make-s 1)
                    (s-a (make-s 1))
@@ -1350,17 +1368,45 @@
   
   (test/spec-passed
    'provide/contract6
-   '(let ()
+   '(parameterize ([current-namespace (make-namespace)])
       (eval '(module contract-test-suite6 mzscheme
                (require (lib "contract.ss"))
-               (provide/contract (struct s ((a any/c))))
-               (define-struct s (a))))
+               (define-struct s (a))
+               (provide/contract (struct s ((a any/c))))))
       (eval '(require contract-test-suite6))
       (eval '(define-struct (t s) ()))))
   
+  (test/spec-passed
+   'provide/contract6
+   '(parameterize ([current-namespace (make-namespace)])
+      (eval '(module contract-test-suite6 mzscheme
+               (require (lib "contract.ss"))
+               (define-struct s (a))
+               (provide/contract (struct s ((a any/c))))))
+      (eval '(require contract-test-suite6))
+      (eval '(define-struct (t s) ()))))
+  
+  #;
+  (test/spec-passed
+   'provide/contract6b
+   '(parameterize ([current-namespace (make-namespace)])
+      (eval '(module contract-test-suite6b mzscheme
+               (require (lib "contract.ss"))
+               (provide/contract (struct s_ ((a any/c))))
+               (define-struct s_ (a))))
+      (eval '(require contract-test-suite6b))
+      (eval '(module contract-test-suite6b2 mzscheme
+               (require contract-test-suite6b)
+               (require (lib "contract.ss"))
+               (define-struct (t_ s_) (b))
+               (provide/contract (struct (t_ s_) ((a any/c) (b any/c))))))
+      (eval '(require contract-test-suite6b2))
+      (eval '(define-struct (u_ t_) ()))
+      (eval '(t_-a (make-u_ 1 2)))))
+  
   (test/spec-passed
    'provide/contract7
-   '(let ()
+   '(parameterize ([current-namespace (make-namespace)])
       (eval '(module contract-test-suite7 mzscheme
                (require (lib "contract.ss"))
                (define-struct s (a b))
@@ -1378,7 +1424,7 @@
   
   (test/spec-passed
    'provide/contract8
-   '(let ()
+   '(parameterize ([current-namespace (make-namespace)])
       (eval '(module contract-test-suite8 mzscheme
                (require (lib "contract.ss"))
                (define-struct i-s (contents))
@@ -1389,15 +1435,48 @@
       (eval '(i-s-contents (make-i-s 1)))))
    
   (test/spec-passed
-   'provide/contract8
-   '(let ()
-      (eval '(module contract-test-suite8 mzscheme
+   'provide/contract9
+   '(parameterize ([current-namespace (make-namespace)])
+      (eval '(module contract-test-suite9 mzscheme
                (require (lib "contract.ss"))
                (provide/contract (rename the-internal-name the-external-name integer?))
                (define the-internal-name 1)
                (+ the-internal-name 1)))
-      (eval '(require contract-test-suite8))
+      (eval '(require contract-test-suite9))
       (eval '(+ the-external-name 1))))
+  
+  (test/spec-passed
+   'provide/contract10
+   '(parameterize ([current-namespace (make-namespace)])
+      (eval '(module m mzscheme
+               (require (lib "contract.ss"))
+               (define-struct s (a b) (make-inspector))
+               (provide/contract (struct s ((a number?) (b number?))))))
+      (eval '(module n mzscheme
+               (require (lib "struct.ss")
+                        m)
+               (print-struct #t)
+               (copy-struct s 
+                            (make-s 1 2)
+                            [s-a 3])))
+      (eval '(require n))))
+  
+  (test/spec-failed
+   'provide/contract11
+   '(parameterize ([current-namespace (make-namespace)])
+      (eval '(module m mzscheme
+               (require (lib "contract.ss"))
+               (define-struct s (a b) (make-inspector))
+               (provide/contract (struct s ((a number?) (b number?))))))
+      (eval '(module n mzscheme
+               (require (lib "struct.ss")
+                        m)
+               (print-struct #t)
+               (copy-struct s 
+                            (make-s 1 2)
+                            [s-a #f])))
+      (eval '(require n)))
+   'n)
 
   
 ;