diff --git a/collects/mzlib/contract.ss b/collects/mzlib/contract.ss
index 30abf6d70f..a07bee76a0 100644
--- a/collects/mzlib/contract.ss
+++ b/collects/mzlib/contract.ss
@@ -15,6 +15,13 @@
 (require "private/contract-object.ss")
 (provide (all-from-out "private/contract-object.ss"))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; old-style define/contract
+;;
+
+(require "private/contract-define.ss")
+(provide (all-from-out "private/contract-define.ss"))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
@@ -22,7 +29,9 @@
 ;; except the arrow contracts
 ;;
 
-(require scheme/private/contract
+(require (except-in scheme/private/contract
+                    define/contract
+                    with-contract)
          scheme/private/contract-guts
          scheme/private/contract-ds
          scheme/private/contract-opt
diff --git a/collects/mzlib/private/contract-define.ss b/collects/mzlib/private/contract-define.ss
new file mode 100644
index 0000000000..12891e145a
--- /dev/null
+++ b/collects/mzlib/private/contract-define.ss
@@ -0,0 +1,70 @@
+#lang scheme/base
+
+(provide define/contract)
+
+(require (for-syntax scheme/base)
+         (only-in scheme/contract contract)
+         (for-syntax (prefix-in a: scheme/private/contract-helpers)))
+
+;; First, we have the old define/contract implementation, which
+;; is still used in mzlib/contract.
+
+(define-for-syntax (make-define/contract-transformer contract-id id)
+  (make-set!-transformer
+   (λ (stx)
+     (with-syntax ([neg-blame-str (a:build-src-loc-string stx)]
+                   [contract-id contract-id]
+                   [id id])
+       (syntax-case stx (set!)
+         [(set! id arg)
+          (raise-syntax-error 'define/contract
+                              "cannot set! a define/contract variable"
+                              stx
+                              (syntax id))]
+         [(f arg ...)
+          (syntax/loc stx
+            ((contract contract-id
+                       id
+                       (syntax->datum (quote-syntax f))
+                       neg-blame-str
+                       (quote-syntax f))
+             arg
+             ...))]
+         [ident
+          (identifier? (syntax ident))
+          (syntax/loc stx
+            (contract contract-id
+                      id
+                      (syntax->datum (quote-syntax ident))
+                      neg-blame-str
+                      (quote-syntax ident)))])))))
+
+;; (define/contract id contract expr)
+;; defines `id' with `contract'; initially binding
+;; it to the result of `expr'.  These variables may not be set!'d.
+(define-syntax (define/contract define-stx)
+  (syntax-case define-stx ()
+    [(_ name contract-expr expr)
+     (identifier? (syntax name))
+     (with-syntax ([contract-id
+                    (a:mangle-id define-stx
+                                 "define/contract-contract-id"
+                                 (syntax name))]
+                   [id (a:mangle-id define-stx
+                                    "define/contract-id"
+                                    (syntax name))])
+       (syntax/loc define-stx
+         (begin
+           (define contract-id contract-expr)
+           (define-syntax name
+             (make-define/contract-transformer (quote-syntax contract-id)
+                                                   (quote-syntax id)))
+           (define id (let ([name expr]) name))  ;; let for procedure naming
+           )))]
+    [(_ name contract-expr expr)
+     (raise-syntax-error 'define/contract "expected identifier in first position"
+                         define-stx
+                         (syntax name))]))
+
+
+
diff --git a/collects/mzlib/scribblings/contract.scrbl b/collects/mzlib/scribblings/contract.scrbl
index 65dbd92e98..ba6047edbb 100644
--- a/collects/mzlib/scribblings/contract.scrbl
+++ b/collects/mzlib/scribblings/contract.scrbl
@@ -56,7 +56,6 @@ from @schememodname[scheme/contract]:
  contract-violation->string
  contract?
  define-contract-struct
- define/contract
  false/c
  flat-contract
  flat-contract-predicate
@@ -91,3 +90,22 @@ from @schememodname[scheme/contract]:
  vector/c
  vectorof]
 
+It also provides the old version of @scheme[define/contract]:
+
+@defform[(define/contract id contract-expr init-value-expr)]{
+
+Attaches the contract @scheme[contract-expr] to
+@scheme[init-value-expr] and binds that to @scheme[id].
+
+The @scheme[define/contract] form treats individual definitions as
+units of blame. The definition itself is responsible for positive
+(co-variant) positions of the contract and each reference to
+@scheme[id] (including those in the initial value expression) must
+meet the negative positions of the contract.
+
+Error messages with @scheme[define/contract] are not as clear as those
+provided by @scheme[provide/contract], because
+@scheme[define/contract] cannot detect the name of the definition
+where the reference to the defined variable occurs. Instead, it uses
+the source location of the reference to the variable as the name of
+that definition.}
diff --git a/collects/mzlib/unit.ss b/collects/mzlib/unit.ss
index c2e0fa166f..4503056fd1 100644
--- a/collects/mzlib/unit.ss
+++ b/collects/mzlib/unit.ss
@@ -469,13 +469,11 @@
                          #,(syntax-span id))
             #,(format "~s" (syntax-object->datum id))))
   
-  (define-syntax-parameter current-unit-blame-stx (lambda (stx) #'(#%variable-reference)))
-  
   (define-for-syntax (make-import-unboxing var loc ctc)
     (if ctc
         (quasisyntax/loc (error-syntax)
           (quote-syntax (contract #,ctc (unbox #,loc) 'cant-happen
-                                  (current-unit-blame-stx)
+                                  (current-contract-region)
                                   #,(id->contract-src-info var))))
         (quasisyntax/loc (error-syntax)
           (quote-syntax (unbox #,loc)))))
@@ -556,7 +554,7 @@
                (vector-immutable (cons 'export-name 
                                        (vector-immutable export-key ...)) ...)
                (list (cons 'dept depr) ...)
-               (syntax-parameterize ([current-unit-blame-stx (lambda (stx) #'(quote (unit name)))])
+               (syntax-parameterize ([current-contract-region (lambda (stx) #'(quote (unit name)))])
                  (lambda ()
                    (let ([eloc (box undefined)] ... ...)
                      (values 
@@ -693,7 +691,7 @@
                   (set-var-info-add-ctc! 
                    v
                    (λ (e)
-                     #`(contract #,(cdr (syntax-e ctc)) #,e (current-unit-blame-stx) 
+                     #`(contract #,(cdr (syntax-e ctc)) #,e (current-contract-region) 
                                  'cant-happen #,(id->contract-src-info e)))))))
             (syntax->list (localify #'evars def-ctx))
             (syntax->list #'elocs)
@@ -1219,7 +1217,7 @@
                             (lambda (i v c)
                               (if c
                                   #`(contract #,c (unbox (vector-ref #,ov #,i))
-                                              'cant-happen (current-unit-blame-stx)
+                                              'cant-happen (current-contract-region)
                                               #,(id->contract-src-info v))
                                   #`(unbox (vector-ref #,ov #,i))))
                             (iota (length (car os)))
diff --git a/collects/scheme/private/contract-guts.ss b/collects/scheme/private/contract-guts.ss
index 6ff2129aed..b998a7521e 100644
--- a/collects/scheme/private/contract-guts.ss
+++ b/collects/scheme/private/contract-guts.ss
@@ -180,8 +180,7 @@
         [formatted-contract-sexp
          (let ([one-line 
                 (let ([sp (open-output-string)])
-                  (parameterize ([pretty-print-print-line print-contract-liner]
-                                 [pretty-print-columns 'infinity])
+                  (parameterize ([pretty-print-columns 'infinity])
                     (pretty-print contract-sexp sp)
                     (get-output-string sp)))])
            (if (< (string-length one-line) 30)
diff --git a/collects/scheme/private/contract.ss b/collects/scheme/private/contract.ss
index 729fe92bf2..6970090e55 100644
--- a/collects/scheme/private/contract.ss
+++ b/collects/scheme/private/contract.ss
@@ -12,13 +12,20 @@ improve method arity mismatch contract violation error messages?
 (provide (rename-out [-contract contract])
          recursive-contract
          provide/contract
-         define/contract)
+         define/contract
+         with-contract
+         current-contract-region)
 
 (require (for-syntax scheme/base)
          (for-syntax "contract-opt-guts.ss")
          (for-syntax scheme/struct-info)
          (for-syntax scheme/list)
-         scheme/promise)
+         (for-syntax syntax/define)
+         (for-syntax syntax/kerncase)
+         scheme/promise
+         scheme/stxparam
+         scheme/splicing
+         mzlib/etc)
 
 (require "contract-arrow.ss"
          "contract-guts.ss"
@@ -28,6 +35,24 @@ improve method arity mismatch contract violation error messages?
          (for-syntax (prefix-in a: "contract-helpers.ss")))
 
 
+;; These are useful for all below.
+
+(define-syntax (verify-contract stx)
+  (syntax-case stx ()
+    [(_ name x) (a:known-good-contract? #'x) #'x]
+    [(_ name x) #'(coerce-contract name x)]))
+
+;; id->contract-src-info : identifier -> syntax
+;; constructs the last argument to the -contract, given an identifier
+(define-for-syntax (id->contract-src-info id)
+  #`(list (make-srcloc #,id
+                       #,(syntax-line id)
+                       #,(syntax-column id)
+                       #,(syntax-position id)
+                       #,(syntax-span id))
+          #,(format "~s" (syntax->datum id))))
+
+
 
 ;                                                                                                    
 ;                                                                                                    
@@ -46,6 +71,267 @@ improve method arity mismatch contract violation error messages?
 ;                                          ;                                                         
 ;                                                                                                    
 
+;; (define/contract id contract expr)
+;; defines `id' with `contract'; initially binding
+;; it to the result of `expr'.  These variables may not be set!'d.
+(define-syntax (define/contract define-stx)
+  (when (eq? (syntax-local-context) 'expression)
+    (raise-syntax-error 'define/contract
+                        "used in expression context"
+                        define-stx))
+  (syntax-case define-stx ()
+    [(_ name)
+     (raise-syntax-error 'define/contract
+                         "no contract or body"
+                         define-stx)]
+    [(_ name contract-expr)
+     (raise-syntax-error 'define/contract
+                         "no body after contract"
+                         define-stx)]
+    [(_ name contract-expr expr)
+     (identifier? #'name)
+     (let ([contract (if (a:known-good-contract? #'contract-expr)
+                         #'contract-expr
+                         #'(verify-contract 'define/contract contract-expr))])
+       (quasisyntax/loc define-stx
+         (with-contract #:type definition name
+           ([name #,contract])
+           (define name expr))))]
+    [(_ name contract-expr expr0 expr ...)
+     (identifier? #'name)
+     (raise-syntax-error 'define/contract
+                         "multiple expressions after identifier and contract"
+                         define-stx)]
+    [(_ name+arg-list contract body0 body ...)
+     (let-values ([(name lam-expr)
+                   (normalize-definition
+                    (datum->syntax #'define-stx (list* 'define/contract #'name+arg-list
+                                                       #'body0 #'(body ...)))
+                    #'lambda #t #t)])
+       (with-syntax ([name name]
+                     [lam-expr lam-expr])
+         (syntax/loc define-stx
+           (with-contract #:type function name
+             ([name (verify-contract 'define/contract contract)])
+             (define name lam-expr)))))]))
+
+
+
+;                                                                                         
+;                                                                                         
+;              ;       ;                                                                  
+;                  ;   ;                                     ;                         ;  
+;                  ;   ;                                     ;                         ;  
+;  ;    ;    ; ;  ;;;; ; ;;;          ;;;     ;;;    ; ;;;  ;;;; ; ;;   ;;;;     ;;;  ;;;;
+;  ;    ;    ; ;   ;   ;;   ;        ;   ;   ;   ;   ;;   ;  ;   ;;    ;    ;   ;   ;  ;  
+;   ;  ; ;  ;  ;   ;   ;    ;       ;       ;     ;  ;    ;  ;   ;    ;     ;  ;       ;  
+;   ;  ; ;  ;  ;   ;   ;    ;       ;       ;     ;  ;    ;  ;   ;        ;;;  ;       ;  
+;   ; ;   ; ;  ;   ;   ;    ;       ;       ;     ;  ;    ;  ;   ;     ;;;  ;  ;       ;  
+;   ; ;   ; ;  ;   ;   ;    ; ;;;;  ;       ;     ;  ;    ;  ;   ;    ;     ;  ;       ;  
+;   ; ;   ; ;  ;   ;   ;    ;       ;       ;     ;  ;    ;  ;   ;    ;     ;  ;       ;  
+;    ;     ;   ;   ;   ;    ;        ;   ;   ;   ;   ;    ;  ;   ;    ;    ;;   ;   ;  ;  
+;    ;     ;   ;   ;;; ;    ;         ;;;     ;;;    ;    ;  ;;; ;     ;;;; ;    ;;;   ;;;
+;                                                                                         
+;                                                                                         
+;                                                                                         
+
+(define-syntax-parameter current-contract-region (λ (stx) #'(#%variable-reference)))
+
+(define-for-syntax (make-with-contract-transformer contract-id id pos-blame-id)
+  (make-set!-transformer
+   (lambda (stx)
+     (with-syntax ([neg-blame-id #'(current-contract-region)]
+                   [pos-blame-id pos-blame-id]
+                   [contract-id contract-id]
+                   [id id])
+       (syntax-case stx (set!)
+         [(set! id arg)
+          (raise-syntax-error 'with-contract
+                              "cannot set! a with-contract variable"
+                              stx
+                              (syntax id))]
+         [(f arg ...)
+          (syntax/loc stx
+            ((-contract contract-id
+                        id
+                        pos-blame-id
+                        neg-blame-id
+                        #'f)
+             arg ...))]
+         [ident
+          (identifier? (syntax ident))
+          (syntax/loc stx
+            (-contract contract-id
+                       id
+                       pos-blame-id
+                       neg-blame-id
+                       #'ident))])))))
+
+(define-for-syntax (head-expand-all body-stxs)
+  (apply append
+         (for/list ([stx body-stxs])
+           (let ([exp-form (local-expand stx
+                                         (syntax-local-context)
+                                         (kernel-form-identifier-list))])
+             (syntax-case exp-form (begin)
+               [(begin form ...)
+                (head-expand-all (syntax->list #'(form ...)))]
+               [_
+                (list exp-form)])))))
+
+(define-for-syntax (check-exports ids body-stxs)
+  (let ([defd-ids (for/fold ([id-list null])
+                            ([stx body-stxs])
+                    (kernel-syntax-case stx #f
+                      [(define-values ids expr)
+                       (append (syntax->list #'ids)
+                               id-list)]
+                      [_ id-list]))])
+    (for ([id (in-list ids)])
+         (unless (findf (lambda (s)
+                          (bound-identifier=? s id))
+                        defd-ids)
+           (raise-syntax-error 'with-contract
+                               "identifier not defined in body"
+                               id)))))
+
+(define-for-syntax (check-and-split-with-contract-args args)
+  (let loop ([args args]
+             [unprotected null]
+             [protected null]
+             [protections null])
+    (cond
+      [(null? args)
+       (values unprotected protected protections)]
+      [(identifier? (car args))
+       (loop (cdr args)
+             (cons (car args) unprotected)
+             protected
+             protections)]
+      [(let ([lst (syntax->list (car args))])
+         (and (list? lst)
+              (= (length lst) 2)
+              (identifier? (first lst))
+              lst))
+       =>
+       (lambda (l)
+         (loop (cdr args)
+               unprotected
+               (cons (first l) protected)
+               (cons (second l) protections)))]
+      [else
+       (raise-syntax-error 'with-contract
+                           "expected an identifier or (identifier contract)"
+                           (car args))])))
+
+(define-syntax (with-contract stx)
+  (when (eq? (syntax-local-context) 'expression)
+    (raise-syntax-error 'with-contract
+                        "used in expression context"
+                        stx))
+  (syntax-case stx ()
+    [(_ #:type type blame (arg ...) body0 body ...)
+     (and (identifier? #'blame)
+          (identifier? #'type))
+     (let*-values ([(marker) (make-syntax-introducer)]
+                   [(unprotected protected protections)
+                    (check-and-split-with-contract-args (syntax->list #'(arg ...)))]
+                   [(expanded-bodies)
+                    (head-expand-all (cons #'body0 (syntax->list #'(body ...))))]
+                   [(protected-ids contracts contract-defs)
+                    (for/lists (protected-ids contracts contract-defs)
+                      ([n protected]
+                       [c protections])
+                      (if (a:known-good-contract? c)
+                          (values n c #f)
+                          (let ([contract-id (a:mangle-id stx "with-contract-contract-id" n)])
+                            (values n contract-id
+                                    (quasisyntax/loc stx
+                                      (define-values (#,contract-id)
+                                        (verify-contract 'with-contract #,c)))))))])
+       (begin
+         (let* ([all-ids (append unprotected protected)]
+                [dupd-id (check-duplicate-identifier all-ids)])
+           (when dupd-id
+             (raise-syntax-error 'with-contract
+                                 "identifier appears twice in exports"
+                                 dupd-id))
+           (check-exports (append unprotected protected) expanded-bodies))
+         (with-syntax ([(contract-def ...) (map marker (filter values contract-defs))]
+                       [blame-stx #''(type blame)]
+                       [(marked-body ...) (map marker expanded-bodies)])
+           (quasisyntax/loc stx
+             (splicing-syntax-parameterize ([current-contract-region (λ (stx) #'blame-stx)])
+               marked-body ...
+               contract-def ...
+               #,@(map (λ (p c)
+                         #`(define-syntax #,p
+                             (make-with-contract-transformer
+                              (quote-syntax #,(marker c))
+                              (quote-syntax #,(marker p))
+                              (quote-syntax blame-stx))))
+                         protected-ids contracts)
+               #,@(map (λ (u)
+                         #`(define-syntax #,u
+                             (make-rename-transformer (quote-syntax #,(marker u)))))
+                         unprotected)
+               (define-values ()
+                 (begin
+                   #,@(map (λ (p c)
+                             #`(-contract #,(marker c) #,(marker p) blame-stx 'ignored #,(id->contract-src-info p)))
+                           protected-ids contracts)
+                   (values)))
+               )))))]
+    [(_ #:type type blame (arg ...) body0 body ...)
+     (raise-syntax-error 'with-contract
+                         "expected identifier for blame"
+                         #'blame)]
+    [(_ #:type type blame (arg ...))
+     (identifier? #'blame)
+     (raise-syntax-error 'with-contract
+                         "empty body"
+                         stx)]
+    [(_ #:type type blame bad-args etc ...)
+     (identifier? #'blame)
+     (raise-syntax-error 'with-contract
+                         "expected list of identifier and/or (identifier contract)"
+                         #'bad-args)]
+    [(_ #:type type args etc ...)
+     (not (identifier? #'args))
+     (raise-syntax-error 'with-contract
+                         "expected identifier for blame"
+                         #'args)]
+    [(_ #:type type etc ...)
+     (not (identifier? #'type))
+     (raise-syntax-error 'with-contract
+                         "expected identifier for type"
+                         #'type)]
+    [(_ #:type type blame)
+     (raise-syntax-error 'with-contract
+                         "only blame"
+                         stx)]
+    [(_ etc ...)
+     (syntax/loc stx
+       (with-contract #:type region etc ...))]))
+
+;                                                                                                            
+;                                                                                                            
+;                                                                                                            
+;                               ;       ;             ;                                                      
+;                                       ;             ;                                                      
+;                                       ;            ;                           ;                       ;   
+;   ; ;;    ; ;   ;;;   ;     ; ;    ;; ;    ;;;     ;     ;;;    ;;;    ; ;;   ;;;;  ; ;  ;;;     ;;;  ;;;; 
+;   ;;  ;   ;;   ;   ;   ;   ;  ;   ;  ;;   ;   ;    ;    ;   ;  ;   ;   ;;  ;   ;    ;;  ;   ;   ;   ;  ;   
+;   ;    ;  ;   ;     ;  ;   ;  ;  ;    ;  ;    ;    ;   ;      ;     ;  ;   ;   ;    ;       ;  ;       ;   
+;   ;    ;  ;   ;     ;   ; ;   ;  ;    ;  ;;;;;;   ;    ;      ;     ;  ;   ;   ;    ;    ;;;;  ;       ;   
+;   ;    ;  ;   ;     ;   ; ;   ;  ;    ;  ;        ;    ;      ;     ;  ;   ;   ;    ;   ;   ;  ;       ;   
+;   ;;  ;   ;    ;   ;     ;    ;   ;  ;;   ;       ;     ;   ;  ;   ;   ;   ;   ;    ;   ;   ;   ;   ;  ;   
+;   ; ;;    ;     ;;;      ;    ;    ;; ;    ;;;;  ;       ;;;    ;;;    ;   ;    ;;  ;    ;;;;;   ;;;    ;; 
+;   ;                                              ;                                                         
+;   ;                                              ;                                                         
+;   ;                                                                                                        
+
+
 ;; lookup-struct-info : syntax -> (union #f (list syntax syntax (listof syntax) ...))
 (define-for-syntax (lookup-struct-info stx provide-stx)
   (let ([id (syntax-case stx ()
@@ -59,46 +345,6 @@ improve method arity mismatch contract violation error messages?
                               provide-stx
                               id)))))
 
-(define-for-syntax (make-define/contract-transformer contract-id id)
-  (make-set!-transformer
-   (λ (stx)
-     (with-syntax ([neg-blame-str (a:build-src-loc-string stx)]
-                   [contract-id contract-id]
-                   [id id])
-       (syntax-case stx (set!)
-         [(set! id arg) 
-          (raise-syntax-error 'define/contract
-                              "cannot set! a define/contract variable" 
-                              stx 
-                              (syntax id))]
-         [(f arg ...)
-          (syntax/loc stx
-            ((-contract contract-id
-                        id
-                        (syntax->datum (quote-syntax f))
-                        neg-blame-str
-                        (quote-syntax f))
-             arg
-             ...))]
-         [ident
-          (identifier? (syntax ident))
-          (syntax/loc stx
-            (-contract contract-id
-                       id
-                       (syntax->datum (quote-syntax ident)) 
-                       neg-blame-str
-                       (quote-syntax ident)))])))))
-
-;; id->contract-src-info : identifier -> syntax
-;; constructs the last argument to the -contract, given an identifier
-(define-for-syntax (id->contract-src-info id)
-  #`(list (make-srcloc #,id
-                       #,(syntax-line id)
-                       #,(syntax-column id)
-                       #,(syntax-position id)
-                       #,(syntax-span id))
-          #,(format "~s" (syntax->datum id))))
-
 (define-for-syntax (make-provide/contract-transformer contract-id id pos-module-source)
   (make-set!-transformer
    (let ([saved-id-table (make-hasheq)])
@@ -140,51 +386,6 @@ improve method arity mismatch contract violation error messages?
            ;; delay expansion until it's a good time to lift expressions:
            (quasisyntax/loc stx (#%expression #,stx)))))))
 
-;; (define/contract id contract expr)
-;; defines `id' with `contract'; initially binding
-;; it to the result of `expr'.  These variables may not be set!'d.
-(define-syntax (define/contract define-stx)
-  (syntax-case define-stx ()
-    [(_ name contract-expr expr)
-     (identifier? (syntax name))
-     (with-syntax ([contract-id 
-                    (a:mangle-id define-stx
-                                 "define/contract-contract-id"
-                                 (syntax name))]
-                   [id (a:mangle-id define-stx
-                                    "define/contract-id"
-                                    (syntax name))])
-       (syntax/loc define-stx 
-         (begin
-           (define contract-id contract-expr)
-           (define-syntax name
-             (make-define/contract-transformer (quote-syntax contract-id)
-                                               (quote-syntax id)))
-           (define id (let ([name expr]) name))  ;; let for procedure naming
-           )))]
-    [(_ name contract-expr expr)
-     (raise-syntax-error 'define/contract "expected identifier in first position"
-                         define-stx
-                         (syntax name))])) 
-
-
-;                                                                                                            
-;                                                                                                            
-;                                                                                                            
-;                               ;       ;             ;                                                      
-;                                       ;             ;                                                      
-;                                       ;            ;                           ;                       ;   
-;   ; ;;    ; ;   ;;;   ;     ; ;    ;; ;    ;;;     ;     ;;;    ;;;    ; ;;   ;;;;  ; ;  ;;;     ;;;  ;;;; 
-;   ;;  ;   ;;   ;   ;   ;   ;  ;   ;  ;;   ;   ;    ;    ;   ;  ;   ;   ;;  ;   ;    ;;  ;   ;   ;   ;  ;   
-;   ;    ;  ;   ;     ;  ;   ;  ;  ;    ;  ;    ;    ;   ;      ;     ;  ;   ;   ;    ;       ;  ;       ;   
-;   ;    ;  ;   ;     ;   ; ;   ;  ;    ;  ;;;;;;   ;    ;      ;     ;  ;   ;   ;    ;    ;;;;  ;       ;   
-;   ;    ;  ;   ;     ;   ; ;   ;  ;    ;  ;        ;    ;      ;     ;  ;   ;   ;    ;   ;   ;  ;       ;   
-;   ;;  ;   ;    ;   ;     ;    ;   ;  ;;   ;       ;     ;   ;  ;   ;   ;   ;   ;    ;   ;   ;   ;   ;  ;   
-;   ; ;;    ;     ;;;      ;    ;    ;; ;    ;;;;  ;       ;;;    ;;;    ;   ;    ;;  ;    ;;;;;   ;;;    ;; 
-;   ;                                              ;                                                         
-;   ;                                              ;                                                         
-;   ;                                                                                                        
-
 
 ;; (provide/contract p/c-ele ...)
 ;; p/c-ele = (id expr) | (rename id id expr) | (struct id (id expr) ...)
@@ -483,7 +684,7 @@ improve method arity mismatch contract violation error messages?
                                                     #f
                                                     (with-syntax ([field-contract-id field-contract-id]
                                                                   [field-contract field-contract])
-                                                      #'(define field-contract-id (verify-contract field-contract)))))
+                                                      #'(define field-contract-id (verify-contract 'provide/contract field-contract)))))
                                               field-contract-ids
                                               field-contracts))]
                          [(field-contracts ...) field-contracts]
@@ -671,7 +872,7 @@ improve method arity mismatch contract violation error messages?
                                    
                                    #,@(if no-need-to-check-ctrct?
                                           (list)
-                                          (list #'(define contract-id (verify-contract ctrct))))
+                                          (list #'(define contract-id (verify-contract 'provide/contract ctrct))))
                                    (define-syntax id-rename
                                      (make-provide/contract-transformer (quote-syntax contract-id)
                                                                         (quote-syntax id)
@@ -691,11 +892,6 @@ improve method arity mismatch contract violation error messages?
           (begin
             bodies ...))))]))
 
-(define-syntax (verify-contract stx)
-  (syntax-case stx ()
-    [(_ x) (a:known-good-contract? #'x) #'x]
-    [(_ x) #'(coerce-contract 'provide/contract x)]))
-
 (define (make-pc-struct-type struct-name struct:struct-name . ctcs)
   (let-values ([(struct:struct-name _make _pred _get _set)
                 (make-struct-type struct-name
diff --git a/collects/scribblings/reference/contracts.scrbl b/collects/scribblings/reference/contracts.scrbl
index 1f5053a8c6..0b5dfafcf6 100644
--- a/collects/scribblings/reference/contracts.scrbl
+++ b/collects/scribblings/reference/contracts.scrbl
@@ -673,23 +673,36 @@ contract on the fields that the sub-struct shares with its parent are
 only used in the contract for the sub-struct's maker, and the selector
 or mutators for the super-struct are not provided.}
 
-@defform[(define/contract id contract-expr init-value-expr)]{
+@defform/subs[
+ (with-contract blame-id (wc-export ...) body ...+)
+ ([wc-export
+   id
+   (id contract-expr)])]{
+Generates a local contract boundary.  The @scheme[contract-expr]
+form cannot appear in expression position.  The @scheme[body] of the
+form allows definition/expression interleaving like a @scheme[module]
+body.  Names bound within the @scheme[body] must be exported to be
+accessible from outside the @scheme[with-contract] form.  Such
+@scheme[id]s can either be paired with a @scheme[contract-expr] or
+exported without a contract.
 
-Attaches the contract @scheme[contract-expr] to
-@scheme[init-value-expr] and binds that to @scheme[id].
+The @scheme[blame-id] is used for the positive positions of
+contracts paired with exported @scheme[id]s.  Contracts broken
+within the @scheme[with-contract] @scheme[body] will use the
+@scheme[blame-id] for their negative position.}
+
+@defform*[[(define/contract id contract-expr init-value-expr)
+ (define/contract (head args) contract-expr body ...+)]]{
+Works like @scheme[define], except that the contract
+@scheme[contract-expr] is attached to the bound value.
 
 The @scheme[define/contract] form treats individual definitions as
 units of blame. The definition itself is responsible for positive
 (co-variant) positions of the contract and each reference to
 @scheme[id] (including those in the initial value expression) must
-meet the negative positions of the contract.
-
-Error messages with @scheme[define/contract] are not as clear as those
-provided by @scheme[provide/contract], because
-@scheme[define/contract] cannot detect the name of the definition
-where the reference to the defined variable occurs. Instead, it uses
-the source location of the reference to the variable as the name of
-that definition.}
+meet the negative positions of the contract.  It is equivalent to
+wrapping a single @scheme[define] with a @scheme[with-contract] form
+that pairs the @scheme[contract-expr] with the bound identifier.}
 
 @defform*[[(contract contract-expr to-protect-expr
                      positive-blame-expr negative-blame-expr)
diff --git a/collects/tests/mzscheme/contract-mzlib-test.ss b/collects/tests/mzscheme/contract-mzlib-test.ss
index 4d0b8c923d..2e22f4145b 100644
--- a/collects/tests/mzscheme/contract-mzlib-test.ss
+++ b/collects/tests/mzscheme/contract-mzlib-test.ss
@@ -81,7 +81,7 @@ of the contract library does not change over time.
         (equal?
          blame
          (cond
-           [(regexp-match #rx"(^| )([^ ]*) broke" msg) 
+           [(regexp-match #rx"(^| )(.*) broke" msg) 
             =>
             (λ (x) (caddr x))]
            [else (format "no blame in error message: \"~a\"" msg)])))
@@ -4820,7 +4820,7 @@ so that propagation occurs.
                             (make-s 1 2)
                             [s-a #f])))
       (eval '(require 'pc11b-n)))
-   'n)
+   "'n")
 |#
   
   (test/spec-passed
diff --git a/collects/tests/mzscheme/contract-test.ss b/collects/tests/mzscheme/contract-test.ss
index d262306d9f..5b2dd5387c 100644
--- a/collects/tests/mzscheme/contract-test.ss
+++ b/collects/tests/mzscheme/contract-test.ss
@@ -1,3 +1,4 @@
+
 (load-relative "loadtest.ss")
 (Section 'contract)
 
@@ -75,7 +76,7 @@
         (equal?
          blame
          (cond
-           [(regexp-match #rx"(^| )([^ ]*) broke" msg) 
+           [(regexp-match #rx"(^| )(.*) broke" msg) 
             =>
             (λ (x) (caddr x))]
            [else (format "no blame in error message: \"~a\"" msg)])))
@@ -2160,6 +2161,323 @@
 
   
 
+;                                                                                           
+;                                                                                           
+;                                                                                           
+;        ;          ;;;;                  ;                                                 
+;       ;;         ;   ;                  ;                                                 
+;        ;         ;                     ;                        ;                      ;  
+;        ;         ;                     ;                        ;                      ;  
+;     ;; ;   ;;;  ;;;; ;  ; ;;    ;;;    ;   ;;;     ;;    ; ;;  ;;;; ; ;;  ;;;    ;;;  ;;;;
+;    ;  ;;  ;   ;  ;  ;; ;;;  ;  ;   ;  ;   ;   ;   ;  ;  ;;;  ;  ;  ;;;   ;   ;  ;   ;  ;  
+;   ;    ;  ;;;;;  ;   ;  ;   ;  ;;;;;  ;   ;      ;    ;  ;   ;  ;   ;       ;;  ;      ;  
+;   ;    ;  ;      ;   ;  ;   ;  ;      ;   ;      ;    ;  ;   ;  ;   ;     ;; ;  ;      ;  
+;   ;    ;  ;      ;   ;  ;   ;  ;      ;   ;      ;    ;  ;   ;  ;   ;    ;   ;  ;      ;  
+;    ;  ;;; ;   ;  ;   ;  ;   ;  ;   ; ;    ;   ;   ;  ;   ;   ;  ; ; ;    ;  ;;  ;   ;  ; ;
+;     ;; ;   ;;;  ;;;;;;;;;; ;;;  ;;;  ;     ;;;     ;;   ;;; ;;; ;; ;;;    ;; ;;  ;;;   ;; 
+;                                                                                           
+;                                                                                           
+;                                                                                           
+
+  (test/spec-passed
+   'define/contract1
+   '(let ()
+      (define/contract i integer? 1)
+      i))
+  
+  (test/spec-failed
+   'define/contract2
+   '(let ()
+      (define/contract i integer? #t)
+      i)
+   "(definition i)")
+  
+  (test/spec-failed
+   'define/contract3
+   '(let ()
+      (define/contract i (-> integer? integer?) (lambda (x) #t))
+      (i 1))
+   "(definition i)")
+  
+  (test/spec-failed
+   'define/contract4
+   '(let ()
+      (define/contract i (-> integer? integer?) (lambda (x) 1))
+      (i #f))
+   "top-level")
+  
+  (test/spec-failed
+   'define/contract5
+   '(let ()
+      (define/contract (i x) (-> integer? integer?) 1)
+      (i #f))
+   "top-level")
+  
+  (test/spec-passed
+   'define/contract6
+   '(let ()
+      (define/contract (i x) (-> integer? integer?)
+        (cond
+          [(not (integer? x)) 1]
+          [else (i #f)]))
+      (i 1)))
+  
+  (test/spec-passed
+   'define/contract7
+   '(let ()
+      (define/contract (contracted-func label t)
+                       (string?  string? . -> . string?)
+                       t)
+      (contracted-func
+       "I'm a string constant with side effects"
+       "ans")))
+
+  (test/spec-passed
+   'define/contract8
+   '(let ()
+      (eval '(module contract-test-suite-define1 scheme/base
+               (require scheme/contract)
+               (define/contract x string? "a")
+               x))
+      (eval '(require 'contract-test-suite-define1))))
+  
+  (test/spec-failed
+   'define/contract9
+   '(let ()
+      (define/contract (a n)
+        (-> number? number?)
+        (define/contract (b m)
+          (-> number? number?)
+          (+ m 1))
+        (b (zero? n)))
+      (a 5))
+   "(function a)")
+  
+  (test/spec-failed
+   'define/contract10
+   '(let ()
+      (define/contract (a n)
+        (-> number? number?)
+        (define/contract (b m)
+          (-> number? number?)
+          #t)
+        (b (add1 n)))
+      (a 5))
+   "(function b)")
+  
+  (test/spec-passed
+   'define/contract11
+   '(let ()
+      (define/contract (f n)
+        (-> number? number?)
+        (+ n 1))
+      (define/contract (g b m)
+        (-> boolean? number? number?)
+        (if b (f m) (f #t)))
+      (g #t 3)))
+  
+  (test/spec-failed
+   'define/contract12
+   '(let ()
+      (define/contract (f n)
+        (-> number? number?)
+        (+ n 1))
+      (define/contract (g b m)
+        (-> boolean? number? number?)
+        (if b (f m) (f #t)))
+      (g #f 3))
+   "(function g)")
+
+  (test/spec-failed
+   'define/contract13
+   '(begin
+      (eval '(module foo-dc13 scheme/base
+	       (require scheme/contract)
+	       (define/contract (foo-dc13 n)
+		 (-> number? number?)
+		 (+ n 1))
+	       (foo-dc13 #t)))
+      (eval '(require 'foo-dc13)))
+   "'foo-dc13")
+  
+  (test/spec-failed
+   'define/contract14
+   '(begin
+      (eval '(module foo-dc14 scheme/base
+	       (require scheme/contract)
+	       (provide foo-dc14)
+	       (define/contract (foo-dc14 n)
+		 (-> number? number?)
+		 (+ n 1))))
+      (eval '(module bar-dc14 scheme/base
+	       (require 'foo-dc14)
+	       (foo-dc14 #t)))
+      (eval '(require 'bar-dc14)))
+   "'bar-dc14")
+
+  (test/spec-failed
+   'define/contract15
+   '(begin
+      (eval '(module foo-dc15 scheme/base
+	       (require scheme/contract)
+	       (provide foo-dc15)
+	       (define/contract (foo-dc15 n)
+		 (-> number? number?)
+		 (+ n 1))))
+      (eval '(require 'foo-dc15))
+      (eval '(foo-dc15 #t)))
+   "top-level")
+  
+  ;; Let's see how units + define/contract interact
+  
+  (test/spec-failed
+   'define/contract16
+   '(begin
+      (eval '(module foo-dc16 scheme/base
+               (require scheme/contract)
+               (require scheme/unit)
+               (let ()
+                 (define/contract (foo n)
+                   (-> number? number?)
+                   (define-signature U^
+                     ((contracted [x (-> number? number?)])))
+                   (define-unit U@
+                     (import)
+                     (export U^)
+                     (define (x n) #t))
+                   (define-values/invoke-unit U@
+                     (import)
+                     (export U^))
+                   (x n))
+                 (foo 3))))
+      (eval '(require 'foo-dc16)))
+   "(unit U@)")
+  
+  (test/spec-failed
+   'define/contract17
+   '(begin
+      (eval '(module foo-dc17 scheme/base
+               (require scheme/contract)
+               (require scheme/unit)
+               (let ()
+                 (define/contract (foo n)
+                   (-> number? number?)
+                   (define-signature U^
+                     ((contracted [x (-> number? number?)])))
+                   (define-unit U@
+                     (import)
+                     (export U^)
+                     (define (x n) 3))
+                   (define-values/invoke-unit U@
+                     (import)
+                     (export U^))
+                   (x (zero? n)))
+                 (foo 3))))
+      (eval '(require 'foo-dc17)))
+   "(function foo)")
+  
+  (test/spec-failed
+   'define/contract18
+   '(begin
+      (eval '(module foo-dc17 scheme/base
+               (require scheme/contract)
+               (require scheme/unit)
+               (let ()
+                 (define-signature U^
+                   ((contracted [x (-> number? number?)])))
+                 (define-unit U@
+                   (import)
+                   (export U^)
+                   ;; Can't define/contract x directly because
+                   ;; x ends up bound to a transformer and thus
+                   ;; is syntax.
+                   (define/contract (y n)
+                     (-> number? boolean?) #t)
+                   (define x y))
+                 (define-values/invoke-unit U@
+                   (import)
+                   (export U^))
+                 (x 3))))
+      (eval '(require 'foo-dc18)))
+   "(unit U@)")
+  
+
+;                                                                                  
+;                                                                                  
+;                                                                                  
+;              ;      ;                                                            
+;                    ;;                                                            
+;                 ;   ;                                  ;                      ;  
+;                 ;   ;                                  ;                      ;  
+;  ;;; ;;; ;;; ; ;;;; ; ;;          ;;;     ;;    ; ;;  ;;;; ; ;;  ;;;    ;;;  ;;;;
+;   ;   ;   ; ;;  ;   ;;  ;        ;   ;   ;  ;  ;;;  ;  ;  ;;;   ;   ;  ;   ;  ;  
+;   ;   ;   ;  ;  ;   ;   ;        ;      ;    ;  ;   ;  ;   ;       ;;  ;      ;  
+;    ; ; ; ;   ;  ;   ;   ;  ;;;;  ;      ;    ;  ;   ;  ;   ;     ;; ;  ;      ;  
+;    ; ; ; ;   ;  ;   ;   ;        ;      ;    ;  ;   ;  ;   ;    ;   ;  ;      ;  
+;    ;;  ;;    ;  ; ; ;   ;        ;   ;   ;  ;   ;   ;  ; ; ;    ;  ;;  ;   ;  ; ;
+;     ;   ;   ;;; ;; ;;; ;;;        ;;;     ;;   ;;; ;;; ;; ;;;    ;; ;;  ;;;   ;; 
+;                                                                                  
+;                                                                                  
+;                                                                                  
+
+  (test/spec-passed
+   'with-contract1
+   '(let ()
+      (with-contract odd-even
+        ([odd? (-> number? boolean?)]
+         [even? (-> number? boolean?)])
+        (define (odd? n)
+          (if (zero? n) #f (even? (sub1 n))))
+        (define (even? n)
+          (if (zero? n) #t (odd? (sub1 n)))))
+      (odd? 5)))
+  
+  (test/spec-failed
+   'with-contract2
+   '(let ()
+      (with-contract odd-even
+        ([odd? (-> number? boolean?)]
+         [even? (-> number? boolean?)])
+        (define (odd? n)
+          (if (zero? n) #f (even? (sub1 n))))
+        (define (even? n)
+          (if (zero? n) #t (odd? (sub1 n)))))
+      (odd? #t))
+   "top-level")
+  
+  (test/spec-failed
+   'with-contract3
+   '(let ()
+      (with-contract odd-even
+        ([odd? (-> number? boolean?)]
+         [even? (-> number? boolean?)])
+        (define (odd? n)
+          (if (zero? n) n (even? (sub1 n))))
+        (define (even? n)
+          (if (zero? n) #t (odd? (sub1 n)))))
+      (odd? 4))
+   "(region odd-even)")
+  
+  ;; Functions within the same with-contract region can call
+  ;; each other however they want, so here we have even?
+  ;; call odd? with a boolean, even though its contract in
+  ;; the odd-even contract says it only takes numbers.
+  (test/spec-passed
+   'with-contract4
+   '(let ()
+      (with-contract odd-even
+        ([odd? (-> number? boolean?)]
+         [even? (-> number? boolean?)])
+        (define (odd? n)
+          (cond
+            [(not (number? n)) #f]
+            [(zero? n) #f]
+            [else (even? (sub1 n))]))
+        (define (even? n)
+          (if (zero? n) #t (odd? (zero? n)))))
+      (odd? 5)))
+
+
 ;                                                                                                                         
 ;                                                                                                                         
 ;                                                                                                                         
@@ -5623,7 +5941,7 @@ so that propagation occurs.
                             (make-s 1 2)
                             [s-a #f])))
       (eval '(require 'pc11b-n)))
-   'n)
+   "'n")
 |#
   
   (test/spec-passed
diff --git a/collects/tests/units/test-unit-contracts.ss b/collects/tests/units/test-unit-contracts.ss
index dd5f04de6f..4b355450b5 100644
--- a/collects/tests/units/test-unit-contracts.ss
+++ b/collects/tests/units/test-unit-contracts.ss
@@ -152,3 +152,13 @@
 
 (test-runtime-error exn:fail:contract? "unit9-1 provides wrong value for function f"
   (invoke-unit unit9))
+
+(define-values/invoke-unit
+  (unit
+   (import) (export sig2)
+   (define f values))
+  (import)
+  (export sig2))
+
+(test-runtime-error exn:fail:contract? "top-level misuses f"
+  (f #t))