diff --git a/collects/mzlib/contract.rkt b/collects/mzlib/contract.rkt
index e9a81466b2..462ff7cc5f 100644
--- a/collects/mzlib/contract.rkt
+++ b/collects/mzlib/contract.rkt
@@ -40,7 +40,8 @@
 (provide 
  opt/c define-opt/c ;(all-from "private/contract-opt.rkt")
  (except-out (all-from-out racket/contract/private/ds)
-             lazy-depth-to-look)
+             lazy-depth-to-look
+             contract-struct)
  
  (all-from-out racket/contract/private/base)
  (all-from-out racket/contract/private/provide)
diff --git a/collects/racket/contract/private/ds-helpers.rkt b/collects/racket/contract/private/ds-helpers.rkt
index a8020ad663..a2b425cdca 100644
--- a/collects/racket/contract/private/ds-helpers.rkt
+++ b/collects/racket/contract/private/ds-helpers.rkt
@@ -3,9 +3,10 @@
          build-func-params
          build-clauses
          build-enforcer-clauses
-         generate-arglists)
+         generate-arglists
+         (struct-out contract-struct-transformer))
 
-(require "opt-guts.rkt")
+(require racket/struct-info "opt-guts.rkt")
 (require (for-template racket/base))
 
 #|
@@ -382,3 +383,7 @@ which are then called when the contract's fields are explored
      (for-each
       (λ (id) (unless (identifier? id) (raise-syntax-error 'struct/dc "expected identifier" stx id)))
       (syntax->list (syntax (id ...))))]))
+
+(struct contract-struct-transformer (info proc)
+  #:property prop:struct-info (λ (ctc) (contract-struct-transformer-info ctc))
+  #:property prop:procedure 1)
\ No newline at end of file
diff --git a/collects/racket/contract/private/ds.rkt b/collects/racket/contract/private/ds.rkt
index fd65ab9304..ae1313c5a9 100644
--- a/collects/racket/contract/private/ds.rkt
+++ b/collects/racket/contract/private/ds.rkt
@@ -25,6 +25,7 @@ it around flattened out.
          (for-syntax "opt-guts.rkt"))
 
 (provide define-contract-struct
+         contract-struct
          
          make-opt-contract/info
          ;set-opt-contract/info-enforcer!
@@ -36,300 +37,312 @@ it around flattened out.
          unknown?
          synthesized-value)
 
-(define-syntax (define-contract-struct stx)
-  (syntax-case stx ()
-    [(_ name (fields ...)) 
-     (syntax (define-contract-struct name (fields ...) (current-inspector)))]
-    [(_ name (fields ...) inspector)
-     (and (identifier? (syntax name))
-          (andmap identifier? (syntax->list (syntax (fields ...)))))
-     (let* ([mutable? (syntax-e (syntax mutable?))]
-            [add-suffix
-             (λ (suffix)
-               (datum->syntax (syntax name)
-                              (string->symbol 
-                               (string-append (symbol->string (syntax-e (syntax name)))
-                                              suffix))
-                              stx))]
-            [struct-names (build-struct-names (syntax name)
-                                              (syntax->list (syntax (fields ...)))
-                                              #f
-                                              #t
-                                              stx)]
-            [struct:-name/val (list-ref struct-names 0)]
-            [struct-maker/val (list-ref struct-names 1)]
-            [predicate/val (list-ref struct-names 2)]
-            [selectors/val (cdddr struct-names)]
-            [struct/c-name/val (add-suffix "/c")]
-            [struct/dc-name/val (add-suffix "/dc")]
-            [field-count/val (length selectors/val)]
-            [f-x/vals (generate-temporaries (syntax (fields ...)))]
-            [f-xs/vals (generate-arglists f-x/vals)])
-       
-       (with-syntax ([struct/c struct/c-name/val]
-                     [struct/dc struct/dc-name/val]
-                     [field-count field-count/val]
-                     [(selectors ...) selectors/val]
-                     [struct:-name struct:-name/val]
-                     [struct-maker struct-maker/val]
-                     [predicate predicate/val]
-                     [the-contract (add-suffix "-contract")]
-                     [(selector-indices ...) (nums-up-to field-count/val)]
-                     [(selector-indices+1 ...) (map add1 (nums-up-to field-count/val))]
-                     [(ctc-x ...) (generate-temporaries (syntax (fields ...)))]
-                     [(f-x ...) f-x/vals]
-                     [((f-xs ...) ...) f-xs/vals]
-                     [wrap-name (string->symbol (format "~a/lazy-contract" (syntax-e (syntax name))))]
-                     [opt-wrap-name (string->symbol (format "~a/lazy-opt-contract" (syntax-e (syntax name))))])
-         #` 
-         (begin
-           
-           ;; `declare' future bindings for the top-level (so that everyone picks them up)
-           #,@(if (eq? (syntax-local-context) 'top-level)
-                  (list
-                   (syntax
-                    (define-syntaxes (contract-type contract-maker contract-predicate contract-get contract-set 
-                                                    already-there? burrow-in rewrite-fields wrap-get)
-                      (values))))
-                  (list))
-           
-           (define-syntax name (list #'struct:-name 
-                                     #'struct-maker 
-                                     #'predicate
-                                     (reverse (list #'selectors ...))
-                                     (list #,@(map (λ (x) #f) (syntax->list #'(selectors ...))))
-                                     #t))
-           
-           (define (evaluate-attrs stct contract/info)
-             (when (wrap-parent-get stct 0) ;; test to make sure this even has attributes
-               (let* ([any-unknown? #f]
-                      [any-became-known? #f]
-                      [synth-info (wrap-parent-get stct 0)]
-                      [ht (synth-info-vals synth-info)])
-                 (hash-for-each 
-                  ht
-                  (lambda (k v)
-                    (when (unknown? v)
-                      (let ([proc (unknown-proc v)])
-                        (let ([new (proc (wrap-get stct selector-indices+1) ...)])
-                          (cond
-                            [(unknown? new) 
-                             (set! any-unknown? #t)]
-                            [else
-                             (set! any-became-known? #t)
-                             (hash-set! ht k new)]))))))
-                 (unless any-unknown?
-                   (check-synth-info-test stct synth-info contract/info))
-                 (when any-became-known?
-                   (for-each 
-                    (lambda (x) ((evaluate-attr-prop-accessor x) x contract/info))
-                    (synth-info-parents synth-info)))
-                 (unless any-unknown?
-                   (set-synth-info-parents! synth-info '())))))
-           
-           (define-values (wrap-type wrap-maker wrap-predicate wrap-get wrap-set)
-             (make-struct-type 'wrap-name
-                               wrap-parent-type  ;; super struct
-                               2   ;; field count
-                               (max 0 (- field-count 1))   ;; auto-field-k
-                               #f ;; auto-field-v
-                               (list (cons evaluate-attr-prop evaluate-attrs))
-                               inspector))
-           
-           (define-values (opt-wrap-type opt-wrap-maker opt-wrap-predicate opt-wrap-get opt-wrap-set)
-             (make-struct-type 'opt-wrap-name
-                               #f  ;; super struct
-                               2   ;; field count
-                               (+ 1 field-count)   ;; auto-field-k
-                               #f ;; auto-field-v
-                               '() ;; prop-value-list
-                               inspector))
-           
-           (define-values (type struct-maker raw-predicate get set)
-             (make-struct-type 'name
-                               #f  ;; super struct
-                               field-count
-                               0   ;; auto-field-k
-                               '() ;; auto-field-v
-                               '() ;; prop-value-list
-                               inspector))
-           
-           (define (predicate x) (or (raw-predicate x) (opt-wrap-predicate x) (wrap-predicate x)))
-           
-           (define-syntax (struct/dc stx)
-             (syntax-case stx ()
-               [(_ clause (... ...))
-                (with-syntax ([((maker-args (... ...))
-                                (names (... ...)))
-                               (build-clauses 'struct/dc 
-                                              (syntax coerce-contract)
-                                              stx 
-                                              (syntax (clause (... ...))))])
-                  (syntax 
-                   (let ([names 'names] (... ...))
-                     (contract-maker maker-args (... ...)))))]))
-           
-           (define (do-selection stct i+1)
-             (let-values ([(stct fields ...) 
-                           (let loop ([stct stct])
-                             (cond
-                               [(raw-predicate stct)
-                                ;; found the original value
-                                (values #f (get stct selector-indices) ...)]
+;; main : syntax syntax[list-of-identifier] syntax boolean -> syntax
+;; define-struct? tells us if this is a 'contract-struct' or a 'define-contract-struct'
+(define-for-syntax (main stx name fields inspector define-struct?)
+  (with-syntax ([name name]
+                [(fields ...) fields]
+                [inspector inspector])
+    
+    (let* ([mutable? (syntax-e (syntax mutable?))]
+           [add-suffix
+            (λ (suffix)
+              (datum->syntax (syntax name)
+                             (string->symbol 
+                              (string-append (symbol->string (syntax-e (syntax name)))
+                                             suffix))
+                             stx))]
+           [struct-names (build-struct-names (syntax name)
+                                             (syntax->list (syntax (fields ...)))
+                                             #f
+                                             #t
+                                             stx)]
+           [struct:-name/val (list-ref struct-names 0)]
+           [struct-maker/val (list-ref struct-names 1)]
+           [predicate/val (list-ref struct-names 2)]
+           [selectors/val (cdddr struct-names)]
+           [struct/c-name/val (add-suffix "/c")]
+           [struct/dc-name/val (add-suffix "/dc")]
+           [field-count/val (length selectors/val)]
+           [f-x/vals (generate-temporaries (syntax (fields ...)))]
+           [f-xs/vals (generate-arglists f-x/vals)])
+      
+      (with-syntax ([struct/c struct/c-name/val]
+                    [struct/dc struct/dc-name/val]
+                    [field-count field-count/val]
+                    [(selectors ...) selectors/val]
+                    [struct:-name struct:-name/val]
+                    [struct-maker struct-maker/val]
+                    [predicate predicate/val]
+                    [the-contract (add-suffix "-contract")]
+                    [(selector-indices ...) (nums-up-to field-count/val)]
+                    [(selector-indices+1 ...) (map add1 (nums-up-to field-count/val))]
+                    [(ctc-x ...) (generate-temporaries (syntax (fields ...)))]
+                    [(f-x ...) f-x/vals]
+                    [((f-xs ...) ...) f-xs/vals]
+                    [wrap-name (string->symbol (format "~a/lazy-contract" (syntax-e (syntax name))))]
+                    [opt-wrap-name (string->symbol (format "~a/lazy-opt-contract" (syntax-e (syntax name))))])
+        #` 
+        (begin
+          
+          ;; `declare' future bindings for the top-level (so that everyone picks them up)
+          #,@(if (eq? (syntax-local-context) 'top-level)
+                 (list
+                  (syntax
+                   (define-syntaxes (contract-type contract-maker contract-predicate contract-get contract-set 
+                                                   already-there? burrow-in rewrite-fields wrap-get)
+                     (values))))
+                 (list))
+          
+          (define-syntax name 
+            #,(let ([the-info-list 
+                     #`(list #'struct:-name 
+                             #'struct-maker 
+                             #'predicate
+                             (reverse (list #'selectors ...))
+                             (list #,@(map (λ (x) #f) (syntax->list #'(selectors ...))))
+                             #t)])
+                (if define-struct?
+                    the-info-list
+                    #`(contract-struct-transformer #,the-info-list
+                                                   (λ (stx) 
+                                                     (if (identifier? stx)
+                                                         #'struct-maker
+                                                         (let ([pr (syntax-e stx)])
+                                                           (if (pair? pr)
+                                                               (datum->syntax #'here (cons #'struct-maker (cdr pr)))
+                                                               (raise-syntax-error #f "what happened?" stx)))))))))
+          
+          (define (evaluate-attrs stct contract/info)
+            (when (wrap-parent-get stct 0) ;; test to make sure this even has attributes
+              (let* ([any-unknown? #f]
+                     [any-became-known? #f]
+                     [synth-info (wrap-parent-get stct 0)]
+                     [ht (synth-info-vals synth-info)])
+                (hash-for-each 
+                 ht
+                 (lambda (k v)
+                   (when (unknown? v)
+                     (let ([proc (unknown-proc v)])
+                       (let ([new (proc (wrap-get stct selector-indices+1) ...)])
+                         (cond
+                           [(unknown? new) 
+                            (set! any-unknown? #t)]
+                           [else
+                            (set! any-became-known? #t)
+                            (hash-set! ht k new)]))))))
+                (unless any-unknown?
+                  (check-synth-info-test stct synth-info contract/info))
+                (when any-became-known?
+                  (for-each 
+                   (lambda (x) ((evaluate-attr-prop-accessor x) x contract/info))
+                   (synth-info-parents synth-info)))
+                (unless any-unknown?
+                  (set-synth-info-parents! synth-info '())))))
+          
+          (define-values (wrap-type wrap-maker wrap-predicate wrap-get wrap-set)
+            (make-struct-type 'wrap-name
+                              wrap-parent-type  ;; super struct
+                              2   ;; field count
+                              (max 0 (- field-count 1))   ;; auto-field-k
+                              #f ;; auto-field-v
+                              (list (cons evaluate-attr-prop evaluate-attrs))
+                              inspector))
+          
+          (define-values (opt-wrap-type opt-wrap-maker opt-wrap-predicate opt-wrap-get opt-wrap-set)
+            (make-struct-type 'opt-wrap-name
+                              #f  ;; super struct
+                              2   ;; field count
+                              (+ 1 field-count)   ;; auto-field-k
+                              #f ;; auto-field-v
+                              '() ;; prop-value-list
+                              inspector))
+          
+          (define-values (type struct-maker raw-predicate get set)
+            (make-struct-type 'name
+                              #f  ;; super struct
+                              field-count
+                              0   ;; auto-field-k
+                              '() ;; auto-field-v
+                              '() ;; prop-value-list
+                              inspector))
+          
+          (define (predicate x) (or (raw-predicate x) (opt-wrap-predicate x) (wrap-predicate x)))
+          
+          (define-syntax (struct/dc stx)
+            (syntax-case stx ()
+              [(_ clause (... ...))
+               (with-syntax ([((maker-args (... ...))
+                               (names (... ...)))
+                              (build-clauses 'struct/dc 
+                                             (syntax coerce-contract)
+                                             stx 
+                                             (syntax (clause (... ...))))])
+                 (syntax 
+                  (let ([names 'names] (... ...))
+                    (contract-maker maker-args (... ...)))))]))
+          
+          (define (do-selection stct i+1)
+            (let-values ([(stct fields ...) 
+                          (let loop ([stct stct])
+                            (cond
+                              [(raw-predicate stct)
+                               ;; found the original value
+                               (values #f (get stct selector-indices) ...)]
+                              
+                              [(opt-wrap-predicate stct)
+                               (let ((inner (opt-wrap-get stct 0)))
+                                 (if inner
+                                     (let* ((info (opt-wrap-get stct 1))
+                                            (enforcer (opt-contract/info-enforcer info)))
+                                       (let-values ([(inner-stct fields ...) (loop inner)])
+                                         (let-values ([(fields ...) (enforcer stct fields ...)])
+                                           (opt-wrap-set stct 0 #f)
+                                           (opt-wrap-set stct selector-indices+1 fields) ...
+                                           (values stct fields ...))))
+                                     
+                                     ;; found a cached version
+                                     (values #f (opt-wrap-get stct selector-indices+1) ...)))]
+                              [(wrap-predicate stct)
+                               (let ([inner (wrap-get stct 0)])
+                                 (if inner
+                                     ;; we have a contract to update
+                                     (let ([contract/info (wrap-get stct 1)])
+                                       (let-values ([(_1 fields ...) (loop inner)])
+                                         (let-values ([(fields ...) 
+                                                       (rewrite-fields stct contract/info fields ...)])
+                                           (wrap-set stct 0 #f)
+                                           (wrap-set stct selector-indices+1 fields) ...
+                                           (evaluate-attrs stct contract/info)
+                                           (values stct fields ...))))
+                                     
+                                     ;; found a cached version of the value
+                                     (values #f (wrap-get stct selector-indices+1) ...)))]))])
+              (cond 
+                [(opt-wrap-predicate stct) (opt-wrap-get stct i+1)]
+                [(wrap-predicate stct) (wrap-get stct i+1)])))
+          
+          (define (rewrite-fields parent contract/info ctc-x ...)
+            (let* ([f-x (let* ([ctc-field (contract-get (contract/info-contract contract/info)
+                                                        selector-indices)]
+                               [ctc (if (contract-struct? ctc-field)
+                                        ctc-field
+                                        (ctc-field f-xs ...))]
                                
-                               [(opt-wrap-predicate stct)
-                                (let ((inner (opt-wrap-get stct 0)))
-                                  (if inner
-                                      (let* ((info (opt-wrap-get stct 1))
-                                             (enforcer (opt-contract/info-enforcer info)))
-                                        (let-values ([(inner-stct fields ...) (loop inner)])
-                                          (let-values ([(fields ...) (enforcer stct fields ...)])
-                                            (opt-wrap-set stct 0 #f)
-                                            (opt-wrap-set stct selector-indices+1 fields) ...
-                                            (values stct fields ...))))
-                                      
-                                      ;; found a cached version
-                                      (values #f (opt-wrap-get stct selector-indices+1) ...)))]
-                               [(wrap-predicate stct)
-                                (let ([inner (wrap-get stct 0)])
-                                  (if inner
-                                      ;; we have a contract to update
-                                      (let ([contract/info (wrap-get stct 1)])
-                                        (let-values ([(_1 fields ...) (loop inner)])
-                                          (let-values ([(fields ...) 
-                                                        (rewrite-fields stct contract/info fields ...)])
-                                            (wrap-set stct 0 #f)
-                                            (wrap-set stct selector-indices+1 fields) ...
-                                            (evaluate-attrs stct contract/info)
-                                            (values stct fields ...))))
-                                      
-                                      ;; found a cached version of the value
-                                      (values #f (wrap-get stct selector-indices+1) ...)))]))])
-               (cond 
-                 [(opt-wrap-predicate stct) (opt-wrap-get stct i+1)]
-                 [(wrap-predicate stct) (wrap-get stct i+1)])))
-           
-           (define (rewrite-fields parent contract/info ctc-x ...)
-             (let* ([f-x (let* ([ctc-field (contract-get (contract/info-contract contract/info)
-                                                         selector-indices)]
-                                [ctc (if (contract-struct? ctc-field)
-                                         ctc-field
-                                         (ctc-field f-xs ...))]
-                                
-                                [ctc-field-val
-                                 (((contract-projection ctc)
-                                   (contract/info-blame contract/info))
-                                  ctc-x)])
-                           (update-parent-links parent ctc-field-val)
-                           ctc-field-val)] ...)
-               (values f-x ...)))
-           
-           (define (stronger-lazy-contract? a b)
-             (and (contract-predicate b)
-                  (contract-stronger? 
-                   (contract-get a selector-indices)
-                   (contract-get b selector-indices)) ...))
-           
-           (define (lazy-contract-proj ctc)
-             (λ (blame)
-               (let ([contract/info (make-contract/info ctc blame)])
-                 (λ (val)
-                   (unless (or (wrap-predicate val)
-                               (opt-wrap-predicate val)
-                               (raw-predicate val))
-                     (raise-blame-error
-                      blame
-                      val
-                      "expected <~a>, got ~e" 'name val))
-                   (cond
-                     [(already-there? contract/info val lazy-depth-to-look)
-                      val]
-                     [else
-                      (let ([wrapper (wrap-maker val contract/info)])
-                        (let ([synth-setup-stuff (contract-get ctc field-count)])
-                          (when synth-setup-stuff
-                            (let ([ht (make-hash)])
-                              (for-each (λ (pr) (hash-set! ht (car pr) (make-unknown (cdr pr))))
-                                        (cdr synth-setup-stuff))
-                              (wrap-parent-set wrapper 0 (make-synth-info '() ht (car synth-setup-stuff))))))
-                        wrapper)])))))
-           
-           (define (already-there? new-contract/info val depth)
-             (cond
-               [(raw-predicate val) #f]
-               [(zero? depth) #f]
-               [(wrap-predicate val)
-                (and (wrap-get val 0)
-                     (let ([old-contract/info (wrap-get val 1)])
-                       (if (and (equal? (contract/info-blame new-contract/info)
-                                        (contract/info-blame old-contract/info))
-                                (contract-stronger? (contract/info-contract old-contract/info)
-                                                    (contract/info-contract new-contract/info)))
-                           #t
-                           (already-there? new-contract/info (wrap-get val 0) (- depth 1)))))]
-               [else 
-                ;; when the zeroth field is cleared out, we don't 
-                ;; have a contract to compare to anymore.
-                #f]))
-           
-           (define (struct/c ctc-x ...)
-             (let ([ctc-x (coerce-contract 'struct/c ctc-x)] ...)
-               (contract-maker ctc-x ... #f)))
-           
-           (define (selectors x)
-             (burrow-in x 'selectors selector-indices))
-           ...
-           
-           (define (burrow-in struct selector-name i)
-             (cond
+                               [ctc-field-val
+                                (((contract-projection ctc)
+                                  (contract/info-blame contract/info))
+                                 ctc-x)])
+                          (update-parent-links parent ctc-field-val)
+                          ctc-field-val)] ...)
+              (values f-x ...)))
+          
+          (define (stronger-lazy-contract? a b)
+            (and (contract-predicate b)
+                 (contract-stronger? 
+                  (contract-get a selector-indices)
+                  (contract-get b selector-indices)) ...))
+          
+          (define (lazy-contract-proj ctc)
+            (λ (blame)
+              (let ([contract/info (make-contract/info ctc blame)])
+                (λ (val)
+                  (unless (or (wrap-predicate val)
+                              (opt-wrap-predicate val)
+                              (raw-predicate val))
+                    (raise-blame-error
+                     blame
+                     val
+                     "expected <~a>, got ~e" 'name val))
+                  (cond
+                    [(already-there? contract/info val lazy-depth-to-look)
+                     val]
+                    [else
+                     (let ([wrapper (wrap-maker val contract/info)])
+                       (let ([synth-setup-stuff (contract-get ctc field-count)])
+                         (when synth-setup-stuff
+                           (let ([ht (make-hash)])
+                             (for-each (λ (pr) (hash-set! ht (car pr) (make-unknown (cdr pr))))
+                                       (cdr synth-setup-stuff))
+                             (wrap-parent-set wrapper 0 (make-synth-info '() ht (car synth-setup-stuff))))))
+                       wrapper)])))))
+          
+          (define (already-there? new-contract/info val depth)
+            (cond
+              [(raw-predicate val) #f]
+              [(zero? depth) #f]
+              [(wrap-predicate val)
+               (and (wrap-get val 0)
+                    (let ([old-contract/info (wrap-get val 1)])
+                      (if (and (equal? (contract/info-blame new-contract/info)
+                                       (contract/info-blame old-contract/info))
+                               (contract-stronger? (contract/info-contract old-contract/info)
+                                                   (contract/info-contract new-contract/info)))
+                          #t
+                          (already-there? new-contract/info (wrap-get val 0) (- depth 1)))))]
+              [else 
+               ;; when the zeroth field is cleared out, we don't 
+               ;; have a contract to compare to anymore.
+               #f]))
+          
+          (define (struct/c ctc-x ...)
+            (let ([ctc-x (coerce-contract 'struct/c ctc-x)] ...)
+              (contract-maker ctc-x ... #f)))
+          
+          (define (selectors x)
+            (burrow-in x 'selectors selector-indices))
+          ...
+          
+          (define (burrow-in struct selector-name i)
+            (cond
               [(raw-predicate struct)
                (get struct i)]
               [(opt-wrap-predicate struct)
                (if (opt-wrap-get struct 0)
-                 (do-selection struct (+ i 1))
-                 (opt-wrap-get struct (+ i 1)))]
+                   (do-selection struct (+ i 1))
+                   (opt-wrap-get struct (+ i 1)))]
               [(wrap-predicate struct)
                (if (wrap-get struct 0)
-                 (do-selection struct (+ i 1))
-                 (wrap-get struct (+ i 1)))]
+                   (do-selection struct (+ i 1))
+                   (wrap-get struct (+ i 1)))]
               [else
                (error selector-name "expected <~a>, got ~e" 'name struct)]))
-           
-           (define (lazy-contract-name ctc)
-             (do-contract-name 'struct/c
-                               'struct/dc
-                               (list (contract-get ctc selector-indices) ...)
-                               '(fields ...)
-                               (contract-get ctc field-count)))
-
-           (define lazy-contract-property
-             (build-contract-property
-              #:projection lazy-contract-proj
-              #:name lazy-contract-name
-              #:first-order (lambda (ctc) predicate)
-              #:stronger stronger-lazy-contract?))
-           
-           (define-values (contract-type contract-maker contract-predicate contract-get contract-set)
-             (make-struct-type 'the-contract
-                               #f
-                               (+ field-count 1) ;; extra field is for synthesized attribute ctcs
-                               ;; it is a list whose first element is
-                               ;; a procedure (called once the attrs are known) that
-                               ;; indicates if the test passes. the rest of the elements are
-                               ;; procedures that build the attrs
-                               ;; this field is #f when there is no synthesized attrs
-                               0 ;; auto-field-k
-                               '() ;; auto-field-v
-                               (list (cons prop:contract lazy-contract-property))))
-           
-           (define-for-syntax (build-enforcer opt/i opt/info name stx clauses
-                                              helper-id-var helper-info helper-freev
-                                              enforcer-id-var)
-             (define (make-free-vars free-vars freev)
-               (let loop ([i 0]
-                          [stx null]
-                          [free-vars free-vars])
-                 (cond
+          
+          (define (lazy-contract-name ctc)
+            (do-contract-name 'struct/c
+                              'struct/dc
+                              (list (contract-get ctc selector-indices) ...)
+                              '(fields ...)
+                              (contract-get ctc field-count)))
+          
+          (define lazy-contract-property
+            (build-contract-property
+             #:projection lazy-contract-proj
+             #:name lazy-contract-name
+             #:first-order (lambda (ctc) predicate)
+             #:stronger stronger-lazy-contract?))
+          
+          (define-values (contract-type contract-maker contract-predicate contract-get contract-set)
+            (make-struct-type 'the-contract
+                              #f
+                              (+ field-count 1) ;; extra field is for synthesized attribute ctcs
+                              ;; it is a list whose first element is
+                              ;; a procedure (called once the attrs are known) that
+                              ;; indicates if the test passes. the rest of the elements are
+                              ;; procedures that build the attrs
+                              ;; this field is #f when there is no synthesized attrs
+                              0 ;; auto-field-k
+                              '() ;; auto-field-v
+                              (list (cons prop:contract lazy-contract-property))))
+          
+          (define-for-syntax (build-enforcer opt/i opt/info name stx clauses
+                                             helper-id-var helper-info helper-freev
+                                             enforcer-id-var)
+            (define (make-free-vars free-vars freev)
+              (let loop ([i 0]
+                         [stx null]
+                         [free-vars free-vars])
+                (cond
                   [(null? free-vars) (reverse stx)]
                   [else (loop (+ i 1)
                               (cons (with-syntax ((var (car free-vars))
@@ -337,87 +350,87 @@ it around flattened out.
                                                   (j (+ i 2)))
                                       (syntax (var (opt-wrap-get stct j)))) stx)
                               (cdr free-vars))])))
-             
-             (let*-values ([(inner-val) #'val]
-                           [(clauses lifts superlifts stronger-ribs)
-                            (build-enforcer-clauses opt/i
-                                                    (opt/info-change-val inner-val opt/info)
-                                                    name
-                                                    stx
-                                                    clauses
-                                                    (list (syntax f-x) ...)
-                                                    (list (list (syntax f-xs) ...) ...)
-                                                    helper-id-var
-                                                    helper-info
-                                                    helper-freev)])
-               (with-syntax ([(clause (... ...)) clauses]
-                             [enforcer-id enforcer-id-var]
-                             [helper-id helper-id-var]
-                             [((free-var free-var-val) (... ...))
-                              (make-free-vars (append (opt/info-free-vars opt/info)) #'freev)]
-                             [(saved-lifts (... ...)) (lifts-to-save lifts)])
-                 (values
-                  #`(λ (stct f-x ...)
-                       (let ((free-var free-var-val) (... ...))
-                         #,(bind-lifts
-                            lifts
-                            #'(let* (clause (... ...))
-                                (values f-x ...)))))
-                  lifts
-                  superlifts
-                  stronger-ribs))))
-           
-           ;;
-           ;; struct/dc opter
-           ;;
-           (define/opter (struct/dc opt/i opt/info stx)
-             (syntax-case stx ()
-               [(_ clause (... ...))
-                (let ((enforcer-id-var (car (generate-temporaries (syntax (enforcer)))))
-                      (helper-id-var (car (generate-temporaries (syntax (helper)))))
-                      (contract/info-var (car (generate-temporaries (syntax (contract/info)))))
-                      (id-var (car (generate-temporaries (syntax (id))))))
-                  (let-values ([(enforcer lifts superlifts stronger-ribs)
-                                (build-enforcer opt/i
-                                                opt/info
-                                                'struct/dc
-                                                stx
-                                                (syntax (clause (... ...)))
-                                                helper-id-var
-                                                #'info
-                                                #'freev
-                                                enforcer-id-var)])
-                    (let ([to-save (append (opt/info-free-vars opt/info)
-                                           (lifts-to-save lifts))])
-                      (with-syntax ((val (opt/info-val opt/info))
-                                    (blame (opt/info-blame opt/info))
-                                    (ctc (opt/info-contract opt/info))
-                                    (enforcer-id enforcer-id-var)
-                                    (helper-id helper-id-var)
-                                    (contract/info contract/info-var)
-                                    (id id-var)
-                                    ((j (... ...)) (let loop ([i 2]
-                                                              [lst to-save])
-                                                     (cond
+            
+            (let*-values ([(inner-val) #'val]
+                          [(clauses lifts superlifts stronger-ribs)
+                           (build-enforcer-clauses opt/i
+                                                   (opt/info-change-val inner-val opt/info)
+                                                   name
+                                                   stx
+                                                   clauses
+                                                   (list (syntax f-x) ...)
+                                                   (list (list (syntax f-xs) ...) ...)
+                                                   helper-id-var
+                                                   helper-info
+                                                   helper-freev)])
+              (with-syntax ([(clause (... ...)) clauses]
+                            [enforcer-id enforcer-id-var]
+                            [helper-id helper-id-var]
+                            [((free-var free-var-val) (... ...))
+                             (make-free-vars (append (opt/info-free-vars opt/info)) #'freev)]
+                            [(saved-lifts (... ...)) (lifts-to-save lifts)])
+                (values
+                 #`(λ (stct f-x ...)
+                     (let ((free-var free-var-val) (... ...))
+                       #,(bind-lifts
+                          lifts
+                          #'(let* (clause (... ...))
+                              (values f-x ...)))))
+                 lifts
+                 superlifts
+                 stronger-ribs))))
+          
+          ;;
+          ;; struct/dc opter
+          ;;
+          (define/opter (struct/dc opt/i opt/info stx)
+            (syntax-case stx ()
+              [(_ clause (... ...))
+               (let ((enforcer-id-var (car (generate-temporaries (syntax (enforcer)))))
+                     (helper-id-var (car (generate-temporaries (syntax (helper)))))
+                     (contract/info-var (car (generate-temporaries (syntax (contract/info)))))
+                     (id-var (car (generate-temporaries (syntax (id))))))
+                 (let-values ([(enforcer lifts superlifts stronger-ribs)
+                               (build-enforcer opt/i
+                                               opt/info
+                                               'struct/dc
+                                               stx
+                                               (syntax (clause (... ...)))
+                                               helper-id-var
+                                               #'info
+                                               #'freev
+                                               enforcer-id-var)])
+                   (let ([to-save (append (opt/info-free-vars opt/info)
+                                          (lifts-to-save lifts))])
+                     (with-syntax ((val (opt/info-val opt/info))
+                                   (blame (opt/info-blame opt/info))
+                                   (ctc (opt/info-contract opt/info))
+                                   (enforcer-id enforcer-id-var)
+                                   (helper-id helper-id-var)
+                                   (contract/info contract/info-var)
+                                   (id id-var)
+                                   ((j (... ...)) (let loop ([i 2]
+                                                             [lst to-save])
+                                                    (cond
                                                       [(null? lst) null]
                                                       [else (cons i (loop (+ i 1) (cdr lst)))])))
-                                    ((free-var (... ...)) to-save))
-                        (with-syntax ([(stronger-this-var (... ...)) (map stronger-rib-this-var stronger-ribs)]
-                                      [(stronger-that-var (... ...)) (map stronger-rib-that-var stronger-ribs)]
-                                      [(stronger-exps (... ...)) (map stronger-rib-stronger-exp stronger-ribs)]
-                                      [(stronger-indexes (... ...)) (build-list (length stronger-ribs) 
-                                                                                (λ (x) (+ x 2)))]
-                                      [(stronger-var (... ...)) (map stronger-rib-save-id stronger-ribs)])
-                          
-                          (let ([partials
-                                 (list (cons id-var #'(begin-lifted (box 'identity)))
-                                       (cons enforcer-id-var enforcer)
-                                       (cons contract/info-var
-                                             (syntax 
-                                              (make-opt-contract/info ctc enforcer-id id))))])
-                            (values
-                             (syntax 
-                              (cond
+                                   ((free-var (... ...)) to-save))
+                       (with-syntax ([(stronger-this-var (... ...)) (map stronger-rib-this-var stronger-ribs)]
+                                     [(stronger-that-var (... ...)) (map stronger-rib-that-var stronger-ribs)]
+                                     [(stronger-exps (... ...)) (map stronger-rib-stronger-exp stronger-ribs)]
+                                     [(stronger-indexes (... ...)) (build-list (length stronger-ribs) 
+                                                                               (λ (x) (+ x 2)))]
+                                     [(stronger-var (... ...)) (map stronger-rib-save-id stronger-ribs)])
+                         
+                         (let ([partials
+                                (list (cons id-var #'(begin-lifted (box 'identity)))
+                                      (cons enforcer-id-var enforcer)
+                                      (cons contract/info-var
+                                            (syntax 
+                                             (make-opt-contract/info ctc enforcer-id id))))])
+                           (values
+                            (syntax 
+                             (cond
                                [(opt-wrap-predicate val)
                                 (if (and (opt-wrap-get val 0)
                                          (let ([stronger-this-var stronger-var] 
@@ -433,10 +446,10 @@ it around flattened out.
                                             ;; the rest of this test is bogus and may fail at runtime
                                             (eq? id (opt-contract/info-id (opt-wrap-get val 1)))
                                             stronger-exps (... ...))))
-                                  val
-                                  (let ([w (opt-wrap-maker val contract/info)])
-                                    (opt-wrap-set w j free-var) (... ...)
-                                    w))]
+                                    val
+                                    (let ([w (opt-wrap-maker val contract/info)])
+                                      (opt-wrap-set w j free-var) (... ...)
+                                      w))]
                                [(or (raw-predicate val)
                                     (wrap-predicate val))
                                 (let ([w (opt-wrap-maker val contract/info)])
@@ -449,13 +462,29 @@ it around flattened out.
                                  "expected <~a>, got ~e"
                                  (contract-name ctc)
                                  val)]))
-                             lifts
-                             superlifts
-                             partials
-                             #f
-                             #f
-                             stronger-ribs)))))))]))
-           )))]))
+                            lifts
+                            superlifts
+                            partials
+                            #f
+                            #f
+                            stronger-ribs)))))))]))
+          )))))
+
+(define-syntax (define-contract-struct stx)
+  (syntax-case stx ()
+    [(_ name (fields ...)) 
+     (syntax (define-contract-struct name (fields ...) (current-inspector)))]
+    [(_ name (fields ...) inspector)
+     (and (identifier? (syntax name))
+          (andmap identifier? (syntax->list (syntax (fields ...)))))
+     (main stx #'name #'(fields ...) #'inspector #t)]))
+
+(define-syntax (contract-struct stx)
+  (syntax-case stx()
+    [(_ name (fields ...))
+     #'(contract-struct name (fields ...) #:inspector (current-inspector))]
+    [(_ name (fields ...) #:inspector e)
+     (main stx #'name #'(fields ...) #'e #f)]))
 
 (define (do-contract-name name/c name/dc list-of-subcontracts fields attrs)
   (cond
diff --git a/collects/scribblings/reference/contracts.scrbl b/collects/scribblings/reference/contracts.scrbl
index b3528b8e6c..bfee16b083 100644
--- a/collects/scribblings/reference/contracts.scrbl
+++ b/collects/scribblings/reference/contracts.scrbl
@@ -1,5 +1,5 @@
 #lang scribble/doc
-@(require "mz.ss")
+@(require "mz.rkt")
 @(require (for-label syntax/modcollapse))
 
 @(define contract-eval
@@ -710,18 +710,17 @@ be blamed using the above contract:
 
 @section{Lazy Data-structure Contracts}
 
-@defform[
-(define-contract-struct id (field-id ...))
-]{
+@defform[(contract-struct id (field-id ...))]{
 
-Like @racket[define-struct], but with two differences: it does not
-define field mutators, and it does define two contract constructors:
+Like @racket[struct], but with two differences: 
+they do not
+define field mutators, and the do define two contract constructors:
 @racket[id]@racketidfont{/c} and @racket[id]@racketidfont{/dc}. The
 first is a procedure that accepts as many arguments as there are
 fields and returns a contract for struct values whose fields match the
 arguments. The second is a syntactic form that also produces contracts
 on the structs, but the contracts on later fields may depend on the
-values of earlier fields. 
+values of earlier fields.
 
 The generated contract combinators are @italic{lazy}: they only verify
 the contract holds for the portion of some data structure that is
@@ -739,21 +738,26 @@ not checked until a selector extracts a field of a struct.
 In each @racket[field-spec] case, the first @racket[field-id]
 specifies which field the contract applies to; the fields must be
 specified in the same order as the original
-@racket[define-contract-struct]. The first case is for when the
+@racket[contract-struct]. The first case is for when the
 contract on the field does not depend on the value of any other
 field. The second case is for when the contract on the field does
 depend on some other fields, and the parenthesized @racket[field-id]s
 indicate which fields it depends on; these dependencies can only be to
-earlier fields.}
+earlier fields.}}
+ 
+@defform[(define-contract-struct id (field-id ...))]{
+  Like @racket[contract-struct], but where the maker's name is @racketidfont["make-"]@racket[id],
+  much like @racket[define-struct].
+}
 
-As an example, consider the following module:
+As an example of lazy contract checking, consider the following module:
 
 @(begin
 #reader scribble/comment-reader
 [racketmod
 racket
 
-(define-contract-struct kons (hd tl))
+(contract-struct kons (hd tl))
   
 ;; @racket[sorted-list/gt : number -> contract]
 ;; produces a contract that accepts
@@ -778,7 +782,7 @@ racket
          (* (kons-hd l) 
             (product (kons-tl l))))]))
  
-(provide kons? make-kons kons-hd kons-tl)
+(provide kons? kons kons-hd kons-tl)
 (provide/contract [product (-> (sorted-list/gt -inf.0) number?)])
 ])
 
diff --git a/collects/tests/racket/contract-test.rktl b/collects/tests/racket/contract-test.rktl
index d7caf4b43e..b32b3099ff 100644
--- a/collects/tests/racket/contract-test.rktl
+++ b/collects/tests/racket/contract-test.rktl
@@ -7941,6 +7941,16 @@
                         [tl (hd) (-> (>=/c hd) (>=/c hd))])])
       ((couple-tl (contract c x 'pos 'neg)) -11)))
   
+  (contract-eval '(contract-struct no-define (x)))
+  (test/spec-passed/result
+  'd-c-s43
+  '(no-define-x (no-define 1))
+  '1)
+  (test/spec-passed/result
+  'd-c-s44
+  '(no-define? (no-define 1))
+  '#t)
+
   
 ;                                                                                            
 ;