diff --git a/collects/mzlib/private/unit-contract.ss b/collects/mzlib/private/unit-contract.ss
index a7e6a8fdb1..2447abfafa 100644
--- a/collects/mzlib/private/unit-contract.ss
+++ b/collects/mzlib/private/unit-contract.ss
@@ -60,15 +60,13 @@ packed with the neg blame.
                ;; If contract coersion ends up being a large overhead, we can
                ;; store the result in a local box, then just check the box to
                ;; see if we need to coerce.
-               (with-syntax ([ctc-stx (syntax-property #`(letrec-syntax #,rename-bindings #,ctc)
-                                                       'inferred-name var)])
-                 #`(let ([ctc (coerce-contract 'unit/c ctc-stx)])
-                     ((((proj-get ctc) ctc)
-                       #,(if import? neg pos)
-                       #,(if import? pos neg)
-                       #,src-info
-                       #,name)
-                      #,stx))))])
+               #`(let ([ctc (coerce-contract 'unit/c (letrec-syntax #,rename-bindings #,ctc))])
+                   ((((proj-get ctc) ctc)
+                     #,(if import? neg pos)
+                     #,(if import? pos neg)
+                     #,src-info
+                     #,name)
+                    #,stx)))])
         (if ctc
             #`(cons
                #,(if import?
@@ -79,9 +77,13 @@ packed with the neg blame.
                                        #`(let ([old-v/c ((car #,vref))])
                                            (cons #,(wrap-with-proj 
                                                     ctc 
-                                                    #`(contract #,sig-ctc (car old-v/c)
-                                                                (cdr old-v/c) #,pos
-                                                                #,(id->contract-src-info var)))
+                                                    (with-syntax ([sig-ctc-stx
+                                                                   (syntax-property sig-ctc
+                                                                                    'inferred-name
+                                                                                    var)])
+                                                      #`(contract sig-ctc-stx (car old-v/c)
+                                                                  (cdr old-v/c) #,pos
+                                                                  #,(id->contract-src-info var))))
                                                  #,neg))
                                        (wrap-with-proj ctc #`((car #,vref))))])
                            old-v)))
@@ -91,9 +93,13 @@ packed with the neg blame.
                                  #,(if sig-ctc
                                        #`(cons #,(wrap-with-proj 
                                                   ctc 
-                                                  #`(contract #,sig-ctc (car v)
-                                                              (cdr v) #,neg
-                                                              #,(id->contract-src-info var)))
+                                                  (with-syntax ([sig-ctc-stx
+                                                                 (syntax-property sig-ctc
+                                                                                  'inferred-name
+                                                                                  var)])
+                                                    #`(contract sig-ctc-stx (car v)
+                                                                (cdr v) #,neg
+                                                                #,(id->contract-src-info var))))
                                                #,pos)
                                        (wrap-with-proj ctc #'v))])
                            ((cdr #,vref) new-v)))
diff --git a/collects/mzlib/unit.ss b/collects/mzlib/unit.ss
index 0b25cdcba1..64eed9164e 100644
--- a/collects/mzlib/unit.ss
+++ b/collects/mzlib/unit.ss
@@ -459,11 +459,12 @@
                  
   (define-for-syntax (make-import-unboxing var loc ctc)
     (if ctc
-        (quasisyntax/loc (error-syntax)
-          (quote-syntax (let ([v/c ((car #,loc))])
-                          (contract #,ctc (car v/c) (cdr v/c)
-                                    (current-contract-region)
-                                    #,(id->contract-src-info var)))))
+        (with-syntax ([ctc-stx (syntax-property ctc 'inferred-name var)])
+          (quasisyntax/loc (error-syntax)
+            (quote-syntax (let ([v/c ((car #,loc))])
+                            (contract ctc-stx (car v/c) (cdr v/c)
+                                      (current-contract-region)
+                                      #,(id->contract-src-info var))))))
         (quasisyntax/loc (error-syntax)
           (quote-syntax ((car #,loc))))))
   
@@ -1278,9 +1279,13 @@
                                (map (λ (tb i v c)
                                       #`(let ([v/c ((car #,tb))])
                                           #,(if c
-                                                #`(contract (letrec-syntax #,rename-bindings #,c) (car v/c) (cdr v/c)
-                                                            (current-contract-region)
-                                                            #,(id->contract-src-info v))
+                                                (with-syntax ([ctc-stx
+                                                               (syntax-property
+                                                                #`(letrec-syntax #,rename-bindings #,c)
+                                                                'inferred-name v)])
+                                                  #`(contract ctc-stx (car v/c) (cdr v/c)
+                                                              (current-contract-region)
+                                                              #,(id->contract-src-info v)))
                                                 #'v/c)))
                                     tbs
                                     (iota (length (car os)))