diff --git a/collects/mzlib/contract.ss b/collects/mzlib/contract.ss
index 64d02c4..3c6ef88 100644
--- a/collects/mzlib/contract.ss
+++ b/collects/mzlib/contract.ss
@@ -48,48 +48,11 @@
              check-between/c
              string-len/c
              check-unary-between/c)
- (rename-out [string-len/c string/len]))
-
-;; from contract-guts.ss
-
-(provide any
-         and/c
-         any/c
-         none/c
-         make-none/c 
-         
-         guilty-party
-         contract-violation->string
-         
-         contract?
-         contract-name
-         contract-proc
-         
-         flat-contract?
-         flat-contract
-         flat-contract-predicate
-         flat-named-contract
-         
-         contract-first-order-passes?
-         
-         ;; below need docs
-         
-         make-proj-contract
-         
-         contract-stronger?
-         
-         coerce-contract 
-         flat-contract/predicate?
-         
-         build-compound-type-name
-         raise-contract-error
-         
-         proj-prop proj-pred? proj-get
-         name-prop name-pred? name-get
-         stronger-prop stronger-pred? stronger-get
-         flat-prop flat-pred? flat-get
-         first-order-prop first-order-get
-         (rename-out [or/c union]))
+ (rename-out [or/c union])
+ (rename-out [string-len/c string/len])
+ (except-out (all-from-out scheme/contract/private/guts)
+             check-flat-contract
+             check-flat-named-contract))
 
 
 ;; copied here because not provided by scheme/contract anymore
diff --git a/collects/mzlib/private/contract-arr-checks.ss b/collects/mzlib/private/contract-arr-checks.ss
index 547d814..5410d74 100644
--- a/collects/mzlib/private/contract-arr-checks.ss
+++ b/collects/mzlib/private/contract-arr-checks.ss
@@ -77,31 +77,21 @@
            f)))
 
 
-(define (check-pre-expr->pp/h val pre-expr src-info blame orig-str)
+(define (check-pre-expr->pp/h val pre-expr blame)
   (unless pre-expr
-    (raise-contract-error val
-                          src-info
-                          blame
-                          orig-str
-                          "pre-condition expression failure")))
+    (raise-blame-error blame val "pre-condition expression failure")))
 
-(define (check-post-expr->pp/h val post-expr src-info blame orig-str)
+(define (check-post-expr->pp/h val post-expr blame)
   (unless post-expr
-    (raise-contract-error val
-                          src-info
-                          blame
-                          orig-str
-                          "post-condition expression failure")))
+    (raise-blame-error blame val "post-condition expression failure")))
 
-(define (check-procedure val dom-length optionals mandatory-kwds optional-keywords src-info blame orig-str)
+(define (check-procedure val dom-length optionals mandatory-kwds optional-keywords blame)
   (unless (and (procedure? val)
                (procedure-arity-includes?/optionals val dom-length optionals)
                (keywords-match mandatory-kwds optional-keywords val))
-    (raise-contract-error
-     val
-     src-info
+    (raise-blame-error
      blame
-     orig-str
+     val
      "expected a procedure that accepts ~a arguments~a, given: ~e"
      dom-length
      (keyword-error-text mandatory-kwds)
@@ -140,53 +130,37 @@
   (and (procedure? val)
        (procedure-accepts-and-more? val arity)))
 
-(define (check-procedure/kind val arity kind-of-thing src-info blame orig-str)
+(define (check-procedure/kind val arity kind-of-thing blame)
   (unless (procedure? val)
-    (raise-contract-error val
-                          src-info
-                          blame
-                          orig-str
-                          "expected a procedure, got ~e"
-                          val))
+    (raise-blame-error blame val "expected a procedure, got ~e" val))
   (unless (procedure-arity-includes? val arity)
-    (raise-contract-error val
-                          src-info
-                          blame
-                          orig-str
-                          "expected a ~a of arity ~a (not arity ~a), got  ~e"
-                          kind-of-thing
-                          arity
-                          (procedure-arity val)
-                          val)))
+    (raise-blame-error blame
+                       val
+                       "expected a ~a of arity ~a (not arity ~a), got  ~e"
+                       kind-of-thing
+                       arity
+                       (procedure-arity val)
+                       val)))
 
-(define (check-procedure/more/kind val arity kind-of-thing src-info blame orig-str)
+(define (check-procedure/more/kind val arity kind-of-thing blame)
   (unless (procedure? val)
-    (raise-contract-error val
-                          src-info
-                          blame
-                          orig-str
-                          "expected a procedure, got ~e"
-                          val))
+    (raise-blame-error blame val "expected a procedure, got ~e" val))
   (unless (procedure-accepts-and-more? val arity)
-    (raise-contract-error val
-                          src-info
-                          blame
-                          orig-str
-                          "expected a ~a that accepts ~a arguments and aribtrarily more (not arity ~a), got  ~e"
-                          kind-of-thing
-                          arity
-                          (procedure-arity val)
-                          val)))
+    (raise-blame-error blame
+                       val
+                       "expected a ~a that accepts ~a arguments and aribtrarily more (not arity ~a), got  ~e"
+                       kind-of-thing
+                       arity
+                       (procedure-arity val)
+                       val)))
 
-(define (check-procedure/more val dom-length mandatory-kwds optional-kwds src-info blame orig-str)
+(define (check-procedure/more val dom-length mandatory-kwds optional-kwds blame)
   (unless (and (procedure? val)
                (procedure-accepts-and-more? val dom-length)
                (keywords-match mandatory-kwds optional-kwds val))
-    (raise-contract-error
-     val
-     src-info
+    (raise-blame-error
      blame
-     orig-str
+     val
      "expected a procedure that accepts ~a arguments and and arbitrarily more~a, given: ~e"
      dom-length
      (keyword-error-text mandatory-kwds)
diff --git a/collects/mzlib/private/contract-arr-obj-helpers.ss b/collects/mzlib/private/contract-arr-obj-helpers.ss
index 9d4d980..4dd2791 100644
--- a/collects/mzlib/private/contract-arr-obj-helpers.ss
+++ b/collects/mzlib/private/contract-arr-obj-helpers.ss
@@ -19,9 +19,9 @@
 (define (make-/proc method-proc? /h stx)
   (let-values ([(arguments-check build-proj check-val first-order-check wrapper)
                 (/h method-proc? stx)])
-    (let ([outer-args (syntax (val pos-blame neg-blame src-info orig-str name-id positive-position?))])
+    (let ([outer-args (syntax (val blame name-id))])
       (with-syntax ([inner-check (check-val outer-args)]
-                    [(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args]
+                    [(val blame name-id) outer-args]
                     [(val-args body) (wrapper outer-args)])
         (with-syntax ([inner-lambda
                        (set-inferred-name-from
@@ -37,11 +37,10 @@
               (arguments-check
                outer-args
                (syntax/loc stx
-                 (make-proj-contract
-                  name-id
-                  (lambda (pos-blame neg-blame src-info orig-str positive-position?)
-                    proj-code)
-                  first-order-check))))))))))
+                 (simple-contract
+                  #:name name-id
+                  #:projection (lambda (blame) proj-code)
+                  #:first-order first-order-check))))))))))
 
 (define (make-case->/proc method-proc? stx inferred-name-stx select/h)
   (syntax-case stx ()
@@ -55,9 +54,9 @@
     [(_ cases ...)
      (let-values ([(arguments-check build-projs check-val first-order-check wrapper) 
                    (case->/h method-proc? stx (syntax->list (syntax (cases ...))) select/h)])
-       (let ([outer-args (syntax (val pos-blame neg-blame src-info orig-str name-id positive-position?))])
+       (let ([outer-args (syntax (val blame name-id))])
          (with-syntax ([(inner-check ...) (check-val outer-args)]
-                       [(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args]
+                       [(val blame name-id) outer-args]
                        [(body ...) (wrapper outer-args)])
            (with-syntax ([inner-lambda 
                           (set-inferred-name-from
@@ -73,11 +72,10 @@
                  (arguments-check
                   outer-args
                   (syntax/loc stx
-                    (make-proj-contract
-                     (apply build-compound-type-name 'case-> name-id)
-                     (lambda (pos-blame neg-blame src-info orig-str positive-position?)
-                       proj-code)
-                     first-order-check)))))))))]))
+                    (simple-contract
+                     #:name (apply build-compound-type-name 'case-> name-id)
+                     #:projection (lambda (blame) proj-code)
+                     #:first-order first-order-check)))))))))]))
 
 (define (make-opt->/proc method-proc? stx select/h case-arr-stx arr-stx)
   (syntax-case stx (any)
@@ -230,7 +228,7 @@
       [(null? cases) 
        (values 
         (lambda (outer-args body)
-          (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args]
+          (with-syntax ([(val blame name-id) outer-args]
                         [body body]
                         [(name-ids ...) (reverse name-ids)])
             (syntax
@@ -249,10 +247,10 @@
                        (/h method-proc? (car cases))])
            (values
             (lambda (outer-args x) 
-              (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args]
+              (with-syntax ([(val blame name-id) outer-args]
                             [new-id new-id])
                 (arguments-check 
-                 (syntax (val pos-blame neg-blame src-info orig-str new-id positive-position?)) 
+                 (syntax (val blame new-id)) 
                  (arguments-checks 
                   outer-args
                   x))))
@@ -364,7 +362,7 @@
             (values
              (lambda (outer-args body)
                (with-syntax ([body body]
-                             [(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args])
+                             [(val blame name-id) outer-args])
                  (syntax
                   (let ([dom-contract-x (coerce-contract '-> dom)] ...)
                     (let ([dom-x (contract-proc dom-contract-x)] ...)
@@ -373,19 +371,19 @@
              
              ;; proj
              (lambda (outer-args inner-lambda)
-               (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args]
+               (with-syntax ([(val blame name-id) outer-args]
                              [inner-lambda inner-lambda])
                  (syntax
-                  (let ([dom-projection-x (dom-x neg-blame pos-blame src-info orig-str (not positive-position?))] ...)
+                  (let ([dom-projection-x (dom-x (blame-swap blame))] ...)
                     inner-lambda))))
              
              (lambda (outer-args)
-               (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args])
+               (with-syntax ([(val blame name-id) outer-args])
                  (syntax
-                  (check-procedure val dom-length 0 '() '() #|keywords|# src-info pos-blame orig-str))))
+                  (check-procedure val dom-length 0 '() '() #|keywords|# blame))))
              (syntax (check-procedure? dom-length))
              (lambda (outer-args)
-               (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args])
+               (with-syntax ([(val blame name-id) outer-args])
                  (syntax
                   ((arg-x ...)
                    (val (dom-projection-x arg-x) ...))))))]
@@ -399,14 +397,14 @@
               (values
                (lambda (outer-args body)
                  (with-syntax ([body body]
-                               [(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args])
+                               [(val blame name-id) outer-args])
                    (syntax
                     (let ([dom-contract-x (coerce-contract '-> dom)] 
                           ...
                           [rng-contract-x (coerce-contract '-> rng)] ...)
-                      (let ([dom-x (contract-proc dom-contract-x)] 
+                      (let ([dom-x (contract-projection dom-contract-x)] 
                             ...
-                            [rng-x (contract-proc rng-contract-x)]
+                            [rng-x (contract-projection rng-contract-x)]
                             ...)
                         (let ([name-id 
                                (build-compound-type-name 
@@ -417,22 +415,22 @@
                
                ;; proj
                (lambda (outer-args inner-lambda)
-                 (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args]
+                 (with-syntax ([(val blame name-id) outer-args]
                                [inner-lambda inner-lambda])
                    (syntax
-                    (let ([dom-projection-x (dom-x neg-blame pos-blame src-info orig-str (not positive-position?))] 
+                    (let ([dom-projection-x (dom-x (blame-swap blame))] 
                           ...
-                          [rng-projection-x (rng-x pos-blame neg-blame src-info orig-str positive-position?)] ...)
+                          [rng-projection-x (rng-x blame)] ...)
                       inner-lambda))))
                
                (lambda (outer-args)
-                 (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args])
+                 (with-syntax ([(val blame name-id) outer-args])
                    (syntax
-                    (check-procedure val dom-length 0 '() '() #|keywords|# src-info pos-blame orig-str))))
+                    (check-procedure val dom-length 0 '() '() #|keywords|# blame))))
                (syntax (check-procedure? dom-length))
                
                (lambda (outer-args)
-                 (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args])
+                 (with-syntax ([(val blame name-id) outer-args])
                    (syntax
                     ((arg-x ...)
                      (let-values ([(res-x ...) (val (dom-projection-x arg-x) ...)])
@@ -448,34 +446,34 @@
               (values
                (lambda (outer-args body)
                  (with-syntax ([body body]
-                               [(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args])
+                               [(val blame name-id) outer-args])
                    (syntax
                     (let ([dom-contract-x (coerce-contract '-> dom)] 
                           ...
                           [rng-contract-x (coerce-contract '-> rng)])
-                      (let ([dom-x (contract-proc dom-contract-x)] 
+                      (let ([dom-x (contract-projection dom-contract-x)] 
                             ...
-                            [rng-x (contract-proc rng-contract-x)])
+                            [rng-x (contract-projection rng-contract-x)])
                         (let ([name-id (build-compound-type-name '-> name-dom-contract-x ... rng-contract-x)])
                           body))))))
                
                ;; proj
                (lambda (outer-args inner-lambda)
-                 (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args]
+                 (with-syntax ([(val blame name-id) outer-args]
                                [inner-lambda inner-lambda])
                    (syntax
-                    (let ([dom-projection-x (dom-x neg-blame pos-blame src-info orig-str (not positive-position?))] 
+                    (let ([dom-projection-x (dom-x (blame-swap blame))] 
                           ...
-                          [rng-projection-x (rng-x pos-blame neg-blame src-info orig-str positive-position?)])
+                          [rng-projection-x (rng-x blame)])
                       inner-lambda))))
                
                (lambda (outer-args)
-                 (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args])
+                 (with-syntax ([(val blame name-id) outer-args])
                    (syntax
-                    (check-procedure val dom-length 0 '() '() #|keywords|# src-info pos-blame orig-str))))
+                    (check-procedure val dom-length 0 '() '() #|keywords|# blame))))
                (syntax (check-procedure? dom-length))
                (lambda (outer-args)
-                 (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args])
+                 (with-syntax ([(val blame name-id) outer-args])
                    (syntax
                     ((arg-x ...)
                      (let ([res-x (val (dom-projection-x arg-x) ...)])
@@ -509,7 +507,7 @@
                    [arity (length (syntax->list (syntax (dom ...))))])
        (values
         (lambda (outer-args body)
-          (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args]
+          (with-syntax ([(val blame name-id) outer-args]
                         [body body]
                         [(name-dom-contract-x ...)
                          (if method-proc?
@@ -522,10 +520,10 @@
                    ...
                    [dom-rest-contract-x (coerce-contract '->* rest)]
                    [rng-contract-x (coerce-contract '->* rng)] ...)
-               (let ([dom-x (contract-proc dom-contract-x)]
+               (let ([dom-x (contract-projection dom-contract-x)]
                      ...
-                     [dom-rest-x (contract-proc dom-rest-contract-x)]
-                     [rng-x (contract-proc rng-contract-x)] 
+                     [dom-rest-x (contract-projection dom-rest-contract-x)]
+                     [rng-x (contract-projection rng-contract-x)] 
                      ...)
                  (let ([name-id 
                         (build-compound-type-name 
@@ -536,22 +534,22 @@
                    body))))))
         ;; proj
         (lambda (outer-args inner-lambda)
-          (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args]
+          (with-syntax ([(val blame name-id) outer-args]
                         [inner-lambda inner-lambda])
             (syntax
-             (let ([dom-projection-x (dom-x neg-blame pos-blame src-info orig-str (not positive-position?))] 
+             (let ([dom-projection-x (dom-x (blame-swap blame))] 
                    ...
-                   [dom-rest-projection-x (dom-rest-x neg-blame pos-blame src-info orig-str (not positive-position?))]
-                   [rng-projection-x (rng-x pos-blame neg-blame src-info orig-str positive-position?)] ...)
+                   [dom-rest-projection-x (dom-rest-x (blame-swap blame))]
+                   [rng-projection-x (rng-x blame)] ...)
                inner-lambda))))
         
         (lambda (outer-args)
-          (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args])
+          (with-syntax ([(val blame name-id) outer-args])
             (syntax
-             (check-procedure/more val dom-length '() '() #|keywords|# src-info pos-blame orig-str))))
+             (check-procedure/more val dom-length '() '() #|keywords|# blame))))
         (syntax (check-procedure/more? dom-length))
         (lambda (outer-args)
-          (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args])
+          (with-syntax ([(val blame name-id) outer-args])
             (syntax
              ((arg-x ... . arg-rest-x)
               (let-values ([(res-x ...)
@@ -577,7 +575,7 @@
        (values
         (lambda (outer-args body)
           (with-syntax ([body body]
-                        [(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args]
+                        [(val blame name-id) outer-args]
                         [(name-dom-contract-x ...)
                          (if method-proc?
                              (cdr
@@ -588,9 +586,9 @@
              (let ([dom-contract-x (coerce-contract '->* dom)] 
                    ...
                    [dom-rest-contract-x (coerce-contract '->* rest)])
-               (let ([dom-x (contract-proc dom-contract-x)]
+               (let ([dom-x (contract-projection dom-contract-x)]
                      ...
-                     [dom-rest-x (contract-proc dom-rest-contract-x)])
+                     [dom-rest-x (contract-projection dom-rest-contract-x)])
                  (let ([name-id (build-compound-type-name
                                  '->* 
                                  (build-compound-type-name name-dom-contract-x ...)
@@ -599,21 +597,21 @@
                    body))))))
         ;; proj
         (lambda (outer-args inner-lambda)
-          (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args]
+          (with-syntax ([(val blame name-id) outer-args]
                         [inner-lambda inner-lambda])
             (syntax
-             (let ([dom-projection-x (dom-x neg-blame pos-blame src-info orig-str (not positive-position?))] 
+             (let ([dom-projection-x (dom-x (blame-swap blame))] 
                    ...
-                   [dom-projection-rest-x (dom-rest-x neg-blame pos-blame src-info orig-str (not positive-position?))])
+                   [dom-projection-rest-x (dom-rest-x (blame-swap blame))])
                inner-lambda))))
         
         (lambda (outer-args)
-          (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args])
+          (with-syntax ([(val blame name-id) outer-args])
             (syntax
-             (check-procedure/more val dom-length '() '() #|keywords|# src-info pos-blame orig-str))))
+             (check-procedure/more val dom-length '() '() #|keywords|# blame))))
         (syntax (check-procedure/more? dom-length))
         (lambda (outer-args)
-          (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args])
+          (with-syntax ([(val blame name-id) outer-args])
             (syntax
              ((arg-x ... . arg-rest-x)
               (apply
@@ -636,7 +634,7 @@
        (values
         (lambda (outer-args body)
           (with-syntax ([body body]
-                        [(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args]
+                        [(val blame name-id) outer-args]
                         [(name-dom-contract-x ...)
                          (if method-proc?
                              (cdr
@@ -645,7 +643,7 @@
                              (syntax (dom-contract-x ...)))])
             (syntax
              (let ([dom-contract-x (coerce-contract '->d dom)] ...)
-               (let ([dom-x (contract-proc dom-contract-x)] 
+               (let ([dom-x (contract-projection dom-contract-x)] 
                      ...
                      [rng-x rng])
                  (check-rng-procedure '->d rng-x arity)
@@ -654,31 +652,27 @@
         
         ;; proj
         (lambda (outer-args inner-lambda)
-          (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args]
+          (with-syntax ([(val blame name-id) outer-args]
                         [inner-lambda inner-lambda])
             (syntax
-             (let ([dom-projection-x (dom-x neg-blame pos-blame src-info orig-str (not positive-position?))] ...)
+             (let ([dom-projection-x (dom-x (blame-swap blame))] ...)
                inner-lambda))))
         
         (lambda (outer-args)
-          (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args])
+          (with-syntax ([(val blame name-id) outer-args])
             (syntax
-             (check-procedure val arity 0 '() '() #|keywords|# src-info pos-blame orig-str))))
+             (check-procedure val arity 0 '() '() #|keywords|# blame))))
         
         (syntax (check-procedure? arity))
         
         (lambda (outer-args)
-          (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args])
+          (with-syntax ([(val blame name-id) outer-args])
             (syntax
              ((arg-x ...)
               (let ([arg-x (dom-projection-x arg-x)] ...) 
                 (let ([rng-contract (rng-x arg-x ...)])
-                  (((contract-proc (coerce-contract '->d rng-contract))
-                    pos-blame
-                    neg-blame
-                    src-info
-                    orig-str
-                    positive-position?)
+                  (((contract-projection (coerce-contract '->d rng-contract))
+                    blame)
                    (val arg-x ...))))))))))]))
 
 ;; ->d*/h : boolean stx -> (values (syntax -> syntax) (syntax -> syntax) (syntax -> syntax))
@@ -694,7 +688,7 @@
        (values
         (lambda (outer-args body)
           (with-syntax ([body body]
-                        [(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args]
+                        [(val blame name-id) outer-args]
                         [(name-dom-contract-x ...)
                          (if method-proc?
                              (cdr
@@ -703,7 +697,7 @@
                              (syntax (dom-contract-x ...)))])
             (syntax
              (let ([dom-contract-x (coerce-contract '->d* dom)] ...)
-               (let ([dom-x (contract-proc dom-contract-x)] 
+               (let ([dom-x (contract-projection dom-contract-x)] 
                      ...
                      [rng-mk-x rng-mk])
                  (check-rng-procedure '->d* rng-mk-x dom-length)
@@ -715,20 +709,20 @@
         
         ;; proj
         (lambda (outer-args inner-lambda)
-          (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args]
+          (with-syntax ([(val blame name-id) outer-args]
                         [inner-lambda inner-lambda])
             (syntax
-             (let ([dom-projection-x (dom-x neg-blame pos-blame src-info orig-str (not positive-position?))] ...)
+             (let ([dom-projection-x (dom-x (blame-swap blame))] ...)
                inner-lambda))))
         
         (lambda (outer-args)
-          (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args])
+          (with-syntax ([(val blame name-id) outer-args])
             (syntax
-             (check-procedure val dom-length 0 '() '() #|keywords|# src-info pos-blame orig-str))))
+             (check-procedure val dom-length 0 '() '() #|keywords|# blame))))
         (syntax (check-procedure? dom-length))
         
         (lambda (outer-args)
-          (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args])
+          (with-syntax ([(val blame name-id) outer-args])
             (syntax
              ((arg-x ...)
               (call-with-values
@@ -742,12 +736,8 @@
                     (apply 
                      values
                      (map (lambda (rng-contract result)
-                            (((contract-proc (coerce-contract '->d* rng-contract))
-                              pos-blame
-                              neg-blame
-                              src-info
-                              orig-str
-                              positive-position?)
+                            (((contract-projection (coerce-contract '->d* rng-contract))
+                              blame)
                              result))
                           rng-contracts
                           results))))))))))))]
@@ -763,7 +753,7 @@
        (values
         (lambda (outer-args body)
           (with-syntax ([body body]
-                        [(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args]
+                        [(val blame name-id) outer-args]
                         [(name-dom-contract-x ...)
                          (if method-proc?
                              (cdr
@@ -774,9 +764,9 @@
              (let ([dom-contract-x (coerce-contract '->d* dom)] 
                    ...
                    [dom-rest-contract-x (coerce-contract '->d* rest)])
-               (let ([dom-x (contract-proc dom-contract-x)] 
+               (let ([dom-x (contract-projection dom-contract-x)] 
                      ...
-                     [dom-rest-x (contract-proc dom-rest-contract-x)]
+                     [dom-rest-x (contract-projection dom-rest-contract-x)]
                      [rng-mk-x rng-mk])
                  (check-rng-procedure/more rng-mk-x arity)
                  (let ([name-id (build-compound-type-name 
@@ -788,22 +778,22 @@
         
         ;; proj
         (lambda (outer-args inner-lambda)
-          (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args]
+          (with-syntax ([(val blame name-id) outer-args]
                         [inner-lambda inner-lambda])
             (syntax
-             (let ([dom-projection-x (dom-x neg-blame pos-blame src-info orig-str (not positive-position?))] 
+             (let ([dom-projection-x (dom-x (blame-swap blame))] 
                    ...
-                   [dom-rest-projection-x (dom-rest-x neg-blame pos-blame src-info orig-str (not positive-position?))])
+                   [dom-rest-projection-x (dom-rest-x (blame-swap blame))])
                inner-lambda))))
         
         (lambda (outer-args)
-          (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args])
+          (with-syntax ([(val blame name-id) outer-args])
             (syntax
-             (check-procedure/more val arity '() '() #|keywords|# src-info pos-blame orig-str))))
+             (check-procedure/more val arity '() '() #|keywords|# blame))))
         (syntax (check-procedure/more? arity))
         
         (lambda (outer-args)
-          (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args])
+          (with-syntax ([(val blame name-id) outer-args])
             (syntax
              ((arg-x ... . rest-arg-x)
               (call-with-values
@@ -822,12 +812,8 @@
                     (apply 
                      values
                      (map (lambda (rng-contract result)
-                            (((contract-proc (coerce-contract '->d* rng-contract))
-                              pos-blame
-                              neg-blame
-                              src-info
-                              orig-str
-                              positive-position?)
+                            (((contract-projection (coerce-contract '->d* rng-contract))
+                              blame)
                              result))
                           rng-contracts
                           results))))))))))))]))
@@ -880,32 +866,31 @@
          (values
           (lambda (outer-args body)
             (with-syntax ([body body]
-                          [(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args])
+                          [(val blame name-id) outer-args])
               (syntax
                (let ([name-id name-stx])
                  body))))
           (lambda (outer-args inner-lambda) inner-lambda)
           
           (lambda (outer-args)
-            (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args]
+            (with-syntax ([(val blame name-id) outer-args]
                           [kind-of-thing (if method-proc? 'method 'procedure)])
               (syntax
                (begin 
-                 (check-procedure/kind val arity 'kind-of-thing src-info pos-blame orig-str)))))
+                 (check-procedure/kind val arity 'kind-of-thing blame)))))
           
           (syntax (check-procedure? arity))
           
           (lambda (outer-args)
-            (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args])
+            (with-syntax ([(val blame name-id) outer-args])
               (syntax-case* (syntax result-stuff) (any values) module-or-top-identifier=?
                 [(any)
                  (syntax
                   ((x ...)
                    (begin
-                     (check-pre-expr->pp/h val pre-expr src-info neg-blame orig-str)
-                     (let ([dom-id ((contract-proc (coerce-contract 'stx-name dom)) 
-                                    neg-blame pos-blame src-info orig-str
-                                    (not positive-position?))]
+                     (check-pre-expr->pp/h val pre-expr blame)
+                     (let ([dom-id ((contract-projection (coerce-contract 'stx-name dom)) 
+                                    (blame-swap blame))]
                            ...)
                        (val (dom-id x) ...)))))]
                 [((values (rng-ids rng-ctc) ...) post-expr)
@@ -915,16 +900,14 @@
                    (syntax
                     ((x ...)
                      (begin
-                       (check-pre-expr->pp/h val pre-expr src-info neg-blame orig-str)
-                       (let ([dom-id ((contract-proc (coerce-contract 'stx-name dom)) 
-                                      neg-blame pos-blame src-info orig-str
-                                      (not positive-position?))]
+                       (check-pre-expr->pp/h val pre-expr (blame-swap blame))
+                       (let ([dom-id ((contract-projection (coerce-contract 'stx-name dom))
+                                      (blame-swap blame))]
                              ...)
                          (let-values ([(rng-ids ...) (val (dom-id x) ...)])
-                           (check-post-expr->pp/h val post-expr src-info pos-blame orig-str)
-                           (let ([rng-ids-x ((contract-proc (coerce-contract 'stx-name rng-ctc))
-                                             pos-blame neg-blame src-info orig-str
-                                             positive-position?)] ...)
+                           (check-post-expr->pp/h val post-expr blame)
+                           (let ([rng-ids-x ((contract-projection (coerce-contract 'stx-name rng-ctc))
+                                             blame)] ...)
                              (values (rng-ids-x rng-ids) ...))))))))]
                 [((values (rng-ids rng-ctc) ...) post-expr)
                  (andmap identifier? (syntax->list (syntax (rng-ids ...))))
@@ -941,16 +924,14 @@
                  (syntax
                   ((x ...)
                    (begin
-                     (check-pre-expr->pp/h val pre-expr src-info neg-blame orig-str)
-                     (let ([dom-id ((contract-proc (coerce-contract 'stx-name dom))
-                                    neg-blame pos-blame src-info orig-str
-                                    (not positive-position?))]
+                     (check-pre-expr->pp/h val pre-expr (blame-swap blame))
+                     (let ([dom-id ((contract-projection (coerce-contract 'stx-name dom))
+                                    (blame-swap blame))]
                            ...
-                           [rng-id ((contract-proc (coerce-contract 'stx-name rng)) 
-                                    pos-blame neg-blame src-info orig-str
-                                    positive-position?)])
+                           [rng-id ((contract-projection (coerce-contract 'stx-name rng)) 
+                                    blame)])
                        (let ([res-id (rng-id (val (dom-id x) ...))])
-                         (check-post-expr->pp/h val post-expr src-info pos-blame orig-str)
+                         (check-post-expr->pp/h val post-expr blame)
                          res-id)))))]
                 [_ 
                  (raise-syntax-error name "unknown result specification" stx (syntax result-stuff))]))))))]
@@ -1000,35 +981,33 @@
          (values
           (lambda (outer-args body)
             (with-syntax ([body body]
-                          [(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args])
+                          [(val blame name-id) outer-args])
               (syntax
                (let ([name-id name-stx])
                  body))))
           (lambda (outer-args inner-lambda) inner-lambda)
           
           (lambda (outer-args)
-            (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args]
+            (with-syntax ([(val blame name-id) outer-args]
                           [kind-of-thing (if method-proc? 'method 'procedure)])
               (syntax
                (begin 
-                 (check-procedure/more/kind val arity 'kind-of-thing src-info pos-blame orig-str)))))
+                 (check-procedure/more/kind val arity 'kind-of-thing blame)))))
           (syntax (check-procedure/more? arity))
           
           (lambda (outer-args)
-            (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id positive-position?) outer-args])
+            (with-syntax ([(val blame name-id) outer-args])
               (syntax-case* (syntax result-stuff) (values any) module-or-top-identifier=?
                 [(any)
                  (syntax
                   ((x ... . rest-x)
                    (begin
-                     (check-pre-expr->pp/h val pre-expr src-info neg-blame orig-str)
-                     (let ([dom-id ((contract-proc (coerce-contract 'stx-name dom)) 
-                                    neg-blame pos-blame src-info orig-str
-                                    (not positive-position?))]
+                     (check-pre-expr->pp/h val pre-expr (blame-swap blame))
+                     (let ([dom-id ((contract-projection (coerce-contract 'stx-name dom))
+                                    (blame-swap blame))]
                            ...
-                           [rest-id ((contract-proc (coerce-contract 'stx-name rest-dom))
-                                     neg-blame pos-blame src-info orig-str
-                                     (not positive-position?))])
+                           [rest-id ((contract-projection (coerce-contract 'stx-name rest-dom))
+                                     (blame-swap blame))])
                        (apply val (dom-id x) ... (rest-id rest-x))))))]
                 [(any . x)
                  (raise-syntax-error name "cannot have anything after any" stx (syntax result-stuff))]
@@ -1039,19 +1018,16 @@
                    (syntax
                     ((x ... . rest-x)
                      (begin
-                       (check-pre-expr->pp/h val pre-expr src-info neg-blame orig-str)
-                       (let ([dom-id ((contract-proc (coerce-contract 'stx-name dom)) 
-                                      neg-blame pos-blame src-info orig-str
-                                      (not positive-position?))]
+                       (check-pre-expr->pp/h val pre-expr (blame-swap blame))
+                       (let ([dom-id ((contract-projection (coerce-contract 'stx-name dom))
+                                      (blame-swap blame))]
                              ...
-                             [rest-id ((contract-proc (coerce-contract 'stx-name rest-dom)) 
-                                       neg-blame pos-blame src-info orig-str
-                                       (not positive-position?))])
+                             [rest-id ((contract-projection (coerce-contract 'stx-name rest-dom))
+                                       (blame-swap blame))])
                          (let-values ([(rng-ids ...) (apply val (dom-id x) ... (rest-id rest-x))])
-                           (check-post-expr->pp/h val post-expr src-info pos-blame orig-str)
-                           (let ([rng-ids-x ((contract-proc (coerce-contract 'stx-name rng-ctc))
-                                             pos-blame neg-blame src-info orig-str
-                                             positive-position?)] ...)
+                           (check-post-expr->pp/h val post-expr blame)
+                           (let ([rng-ids-x ((contract-projection (coerce-contract 'stx-name rng-ctc))
+                                             blame)] ...)
                              (values (rng-ids-x rng-ids) ...))))))))]
                 [((values (rng-ids rng-ctc) ...) . whatever)
                  (and (andmap identifier? (syntax->list (syntax (rng-ids ...))))
@@ -1073,19 +1049,16 @@
                  (syntax
                   ((x ... . rest-x)
                    (begin
-                     (check-pre-expr->pp/h val pre-expr src-info neg-blame orig-str)
-                     (let ([dom-id ((contract-proc (coerce-contract 'stx-name dom)) 
-                                    neg-blame pos-blame src-info orig-str
-                                    (not positive-position?))]
+                     (check-pre-expr->pp/h val pre-expr (blame-swap blame))
+                     (let ([dom-id ((contract-projection (coerce-contract 'stx-name dom))
+                                    (blame-swap blame))]
                            ...
-                           [rest-id ((contract-proc (coerce-contract 'stx-name rest-dom)) 
-                                     neg-blame pos-blame src-info orig-str
-                                     (not positive-position?))]
-                           [rng-id ((contract-proc (coerce-contract 'stx-name rng)) 
-                                    pos-blame neg-blame src-info orig-str
-                                    positive-position?)])
+                           [rest-id ((contract-projection (coerce-contract 'stx-name rest-dom))
+                                     (blame-swap blame))]
+                           [rng-id ((contract-projection (coerce-contract 'stx-name rng))
+                                    blame)])
                        (let ([res-id (rng-id (apply val (dom-id x) ... (rest-id rest-x)))])
-                         (check-post-expr->pp/h val post-expr src-info pos-blame orig-str)
+                         (check-post-expr->pp/h val post-expr blame)
                          res-id)))))]
                 [(rng res-id post-expr)
                  (not (identifier? (syntax res-id)))
diff --git a/collects/mzlib/private/contract-arrow.ss b/collects/mzlib/private/contract-arrow.ss
index 757622b..0a9a658 100644
--- a/collects/mzlib/private/contract-arrow.ss
+++ b/collects/mzlib/private/contract-arrow.ss
@@ -30,21 +30,19 @@
                    [(p-app-x ...) (generate-temporaries #'(rngs ...))]
                    [(res-x ...) (generate-temporaries #'(rngs ...))])
        #'(let ([rngs-x (coerce-contract 'unconstrained-domain-> rngs)] ...)
-           (let ([proj-x ((proj-get rngs-x) rngs-x)] ...)
-             (make-proj-contract
+           (let ([proj-x (contract-projection rngs-x)] ...)
+             (simple-contract
+              #:name
               (build-compound-type-name 'unconstrained-domain-> ((name-get rngs-x) rngs-x) ...)
-              (λ (pos-blame neg-blame src-info orig-str positive-position?)
-                (let ([p-app-x (proj-x pos-blame neg-blame src-info orig-str positive-position?)] ...)
+              #:projection
+              (λ (blame)
+                (let ([p-app-x (proj-x blame)] ...)
                   (λ (val)
                     (if (procedure? val)
                         (λ args
                           (let-values ([(res-x ...) (apply val args)])
                             (values (p-app-x res-x) ...)))
-                        (raise-contract-error val
-                                              src-info
-                                              pos-blame
-                                              orig-str
-                                              "expected a procedure")))))
+                        (raise-blame-error blame val "expected a procedure")))))
               procedure?))))]))
 
 (define (build--> name doms doms-rest rngs kwds quoted-kwds rng-any? func)
@@ -64,64 +62,66 @@
 ;;        and it produces a wrapper-making function.
 (define-struct -> (rng-any? doms dom-rest rngs kwds quoted-kwds func)
   #:omit-define-syntaxes
-  #:property proj-prop
-  (λ (ctc) 
-    (let* ([doms/c (map (λ (x) ((proj-get x) x)) 
-                        (if (->-dom-rest ctc)
+  #:property prop:contract
+  (build-contract-property
+   #:projection
+   (λ (ctc) 
+      (let* ([doms/c (map contract-projection
+                          (if (->-dom-rest ctc)
                             (append (->-doms ctc) (list (->-dom-rest ctc)))
                             (->-doms ctc)))]
-           [rngs/c (map (λ (x) ((proj-get x) x)) (->-rngs ctc))]
-           [kwds/c (map (λ (x) ((proj-get x) x)) (->-kwds ctc))]
-           [mandatory-keywords (->-quoted-kwds ctc)]
-           [func (->-func ctc)]
-           [dom-length (length (->-doms ctc))]
-           [has-rest? (and (->-dom-rest ctc) #t)])
-      (lambda (pos-blame neg-blame src-info orig-str positive-position?)
-        (let ([partial-doms (map (λ (dom) (dom neg-blame pos-blame src-info orig-str (not positive-position?)))
-                                 doms/c)]
-              [partial-ranges (map (λ (rng) (rng pos-blame neg-blame src-info orig-str positive-position?))
-                                   rngs/c)]
-              [partial-kwds (map (λ (kwd) (kwd neg-blame pos-blame src-info orig-str (not positive-position?)))
-                                 kwds/c)])
-          (apply func
-                 (λ (val)
-                   (if has-rest?
-                       (check-procedure/more val dom-length '() mandatory-keywords src-info pos-blame orig-str)
-                       (check-procedure val dom-length 0 '() mandatory-keywords src-info pos-blame orig-str)))
-                 (append partial-doms partial-ranges partial-kwds))))))
-   
-  #:property name-prop
-  (λ (ctc) (single-arrow-name-maker 
-            (->-doms ctc)
-            (->-dom-rest ctc)
-            (->-kwds ctc)
-            (->-quoted-kwds ctc)
-            (->-rng-any? ctc)
-            (->-rngs ctc)))
-  #:property first-order-prop
-  (λ (ctc)
-    (let ([l (length (->-doms ctc))])
-      (if (->-dom-rest ctc)
+             [rngs/c (map contract-projection (->-rngs ctc))]
+             [kwds/c (map contract-projection (->-kwds ctc))]
+             [mandatory-keywords (->-quoted-kwds ctc)]
+             [func (->-func ctc)]
+             [dom-length (length (->-doms ctc))]
+             [has-rest? (and (->-dom-rest ctc) #t)])
+        (lambda (blame)
+          (let ([partial-doms (map (λ (dom) (dom (blame-swap blame)))
+                                   doms/c)]
+                [partial-ranges (map (λ (rng) (rng blame))
+                                     rngs/c)]
+                [partial-kwds (map (λ (kwd) (kwd (blame-swap blame)))
+                                   kwds/c)])
+            (apply func
+                   (λ (val)
+                      (if has-rest?
+                        (check-procedure/more val dom-length '() mandatory-keywords blame)
+                        (check-procedure val dom-length 0 '() mandatory-keywords blame)))
+                   (append partial-doms partial-ranges partial-kwds))))))
+
+   #:name
+   (λ (ctc) (single-arrow-name-maker 
+             (->-doms ctc)
+             (->-dom-rest ctc)
+             (->-kwds ctc)
+             (->-quoted-kwds ctc)
+             (->-rng-any? ctc)
+             (->-rngs ctc)))
+   #:first-order
+   (λ (ctc)
+      (let ([l (length (->-doms ctc))])
+        (if (->-dom-rest ctc)
           (λ (x)
-            (and (procedure? x) 
-                 (procedure-accepts-and-more? x l)))
+             (and (procedure? x) 
+                  (procedure-accepts-and-more? x l)))
           (λ (x)
-            (and (procedure? x) 
-                 (procedure-arity-includes? x l)
-                 (no-mandatory-keywords? x))))))
-  #:property stronger-prop
-  (λ (this that)
-    (and (->? that)
-         (= (length (->-doms that))
-            (length (->-doms this)))
-         (andmap contract-stronger?
-                 (->-doms that)
-                 (->-doms this))
-         (= (length (->-rngs that))
-            (length (->-rngs this)))
-         (andmap contract-stronger?
-                 (->-rngs this) 
-                 (->-rngs that)))))
+             (and (procedure? x) 
+                  (procedure-arity-includes? x l)
+                  (no-mandatory-keywords? x))))))
+   #:stronger
+   (λ (this that)
+      (and (->? that)
+           (= (length (->-doms that))
+              (length (->-doms this)))
+           (andmap contract-stronger?
+                   (->-doms that)
+                   (->-doms this))
+           (= (length (->-rngs that))
+              (length (->-rngs this)))
+           (andmap contract-stronger?
+                   (->-rngs this) 
+                   (->-rngs that))))))
 
 (define (single-arrow-name-maker doms/c doms-rest kwds/c kwds rng-any? rngs)
   (cond
@@ -455,16 +455,14 @@
                                 (append partials-rngs partial)
                                 (append this-stronger-ribs stronger-ribs)))]))])
       (values
-       (with-syntax ((pos (opt/info-pos opt/info))
-                     (src-info (opt/info-src-info opt/info))
-                     (orig-str (opt/info-orig-str opt/info))
+       (with-syntax ((blame (opt/info-blame opt/info))
                      ((dom-arg ...) dom-vars)
                      ((rng-arg ...) rng-vars)
                      ((next-dom ...) next-doms)
                      (dom-len (length dom-vars))
                      ((next-rng ...) next-rngs))
          (syntax (begin
-                   (check-procedure val dom-len 0 '() '() #| keywords |# src-info pos orig-str)
+                   (check-procedure val dom-len 0 '() '() #| keywords |# blame)
                    (λ (dom-arg ...)
                      (let-values ([(rng-arg ...) (val next-dom ...)])
                        (values next-rng ...))))))
@@ -505,14 +503,12 @@
                                 (append partials-doms partial)
                                 (append this-stronger-ribs stronger-ribs)))]))])
       (values
-       (with-syntax ((pos (opt/info-pos opt/info))
-                     (src-info (opt/info-src-info opt/info))
-                     (orig-str (opt/info-orig-str opt/info))
+       (with-syntax ((blame (opt/info-blame opt/info))
                      ((dom-arg ...) dom-vars)
                      ((next-dom ...) next-doms)
                      (dom-len (length dom-vars)))
          (syntax (begin
-                   (check-procedure val dom-len 0 '() '() #|keywords|# src-info pos orig-str)
+                   (check-procedure val dom-len 0 '() '() #|keywords|# blame)
                    (λ (dom-arg ...)
                      (val next-dom ...)))))
        lifts-doms
diff --git a/collects/mzlib/private/contract-object.ss b/collects/mzlib/private/contract-object.ss
index c0166dc..63c91ed 100644
--- a/collects/mzlib/private/contract-object.ss
+++ b/collects/mzlib/private/contract-object.ss
@@ -344,24 +344,24 @@
                      `(object-contract 
                        ,(build-compound-type-name 'method-name method-ctc-var) ...
                        ,(build-compound-type-name 'field 'field-name field-ctc-var) ...)
-                     (lambda (pos-blame neg-blame src-info orig-str positive-position?)
-                       (let ([method/app-var (method-var pos-blame neg-blame src-info orig-str positive-position?)] 
+                     (lambda (blame)
+                       (let ([method/app-var (method-var blame)] 
                              ...
-                             [field/app-var (field-var pos-blame neg-blame src-info orig-str positive-position?)]
+                             [field/app-var (field-var blame)]
                              ...)
                          (let ([field-names-list '(field-name ...)])
                            (lambda (val)
-                             (check-object val src-info pos-blame orig-str)
+                             (check-object val blame)
                              (let ([val-mtd-names
                                     (interface->method-names
                                      (object-interface
                                       val))])
                                (void)
-                               (check-method val 'method-name val-mtd-names src-info pos-blame orig-str)
+                               (check-method val 'method-name val-mtd-names blame)
                                ...)
                              
                              (unless (field-bound? field-name val)
-                               (field-error val 'field-name src-info pos-blame orig-str)) ...
+                               (field-error val 'field-name blame)) ...
                              
                              (let ([vtable (extract-vtable val)]
                                    [method-ht (extract-method-ht val)])
@@ -373,31 +373,16 @@
                      #f)))))))]))))
 
 
-(define (check-object val src-info blame orig-str)
+(define (check-object val blame)
   (unless (object? val)
-    (raise-contract-error val
-                          src-info
-                          blame
-                          orig-str
-                          "expected an object, got ~e"
-                          val)))
+    (raise-blame-error blame val "expected an object, got ~e" val)))
 
-(define (check-method val method-name val-mtd-names src-info blame orig-str)
+(define (check-method val method-name val-mtd-names blame)
   (unless (memq method-name val-mtd-names)
-    (raise-contract-error val
-                          src-info
-                          blame
-                          orig-str
-                          "expected an object with method ~s"
-                          method-name)))
+    (raise-blame-error blame val "expected an object with method ~s" method-name)))
 
-(define (field-error val field-name src-info blame orig-str)
-  (raise-contract-error val
-                        src-info
-                        blame
-                        orig-str
-                        "expected an object with field ~s"
-                        field-name))
+(define (field-error val field-name blame)
+  (raise-blame-error blame val "expected an object with field ~s" field-name))
 
 (define (make-mixin-contract . %/<%>s)
   ((and/c (flat-contract class?)