diff --git a/collects/mzlib/contract.ss b/collects/mzlib/contract.ss
index 2c2daed39d..d6476be935 100644
--- a/collects/mzlib/contract.ss
+++ b/collects/mzlib/contract.ss
@@ -9,7 +9,7 @@
            "private/contract-basic-opters.ss")
   
   (provide 
-   opt/c #;define-opt/c ;(all-from "private/contract-opt.ss")
+   opt/c define-opt/c ;(all-from "private/contract-opt.ss")
    (all-from-except "private/contract-ds.ss"
                     lazy-depth-to-look)
 
diff --git a/collects/mzlib/private/contract-ds-helpers.ss b/collects/mzlib/private/contract-ds-helpers.ss
index dd94575b35..fa8e01bbaa 100644
--- a/collects/mzlib/private/contract-ds-helpers.ss
+++ b/collects/mzlib/private/contract-ds-helpers.ss
@@ -132,35 +132,21 @@ which are then called when the contract's fields are explored
   
   (define (build-enforcer-clauses opt/i opt/info name stx clauses f-x/vals f-xs/vals
                                   helper-id helper-info helper-freev)  
-    (define (opt/enforcer-clause stx)
+    (define (opt/enforcer-clause id stx)
       (syntax-case stx ()
         [(f arg ...)
          ;; we need to override the default optimization of recursive calls to use our helper
          (and (opt/info-recf opt/info) (module-identifier=? (opt/info-recf opt/info) #'f))
          (values
-          #`(f #,(opt/info-val opt/info) arg ...)
+          #`(f #,id arg ...)
           null
           null
           null
           #f
           #f
           null)]
-        #;
-        [(f arg ...)
-         ;; we need to override the default optimization of recursive calls to use our helper
-         (module-identifier=? (opt/info-recf opt/info) #'f)
-         (with-syntax ((helper helper-id)
-                       (val (opt/info-val opt/info))
-                       (info helper-info))
-           (values
-            (syntax (helper val info arg ...))
-            null
-            null
-            null
-            #f
-            #f
-            null))]
-        [else (opt/i opt/info stx)]))
+        [else (opt/i (opt/info-change-val id opt/info)
+                     stx)]))
 
     (let* ([field-names 
             (map (λ (clause)
@@ -197,21 +183,21 @@ which are then called when the contract's fields are explored
                 (and (identifier? (syntax id))
                      (andmap identifier? (syntax->list (syntax (x ...)))))
                 (let*-values ([(next lifts superlifts partials _ _2 _3)
-                               (opt/enforcer-clause (syntax ctc-exp))]
+                               (opt/enforcer-clause let-var (syntax ctc-exp))]
                               [(maker-arg)
-                               (with-syntax ((val (opt/info-val opt/info))
-                                             ((arg ...) arglist)
-                                             [(new-let-vars ...) (match-up (reverse prior-ac-ids)
-                                                                           (syntax (x ...))
-                                                                           field-names)])
+                               (with-syntax ([val (opt/info-val opt/info)]
+                                             [(new-let-bindings ...) 
+                                              (match-up/bind (reverse prior-ac-ids)
+                                                             (syntax (x ...))
+                                                             field-names
+                                                             arglist)])
                                  #`(#,let-var
                                       #,(bind-lifts
                                          superlifts
-                                         #`(let ([new-let-vars arg] ...)
+                                         #`(let (new-let-bindings ...)
                                              #,(bind-lifts 
                                                 (append lifts partials)
-                                                #`(let ((val #,let-var))
-                                                    #,next))))))])
+                                                next)))))])
                   (loop (cdr clauses)
                         (cdr let-vars)
                         (cdr arglists)
@@ -231,14 +217,13 @@ which are then called when the contract's fields are explored
                [(id ctc-exp)
                 (identifier? (syntax id))
                 (let*-values ([(next lifts superlifts partials _ __ stronger-ribs)
-                               (opt/enforcer-clause (syntax ctc-exp))]
+                               (opt/enforcer-clause let-var (syntax ctc-exp))]
                               [(maker-arg)
                                (with-syntax ((val (opt/info-val opt/info)))
                                  #`(#,let-var
                                       #,(bind-lifts
                                          partials
-                                         #`(let ((val #,let-var))
-                                             #,next))))])
+                                         next)))])
                   (loop (cdr clauses)
                         (cdr let-vars)
                         (cdr arglists)
@@ -282,6 +267,31 @@ which are then called when the contract's fields are explored
          [else (cons (reverse (cdr vars)) 
                      (loop (cdr vars)))]))))
   
+  (define (match-up/bind prior-ac-ids used-field-names field-names rhss)
+    (let ([used-field-ids (syntax->list used-field-names)])
+      (let loop ([prior-ac-ids prior-ac-ids]
+                 [field-names field-names]
+                 [rhss rhss])
+        (cond
+          [(null? prior-ac-ids) null]
+          [else (let* ([ac-id (car prior-ac-ids)]
+                       [field-name (car field-names)]
+                       [id-used 
+                        (ormap (λ (used-field-id) 
+                                 (and (eq? (syntax-e field-name) (syntax-e used-field-id))
+                                      used-field-id))
+                               used-field-ids)])
+                  (if id-used
+                      (cons (with-syntax ([id id-used]
+                                          [arg (car rhss)])
+                              #'[id arg])
+                            (loop (cdr prior-ac-ids)
+                                  (cdr field-names)
+                                  (cdr rhss)))
+                      (loop (cdr prior-ac-ids)
+                            (cdr field-names)
+                            (cdr rhss))))]))))
+  
   (define (match-up prior-ac-ids used-field-names field-names)
     (let ([used-field-ids (syntax->list used-field-names)])
       (let loop ([prior-ac-ids prior-ac-ids]
diff --git a/collects/mzlib/private/contract-ds.ss b/collects/mzlib/private/contract-ds.ss
index 3a6649b62d..85c407a0d4 100644
--- a/collects/mzlib/private/contract-ds.ss
+++ b/collects/mzlib/private/contract-ds.ss
@@ -19,7 +19,8 @@ it around flattened out.
 (module contract-ds mzscheme
   (require "contract-guts.ss"
            "contract-opt.ss"
-           "contract-ds-helpers.ss")
+           "contract-ds-helpers.ss"
+           (lib "etc.ss"))
   (require-for-syntax "contract-ds-helpers.ss"
                       "contract-helpers.ss"
                       "contract-opt-guts.ss"
@@ -28,12 +29,10 @@ it around flattened out.
   (provide define-contract-struct
            
            make-opt-contract/info
+           set-opt-contract/info-enforcer!
            opt-contract/info-contract
+           opt-contract/info-id
            opt-contract/info-enforcer
-           opt-contract/info-pos
-           opt-contract/info-neg
-           opt-contract/info-src-info
-           opt-contract/info-orig-str
            lazy-depth-to-look
            
            unknown?
@@ -350,17 +349,7 @@ it around flattened out.
                (let*-values ([(inner-val) #'val]
                              [(clauses lifts superlifts stronger-ribs)
                               (build-enforcer-clauses opt/i
-                                                      (make-opt/info #'ctc
-                                                                     inner-val
-                                                                     #'pos
-                                                                     #'neg
-                                                                     #'src-info
-                                                                     #'orig-str
-                                                                     (opt/info-free-vars opt/info)
-                                                                     (opt/info-recf opt/info)
-                                                                     (opt/info-base-pred opt/info)
-                                                                     (opt/info-this opt/info)
-                                                                     (opt/info-that opt/info))
+                                                      (opt/info-change-val inner-val opt/info)
                                                       name
                                                       stx
                                                       clauses
@@ -372,33 +361,16 @@ it around flattened out.
                  (with-syntax ([(clause (... ...)) clauses]
                                [enforcer-id enforcer-id-var]
                                [helper-id helper-id-var]
-                               [free-vars (make-free-vars (append (opt/info-free-vars opt/info)) #'freev)]
+                               [((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* ([info (opt-wrap-get stct 1)]
-                               [enforcer (opt-contract/info-enforcer info)]
-                               [ctc (opt-contract/info-contract info)]
-                               [pos (opt-contract/info-pos info)]
-                               [neg (opt-contract/info-neg info)]
-                               [src-info (opt-contract/info-src-info info)]
-                               [orig-str (opt-contract/info-orig-str info)])
-                          (let free-vars
-                            #,(bind-lifts
-                               lifts
-                               #`(let-syntax #,(if (opt/info-recf opt/info)
-                                                   #`([#,(opt/info-recf opt/info) 
-                                                         (lambda (stx)
-                                                           (syntax-case stx () 
-                                                             [(f val args ((... ...) (... ...)))
-                                                              #'(helper-id val
-                                                                           info
-                                                                           args
-                                                                           ((... ...) (... ...))
-                                                                           saved-lifts (... ...))]))])
-                                                   #`())
-                                   (let* (clause (... ...))
-                                     (values f-x ...)))))))
+                        (let ((free-var free-var-val) (... ...))
+                          #,(bind-lifts
+                             lifts
+                             #'(let* (clause (... ...))
+                                 (values f-x ...)))))
                     lifts
                     superlifts
                     stronger-ribs))))
@@ -411,7 +383,8 @@ it around flattened out.
                  [(_ 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))))))
+                        (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
@@ -430,100 +403,71 @@ it around flattened out.
                                     (src-info (opt/info-src-info opt/info))
                                     (orig-str (opt/info-orig-str opt/info))
                                     (ctc (opt/info-contract opt/info))
-                                    (base-pred (or (opt/info-base-pred opt/info) #'(λ (x) #f)))
                                     (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))
-                        (values
-                         (syntax (helper-id val contract/info free-var (... ...)))
-                         lifts
-                         (append 
-                          superlifts
-                          (list (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)])
-                                  (cons #'is-stronger? 
-                                        #'(λ (val i free-var (... ...))
-                                            (cond
-                                              [(= i 0) #f]
-                                              [(and (opt-wrap-predicate val)
-                                                    (opt-wrap-get val 0))
-                                               (let ([stronger-this-var stronger-var] 
-                                                     (... ...)
-                                                     
-                                                     ;; this computation is bogus
-                                                     ;; it only works if the stronger vars and the things
-                                                     ;; saved in the wrapper are the same
-                                                     [stronger-that-var (opt-wrap-get val stronger-indexes)]
-                                                     (... ...))
-                                                 
-                                                 (or (and 
-                                                      ;; make sure this is the same contract -- if not,
-                                                      ;; the rest of this test is bogus and may fail at runtime
-                                                      (eq? enforcer-id (opt-contract/info-enforcer 
-                                                                        (opt-wrap-get val 1)))
-                                                      stronger-exps
-                                                      (... ...))
-                                                     (is-stronger? (opt-wrap-get val 0)
-                                                                   (- i 1)
-                                                                   free-var (... ...))))]
-                                              [else #f]))))
-                                (cons 
-                                 helper-id-var
-                                 (syntax
-                                  (λ (val info free-var (... ...))
-                                    (let ([ctc (opt-contract/info-contract info)]
-                                          [pos (opt-contract/info-pos info)]
-                                          [neg (opt-contract/info-neg info)]
-                                          [src-info (opt-contract/info-src-info info)]
-                                          [orig-str (opt-contract/info-orig-str info)])
-                                      (cond
-                                        ;; FIXME terribly broken
-                                        [(base-pred val) val]
-                                        [else
-                                         (begin
-                                           (unless (or (wrap-predicate val)
-                                                       (opt-wrap-predicate val)
-                                                       (raw-predicate val))
-                                             (raise-contract-error
-                                              val
-                                              src-info
-                                              pos
-                                              orig-str
-                                              "expected <~a>, got ~e"
-                                              ((name-get ctc) ctc)
-                                              val))
-                                           (cond
-                                             ;; this is where the optimized stronger needs to be called.
-                                             [(is-stronger? val 5 free-var (... ...))
-                                              val]
-                                             ;; ALLOCATE OPT-WRAP
-                                             [else 
-                                              (let ([w (opt-wrap-maker val info)])
-                                                (opt-wrap-set w j free-var) (... ...)
-                                                w)]))])))))
-                                (cons enforcer-id-var enforcer)))
-                         (list (cons contract/info-var
-                                     (syntax 
-                                      (make-opt-contract/info ctc
-                                                              enforcer-id
-                                                              pos
-                                                              neg
-                                                              src-info
-                                                              orig-str))))
-                         #f
-                         #f
-                         stronger-ribs)))))]))
-             
+                        (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] 
+                                                (... ...)
+                                                
+                                                ;; this computation is bogus
+                                                ;; it only works if the stronger vars and the things
+                                                ;; saved in the wrapper are the same
+                                                [stronger-that-var (opt-wrap-get val stronger-indexes)]
+                                                (... ...))
+                                            (and 
+                                             ;; make sure this is the same contract -- if not,
+                                             ;; 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))]
+                                [(or (raw-predicate val)
+                                     (wrap-predicate val))
+                                 (let ([w (opt-wrap-maker val contract/info)])
+                                   (opt-wrap-set w j free-var) (... ...)
+                                   w)]
+                                [else
+                                 (raise-contract-error
+                                  val
+                                  src-info
+                                  pos
+                                  orig-str
+                                  "expected <~a>, got ~e"
+                                  ((name-get ctc) ctc)
+                                  val)]))
+                             lifts
+                             superlifts
+                             partials
+                             #f
+                             #f
+                             stronger-ribs)))))))]))
              )))]))
   
   (define (do-contract-name name/c name/dc list-of-subcontracts fields attrs)
@@ -550,7 +494,7 @@ it around flattened out.
            [else (apply build-compound-type-name name/dc fields)]))]))
   
   (define-struct contract/info (contract pos neg src-info orig-str))
-  (define-struct opt-contract/info (contract enforcer pos neg src-info orig-str))
+  (define-struct opt-contract/info (contract enforcer id))
 
   ;; parents : (listof wrap-parent)
   ;; vals : hash-table[symbol -o> (union (make-unknown proc[field-vals -> any]) any)
diff --git a/collects/mzlib/private/contract-opt-guts.ss b/collects/mzlib/private/contract-opt-guts.ss
index 6e7d90b64f..d20b882177 100644
--- a/collects/mzlib/private/contract-opt-guts.ss
+++ b/collects/mzlib/private/contract-opt-guts.ss
@@ -20,7 +20,8 @@
            opt/info-this
            opt/info-that
            
-           opt/info-swap-blame)
+           opt/info-swap-blame
+           opt/info-change-val)
   
   ;; a hash table of opters
   (define opters-table
@@ -70,6 +71,21 @@
           (that (opt/info-that info)))
       (make-opt/info ctc val pos neg src-info orig-str free-vars recf base-pred this that)))
   
+  ;; opt/info-change-val : identifier opt/info -> opt/info
+  ;; changes the name of the variable that the value-to-be-contracted is bound to
+  (define (opt/info-change-val val info)
+    (let ((ctc (opt/info-contract info))
+          (pos (opt/info-neg info))
+          (neg (opt/info-pos info))
+          (src-info (opt/info-src-info info))
+          (orig-str (opt/info-orig-str info))
+          (free-vars (opt/info-free-vars info))
+          (recf (opt/info-recf info))
+          (base-pred (opt/info-base-pred info))
+          (this (opt/info-this info))
+          (that (opt/info-that info)))
+      (make-opt/info ctc val neg pos src-info orig-str free-vars recf base-pred this that)))
+  
   
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;;
diff --git a/collects/mzlib/private/contract-opt.ss b/collects/mzlib/private/contract-opt.ss
index cf7d4bbdb9..32c99a4d33 100644
--- a/collects/mzlib/private/contract-opt.ss
+++ b/collects/mzlib/private/contract-opt.ss
@@ -7,7 +7,7 @@
                       (lib "stxparam.ss")
                       (lib "list.ss"))
   
-  (provide opt/c define-opt/c define/opter define/osc opt-stronger-vars-ref)
+  (provide opt/c define-opt/c define/opter opt-stronger-vars-ref)
   
   ;; define/opter : id -> syntax
   ;;
@@ -146,7 +146,7 @@
               (module-identifier=? (syntax-parameter-value #'define/opt-recursive-fn)
                                    #'f))
          (values
-          #`(f #,(opt/info-val opt/info) arg ...)
+          #`(#,(syntax-parameter-value #'define/opt-recursive-fn) #,(opt/info-val opt/info) arg ...)
           null
           null
           null
@@ -157,129 +157,53 @@
          (opt/unknown opt/i opt/info stx)]))
     
     (syntax-case stx ()
-      [(_ e)
+      [(_ e) #'(opt/c e ())]
+      [(_ e (opt-recursive-args ...))
        (let*-values ([(info) (make-opt/info #'ctc
                                             #'val
                                             #'pos
                                             #'neg
                                             #'src-info
                                             #'orig-str
-                                            null
+                                            (syntax->list #'(opt-recursive-args ...))
                                             #f
                                             #f
                                             #'this
                                             #'that)]
                      [(next lifts superlifts partials _ __ stronger-ribs) (opt/i info #'e)])
          (with-syntax ([next next])
-           (let ([superlifts2
-                  (if (syntax-parameter-value #'define/opt-recursive-fn)
-                      (cons (cons
-                             (syntax-parameter-value #'define/opt-recursive-fn)
-                             (with-syntax ([(args ...)
-                                            (syntax-parameter-value #'define/opt-recursive-args)])
-                               #'(lambda (val info args ...) 'next)))
-                            superlifts)
-                      superlifts)])
-             (bind-superlifts 
-              superlifts2
-              (bind-lifts
-               lifts
-               #`(make-opt-contract
-                  (λ (ctc)
-                    (λ (pos neg src-info orig-str)
-                      #,(bind-lifts
-                         partials
-                         #`(λ (val) 
-                             next))))
-                  (λ () e)
-                  (λ (this that) #f)
-                  (vector)
-                  (begin-lifted (box #f))))))))]))
+           (bind-superlifts
+            superlifts
+            (bind-lifts
+             lifts
+             #`(make-opt-contract
+                (λ (ctc)
+                  (λ (pos neg src-info orig-str)
+                    #,(if (syntax-parameter-value #'define/opt-recursive-fn)
+                          (with-syntax ([f (syntax-parameter-value #'define/opt-recursive-fn)])
+                            (bind-superlifts
+                             (cons
+                              (cons (syntax-parameter-value #'define/opt-recursive-fn)
+                                    #'(λ (val opt-recursive-args ...) next))
+                              partials)
+                             #'(λ (val) 
+                                 (f val opt-recursive-args ...))))
+                          (bind-superlifts
+                           partials
+                           #`(λ (val) next)))))
+                (λ () e)
+                (λ (this that) #f)
+                (vector)
+                (begin-lifted (box #f)))))))]))
 
   (define-syntax-parameter define/opt-recursive-fn #f)
-  (define-syntax-parameter define/opt-recursive-args #f)
   
   (define-syntax (define-opt/c stx)
     (syntax-case stx ()
       [(_ (id args ...) body)
        #'(define (id args ...)
-           (syntax-parameterize ([define/opt-recursive-fn #'id]
-                                 [define/opt-recursive-args #'(args ...)])
-                                (opt/c body)))]))
-  
-  ;; define/osc : syntax -> syntax
-  ;; define/osc allows you define optimized recursive contracts, and must be used
-  ;; to define struct contracts.
-  (define-syntax (define/osc stx)
-    
-    ;; opt/i : id opt/info syntax ->
-    ;;          syntax syntax-list syntax-list (union syntax #f) (union syntax #f)
-    ;;
-    ;; this is different from opt/i only in the aspect that it calls the recursive-call opter
-    ;; if it recognizes a recursive call.
-    (define (opt/i opt/info stx)
-      (syntax-case stx ()
-        [(ctc arg ...)
-         (and (identifier? #'ctc) (or (opter #'ctc)
-                                      (module-identifier=? (opt/info-recf opt/info) #'ctc)))
-         (if (module-identifier=? (opt/info-recf opt/info) #'ctc)
-             ;; this is a recursive call
-             (opt/recursive-call opt/info stx)
-             ((opter #'ctc) opt/i opt/info stx))]
-        [argless-ctc
-         (and (identifier? #'argless-ctc) (opter #'argless-ctc))
-         ((opter #'argless-ctc) opt/i opt/info stx)]
-        [else
-         (opt/unknown opt/i opt/info stx)]))
-    
-    (syntax-case stx ()
-      [(_ (f arg ...) base-pred e)
-       (let*-values ([(info) (make-opt/info #'ctc
-                                            #'val
-                                            #'pos
-                                            #'neg
-                                            #'src-info
-                                            #'orig-str
-                                            (syntax->list (syntax (arg ...)))
-                                            #'f
-                                            #'base-pred
-                                            #'this
-                                            #'that)]
-                     [(next lifts superlifts partials _ __ stronger-ribs) (opt/i info #'e)])
-         (with-syntax ((next next)
-                       ((superlift ...) (map (λ (x) (with-syntax ((var (car x))
-                                                                  (e (cdr x)))
-                                                      (syntax (define var e)))) superlifts))
-                       ((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) values))
-                       ((stronger-var ...) (map stronger-rib-save-id stronger-ribs)))
-           #`(begin
-               ;; superlifts are defines
-               superlift ...
-               
-               (define (f arg ...)
-                 
-                 #,(bind-lifts 
-                    lifts
-                    #`(make-opt-contract
-                       (λ (ctc)
-                         (λ (pos neg src-info orig-str)
-                           #,(bind-lifts
-                              partials
-                              #`(λ (val) (if (base-pred val) 
-                                             val
-                                             next)))))
-                       (λ () e)
-                       (λ (this that) 
-                         (let ([stronger-that-var (vector-ref (opt-contract-stronger-vars that) stronger-indexes)]
-                               ...
-                               [stronger-this-var (vector-ref (opt-contract-stronger-vars this) stronger-indexes)]
-                               ...)
-                           (and stronger-exps ...)))
-                       (vector stronger-var ...)
-                       (begin-lifted (box #f))))))))]))
+           (syntax-parameterize ([define/opt-recursive-fn #'id])
+                                (opt/c body (args ...))))]))
     
   ;; optimized contracts
   ;;
diff --git a/collects/mzlib/private/contract.ss b/collects/mzlib/private/contract.ss
index f59c84cb8a..c0c49114d3 100644
--- a/collects/mzlib/private/contract.ss
+++ b/collects/mzlib/private/contract.ss
@@ -1288,9 +1288,14 @@ add struct contracts for immutable structs?
                       (and (number? x)
                            (<= n x m))))))))
   
-  (define (check-unary-between/c sym x)
-    (unless (number? x)
-      (error sym "expected a number, got ~e" x)))
+  (define-syntax (check-unary-between/c stx)
+    (syntax-case stx ()
+      [(_ 'sym x-exp)
+       (identifier? #'sym)
+       #'(let ([x x-exp])
+           (unless (number? x)
+             (error 'sym "expected a number, got ~e" x)))]))
+  
   (define (=/c x) 
     (check-unary-between/c '=/c x)
     (make-between/c x x))
@@ -1377,16 +1382,17 @@ add struct contracts for immutable structs?
                           (this (opt/info-this opt/info))
                           (that (opt/info-that opt/info)))
               (values
-               (syntax (if (and (number? val) (comparison val m)) 
-                           val
-                           (raise-contract-error
-                            val
-                            src-info
-                            pos
-                            orig-str
-                            "expected <~a>, given: ~e"
-                            ((name-get ctc) ctc)
-                            val)))
+               (syntax 
+                (if (and (number? val) (comparison val m)) 
+                    val
+                    (raise-contract-error
+                     val
+                     src-info
+                     pos
+                     orig-str
+                     "expected <~a>, given: ~e"
+                     ((name-get ctc) ctc)
+                     val)))
                lifts3
                null
                null
diff --git a/collects/tests/mzscheme/contract-test.ss b/collects/tests/mzscheme/contract-test.ss
index 172b7700df..42c628d2b9 100644
--- a/collects/tests/mzscheme/contract-test.ss
+++ b/collects/tests/mzscheme/contract-test.ss
@@ -3552,6 +3552,202 @@
       ((couple-tl (contract c x 'pos 'neg)) -11)))
   
   
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;;
+  ;;  testing define-opt/c
+  ;;
+  
+  (contract-eval '(define-contract-struct node (val obj rank left right) (make-inspector)))
+  (contract-eval '(define (compute-rank n)
+                    (cond
+                      [(not n) 0]
+                      [else (node-rank n)])))
+  
+  (contract-eval '(define-opt/c (leftist-heap-greater-than/rank/opt n r)
+                    (or/c not
+                          (node/dc [val (>=/c n)]
+                                   [obj any/c]
+                                   [rank (<=/c r)]
+                                   [left (val) (leftist-heap-greater-than/rank/opt val +inf.0)]
+                                   [right (val left) (leftist-heap-greater-than/rank/opt val (compute-rank left))]))))
+  
+  (contract-eval '(define leftist-heap/c (leftist-heap-greater-than/rank/opt -inf.0 +inf.0)))
+  
+  (test/pos-blame 'd-o/c1 '(contract leftist-heap/c 2 'pos 'neg))
+  
+  
+  (test/spec-passed 'd-o/c2 '(contract leftist-heap/c (make-node 1 2 3 #f #f) 'pos 'neg))
+  (test/spec-passed 'd-o/c3 '(contract leftist-heap/c #f 'pos 'neg))
+  (test/spec-passed 'd-o/c4 '(contract leftist-heap/c (make-node 1 2 3 #f #f) 'pos 'neg))
+  (test/spec-passed/result 'd-o/c5
+                           '(node? (contract leftist-heap/c (make-node 1 2 3 #f #f) 'pos 'neg))
+                           #t)
+  
+  (test/spec-passed/result 'd-o/c6 '(node-val (contract leftist-heap/c (make-node 1 2 3 #f #f) 'pos 'neg)) 1)
+  (test/spec-passed/result 'd-o/c7 '(node-obj (contract leftist-heap/c (make-node 1 2 3 #f #f) 'pos 'neg)) 2)
+  (test/spec-passed/result 'd-o/c8 '(node-rank (contract leftist-heap/c (make-node 1 2 3 #f #f) 'pos 'neg)) 3)
+  (test/spec-passed/result 'd-o/c9 '(node-left (contract leftist-heap/c (make-node 1 2 3 #f #f) 'pos 'neg)) #f)
+  (test/spec-passed/result 'd-o/c10 '(node-right (contract leftist-heap/c (make-node 1 2 3 #f #f) 'pos 'neg)) #f)
+  
+  (test/spec-passed/result 'd-o/c11
+                           '(node-val (contract leftist-heap/c 
+                                                (contract leftist-heap/c 
+                                                          (make-node 1 2 3 #f #f)
+                                                          'pos 'neg)
+                                                'pos 'neg))
+                           1)
+  (test/spec-passed/result 'd-o/c12
+                           '(node-obj (contract leftist-heap/c 
+                                                (contract leftist-heap/c 
+                                                          (make-node 1 2 3 #f #f)
+                                                          'pos 'neg)
+                                                'pos 'neg))
+                           2)
+  (test/spec-passed/result 'd-o/c13
+                           '(node-rank (contract leftist-heap/c 
+                                                 (contract leftist-heap/c 
+                                                           (make-node 1 2 3 #f #f)
+                                                           'pos 'neg)
+                                                 'pos 'neg))
+                           3)
+  (test/spec-passed/result 'd-o/c14
+                           '(node-left (contract leftist-heap/c 
+                                                 (contract leftist-heap/c 
+                                                           (make-node 1 2 3 #f #f)
+                                                           'pos 'neg)
+                                                 'pos 'neg)) 
+                           #f)
+  (test/spec-passed/result 'd-o/c15
+                           '(node-right (contract leftist-heap/c 
+                                                  (contract leftist-heap/c 
+                                                            (make-node 1 2 3 #f #f)
+                                                            'pos 'neg)
+                                                  'pos 'neg))
+                           #f)
+  
+  (test/spec-passed/result 'd-o/c16
+                           '(let ([h (contract leftist-heap/c (make-node 1 2 3 #f #f) 'pos 'neg)])
+                              (node-val h)
+                              (node-val h))
+                           1)
+  (test/spec-passed/result 'd-o/c17
+                           '(let ([h (contract leftist-heap/c (make-node 1 2 3 #f #f) 'pos 'neg)])
+                              (node-obj h)
+                              (node-obj h))
+                           2)
+  
+  (test/spec-passed/result 'd-o/c18
+                           '(let ([h (contract leftist-heap/c (make-node 1 2 3 #f #f)'pos 'neg)])
+                              (node-rank h)
+                              (node-rank h))
+                           3)
+  (test/spec-passed/result 'd-o/c19
+                           '(let ([h (contract leftist-heap/c (make-node 1 2 3 #f #f) 'pos 'neg)])
+                              (node-left h)
+                              (node-left h))
+                           #f)
+  (test/spec-passed/result 'd-o/c20
+                           '(let ([h (contract leftist-heap/c (make-node 1 2 3 #f #f) 'pos 'neg)])
+                              (node-right h)
+                              (node-right h))
+                           #f)
+  
+  (test/spec-passed/result 'd-o/c21
+                           '(node-val
+                             (node-right
+                              (contract leftist-heap/c 
+                                        (make-node 1 2 3 
+                                                   (make-node 7 8 9 #f #f)
+                                                   (make-node 4 5 6 #f #f))
+                                        'pos 'neg)))
+                           4)
+  (test/spec-passed/result 'd-o/c22
+                           '(node-val
+                             (node-left
+                              (contract leftist-heap/c 
+                                        (make-node 1 2 3 
+                                                   (make-node 7 8 9 #f #f)
+                                                   (make-node 4 5 6 #f #f))
+                                        'pos 'neg)))
+                           7)
+  
+  (test/pos-blame 'd-o/c23
+                  '(node-val
+                    (node-right
+                     (contract leftist-heap/c 
+                               (make-node 5 2 3 
+                                          (make-node 7 8 9 #f #f)
+                                          (make-node 4 5 6 #f #f))
+                               'pos 'neg))))
+  
+  (test/pos-blame 'd-o/c24
+                  '(node-val
+                    (node-left
+                     (contract leftist-heap/c 
+                               (make-node 9 2 3 
+                                          (make-node 7 8 9 #f #f)
+                                          (make-node 11 5 6 #f #f))
+                               'pos 'neg))))
+  
+  (test/neg-blame 'd-o/c25
+                  '((contract (-> leftist-heap/c any)
+                              (λ (kh)
+                                (node-val
+                                 (node-left
+                                  kh)))
+                              'pos 'neg)
+                    (make-node 9 2 3 
+                               (make-node 7 8 9 #f #f)
+                               (make-node 11 5 6 #f #f))))
+  
+  
+  
+  (test/spec-passed/result
+   'd-o/c26 
+   '(let ([ai (λ (x) (contract leftist-heap/c x 'pos 'neg))])
+      (define (remove-min t) (merge (node-left t) (node-right t)))
+      
+      (define (merge t1 t2)
+        (cond
+          [(not t1) t2]
+          [(not t2) t1]
+          [else
+           (let ([t1-val (node-val t1)]
+                 [t2-val (node-val t2)])
+             (cond
+               [(<= t1-val t2-val)
+                (pick t1-val 
+                      (node-obj t1)
+                      (node-left t1)
+                      (merge (node-right t1)
+                             t2))]
+               [else
+                (pick t2-val 
+                      (node-obj t2)
+                      (node-left t2)
+                      (merge t1
+                             (node-right t2)))]))]))
+      
+      (define (pick x obj a b)
+        (let ([ra (compute-rank a)]
+              [rb (compute-rank b)])
+          (cond
+            [(>= ra rb)
+             (make-node x obj (+ rb 1) a b)]
+            [else
+             (make-node x obj (+ ra 1) b a)])))
+      (node-val
+       (remove-min (ai (make-node 137 'x 1 
+                                  (ai (make-node 178 'y 1 
+                                                 (make-node 178 'z 1 #f #f)
+                                                 #f))
+                                  #f)))))
+   178)
+  
+  ;;
+  ;;  end of define-opt/c
+  ;;
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   
   ;; NOT YET RELEASED
   #;