diff --git a/collects/mzlib/private/contract-object.ss b/collects/mzlib/private/contract-object.ss
index c5018cb950..76d22c7236 100644
--- a/collects/mzlib/private/contract-object.ss
+++ b/collects/mzlib/private/contract-object.ss
@@ -340,10 +340,12 @@
                                                  (list methods ...)
                                                  '(field-name ...)
                                                  #t)])
-                    (make-proj-contract
+                    (simple-contract
+                     #:name
                      `(object-contract 
                        ,(build-compound-type-name 'method-name method-ctc-var) ...
                        ,(build-compound-type-name 'field 'field-name field-ctc-var) ...)
+                     #:projection
                      (lambda (blame)
                        (let ([method/app-var (method-var blame)] 
                              ...
@@ -369,8 +371,7 @@
                                  val
                                  (method/app-var (vector-ref vtable (hash-ref method-ht 'method-name))) ...
                                  (field/app-var (get-field field-name val)) ...
-                                 ))))))
-                     #f)))))))]))))
+                                 )))))))))))))]))))
 
 
 (define (check-object val blame)
diff --git a/collects/mzlib/private/unit-contract.ss b/collects/mzlib/private/unit-contract.ss
index 11b45f84cc..966e059a18 100644
--- a/collects/mzlib/private/unit-contract.ss
+++ b/collects/mzlib/private/unit-contract.ss
@@ -132,7 +132,8 @@
                            export-tagged-infos)])
          (quasisyntax/loc stx
            (begin
-             (make-proj-contract
+             (simple-contract
+              #:name
               (list 'unit/c
                     (cons 'import 
                           (list (cons 'isig
@@ -144,6 +145,7 @@
                                       (map list (list 'e.x ...)
                                            (build-compound-type-name 'e.c ...)))
                                 ...)))
+              #:projection
               (λ (blame)
                 (λ (unit-tmp)
                   (unless (unit? unit-tmp)
@@ -179,6 +181,7 @@
                                   export-sigs
                                   contract-table
                                   #'blame)))))))
+              #:first-order
               (λ (v)
                 (and (unit? v)
                      (with-handlers ([exn:fail:contract? (λ () #f)])
diff --git a/collects/unstable/contract.ss b/collects/unstable/contract.ss
index 64b9cc4433..cf58f91f42 100644
--- a/collects/unstable/contract.ss
+++ b/collects/unstable/contract.ss
@@ -38,26 +38,29 @@
             (if (predicate x) (then-pred x) (else-pred x)))
           (flat-named-contract name pred))
         ;; ho contract
-        (let ([then-proj ((proj-get then-ctc) then-ctc)]
-              [then-fo ((first-order-get then-ctc) then-ctc)]
-              [else-proj ((proj-get else-ctc) else-ctc)]
-              [else-fo ((first-order-get else-ctc) else-ctc)])
-          (define ((proj pos neg srcinfo name pos?) x)
+        (let ([then-proj (contract-projection then-ctc)]
+              [then-fo (contract-first-order then-ctc)]
+              [else-proj (contract-projection else-ctc)]
+              [else-fo (contract-first-order else-ctc)])
+          (define ((proj blame) x)
             (if (predicate x)
-                ((then-proj pos neg srcinfo name pos?) x)
-                ((else-proj pos neg srcinfo name pos?) x)))
-          (make-proj-contract
-           name
-           proj
+                ((then-proj blame) x)
+                ((else-proj blame) x)))
+          (simple-contract
+           #:name name
+           #:projection proj
+           #:first-order
            (lambda (x) (if (predicate x) (then-fo x) (else-fo x))))))))
 
 (define (rename-contract ctc name)
   (let ([ctc (coerce-contract 'rename-contract ctc)])
     (if (flat-contract? ctc)
         (flat-named-contract name (flat-contract-predicate ctc))
-        (let* ([ctc-fo ((first-order-get ctc) ctc)]
-               [proj ((proj-get ctc) ctc)])
-          (make-proj-contract name proj ctc-fo)))))
+        (let* ([ctc-fo (contract-first-order ctc)]
+               [proj (contract-projection ctc)])
+          (simple-contract #:name name
+                           #:projection proj
+                           #:first-order ctc-fo)))))
 
 (provide/contract
  [non-empty-string/c contract?]
diff --git a/collects/web-server/private/xexpr.ss b/collects/web-server/private/xexpr.ss
index 791634186d..8ad3f10d27 100644
--- a/collects/web-server/private/xexpr.ss
+++ b/collects/web-server/private/xexpr.ss
@@ -12,9 +12,10 @@
  [pretty-xexpr/c contract?])
 
 (define pretty-xexpr/c
-  (make-proj-contract
-   'pretty-xexpr/c
-   (lambda (pos neg src-info name)
+  (simple-contract
+   #:name 'pretty-xexpr/c
+   #:projection
+   (lambda (blame)
      (lambda (val)
        (define marks (current-continuation-marks))
        (with-handlers ([exn:fail:contract?
@@ -25,8 +26,7 @@
                             marks
                             `(span ,(drop-after "Context:\n" (exn-message exn)) "\n"
                                    ,(make-cdata #f #f (format-xexpr/errors val))))))])
-         (contract xexpr/c val pos neg src-info))))
-   (lambda (v) #t)))
+         (((contract-projection xexpr/c) blame) val))))))
 
 (define (drop-after delim str)
   (match (regexp-match-positions (regexp-quote delim) str)
diff --git a/collects/web-server/servlet/setup.ss b/collects/web-server/servlet/setup.ss
index 414831f5f2..f50d740005 100644
--- a/collects/web-server/servlet/setup.ss
+++ b/collects/web-server/servlet/setup.ss
@@ -128,10 +128,7 @@
              [neg-blame 'web-server]
              [pos-blame path-sym]
              [module-name `(file ,path-string)]
-             [mk-loc
-              (lambda (name)
-                (list (make-srcloc a-path #f #f #f #f)
-                      name))]
+             [loc (make-srcloc a-path #f #f #f #f)]
              [s (load/use-compiled a-path)])
         (cond
           [(void? s)
@@ -139,47 +136,47 @@
                   (contract (symbols 'v1 'v2 'stateless) 
                             (dynamic-require module-name 'interface-version)
                             pos-blame neg-blame
-                            (mk-loc "interface-version"))])
+                            loc "interface-version")])
              (case version
                [(v1)
                 (let ([timeout (contract number?
                                          (dynamic-require module-name 'timeout)
                                          pos-blame neg-blame
-                                         (mk-loc "timeout"))]
+                                         loc "timeout")]
                       [start (contract (request? . -> . response/c)
                                        (dynamic-require module-name 'start)
                                        pos-blame neg-blame
-                                       (mk-loc "start"))])
+                                       loc "start")])
                   (make-v1.servlet (directory-part a-path) timeout start))]
                [(v2)
                 (let ([start (contract (request? . -> . response/c)
                                        (dynamic-require module-name 'start)
                                        pos-blame neg-blame
-                                       (mk-loc "start"))]
+                                       loc "start")]
                       [manager (contract manager?
                                          (dynamic-require module-name 'manager)
                                          pos-blame neg-blame
-                                         (mk-loc "manager"))])
+                                         loc "manager")])
                   (make-v2.servlet (directory-part a-path) manager start))]
                [(stateless)
                 (let ([start (contract (request? . -> . response/c)
                                        (dynamic-require module-name 'start)
                                        pos-blame neg-blame
-                                       (mk-loc "start"))]
+                                       loc "start")]
                       [manager (contract manager?
                                          (dynamic-require module-name 'manager 
                                                           (lambda () (create-none-manager (lambda (req) (error "No continuations!")))))
                                          pos-blame neg-blame
-                                         (mk-loc "manager"))]
+                                         loc "manager")]
                       [stuffer (contract (stuffer/c serializable? bytes?)
                                          (dynamic-require module-name 'stuffer (lambda () default-stuffer))
                                          pos-blame neg-blame
-                                         (mk-loc "stuffer"))])
+                                         loc "stuffer")])
                   (make-stateless.servlet (directory-part a-path) stuffer manager start))]))]
           [else
            (make-v1.servlet (directory-part a-path) timeouts-default-servlet
                             (v0.response->v1.lambda 
                              (contract response/c s
                                        pos-blame neg-blame
-                                       (mk-loc path-string))
+                                       loc path-string)
                              a-path))])))))
diff --git a/collects/web-server/stuffers/stuffer.ss b/collects/web-server/stuffers/stuffer.ss
index be68b39197..57dfba47c7 100644
--- a/collects/web-server/stuffers/stuffer.ss
+++ b/collects/web-server/stuffers/stuffer.ss
@@ -3,22 +3,20 @@
 (define-struct stuffer (in out))
 (define (stuffer/c dom rng)
   (define in (dom . -> . rng))
-  (define in-proc (contract-proc in))
+  (define in-proc (contract-projection in))
   (define out (rng . -> . dom))  
-  (define out-proc (contract-proc out))
-  (make-proj-contract
-   (build-compound-type-name 'stuffer/c in out)
-   (λ (pos-blame neg-blame src-info orig-str positive-position?)
-     (define in-app (in-proc pos-blame neg-blame src-info orig-str positive-position?))
-     (define out-app (out-proc pos-blame neg-blame src-info orig-str positive-position?))
+  (define out-proc (contract-projection out))
+  (simple-contract
+   #:name (build-compound-type-name 'stuffer/c in out)
+   #:projection
+   (λ (blame)
+     (define in-app (in-proc blame))
+     (define out-app (out-proc blame))
      (λ (val)
        (unless (stuffer? val)
-         (raise-contract-error
+         (raise-blame-error
+          blame
           val
-          src-info
-          pos-blame
-          'ignored
-          orig-str
           "expected <stuffer>, given: ~e"
           val))
        (make-stuffer