diff --git a/pkgs/racket-test/tests/racket/contract/arrow-neg-party.rkt b/pkgs/racket-test/tests/racket/contract/arrow-neg-party.rkt
index 261edd75d1..283f844dc1 100644
--- a/pkgs/racket-test/tests/racket/contract/arrow-neg-party.rkt
+++ b/pkgs/racket-test/tests/racket/contract/arrow-neg-party.rkt
@@ -6,17 +6,48 @@
                                             'racket/contract/private/guts
                                             'racket/contract/private/blame
                                             'racket/contract/private/arrow-val-first
+                                            'racket/contract/private/provide
                                             'racket/contract/private/arity-checking)])
+
+  (contract-eval '(require (for-syntax racket/base)))
   (contract-eval
-   '(define (neg-party-fn c val)
-      (define blame (make-blame (srcloc #f #f #f #f #f)
-                                'a-name
-                                (λ () (contract-name c))
-                                'pos
-                                #f #t))
-      (wrapped-extra-arg-arrow-extra-neg-party-argument
-       (((contract-struct-val-first-projection c) blame) val))))
+   '(define-syntax (define-the-neg-party-accepting-function stx)
+      (syntax-case stx ()
+        [(_ neg-party-fn-id ctc fn-id)
+         (let ()
+           (define-values (arrow? definition-of-plus-one-acceptor the-valid-app-shapes)
+             (build-definition-of-plus-one-acceptor #'ctc
+                                                    #'fn-id
+                                                    #'neg-party-fn-id
+                                                    #'the-contract
+                                                    #'blame-id))
+           (if arrow?
+               #`(begin
+                   (define the-contract ctc)
+                   (define blame-id
+                     (make-blame (srcloc '#,(syntax-source stx)
+                                         '#,(syntax-line stx)
+                                         '#,(syntax-column stx)
+                                         '#,(syntax-position stx)
+                                         '#,(syntax-span stx))
+                                 fn-id
+                                 (λ () (contract-name the-contract))
+                                 'pos #f #t))
+                   #,definition-of-plus-one-acceptor)
+               #`(error 'allow-neg-party.rkt
+                        "no neg-party-acceptor defined for ~s"
+                        '#,(syntax->datum #'ctc))))])))
   
+  (contract-eval
+   '(define-syntax (neg-party-fn stx)
+      (syntax-case stx ()
+        [(_ c val)
+         #'(let ()
+             (define the-value val)
+             (define-the-neg-party-accepting-function the-neg-party-accepting-function
+               c the-value)
+             the-neg-party-accepting-function)])))
+
   (test/spec-passed/result 
    'arity-as-string1
    '(arity-as-string (let ([f (λ (x) x)]) f))
@@ -62,7 +93,7 @@
       (-> integer? integer?)
       (λ (x) x))
      'neg 1))
-  
+
   (test/neg-blame
    '->neg-party2
    '((neg-party-fn
@@ -97,14 +128,13 @@
       (-> integer? integer?)
       (λ (x) (values x x)))
      'neg 1))
-  
+
   (test/spec-passed
    '->*neg-party1
    '((neg-party-fn
       (->* (integer?) integer?)
       (λ (x) x))
      'neg 1))
-  
   (test/neg-blame
    '->*neg-party2
    '((neg-party-fn
@@ -125,14 +155,14 @@
       (->* (integer?) (#:x integer?) any)
       (λ (x #:x [y #f]) y))
      'neg 1 #:x #f))
-  
+
   (test/neg-blame
    '->*neg-party5
    '((neg-party-fn
       (->* (integer?) #:pre #f any)
       (λ (x) y))
      'neg 1))
-  
+
   (test/pos-blame
    '->*neg-party6
    '((neg-party-fn
@@ -301,4 +331,20 @@
       (-> any/c boolean?)
       (λ (x) #t))
      'neg 1)
-   #t))
+   #t)
+
+  (test/neg-blame
+   '->neg-party25
+   '((neg-party-fn
+      (->* () () #:pre/desc "get-apples not allowed" any)
+      (λ () #t))
+     'neg))
+
+  (test/pos-blame
+   '->neg-party26
+   '((neg-party-fn
+      (->* () () any/c #:post/desc "put-apples not allowed")
+      (λ () #t))
+     'neg))
+
+  )
diff --git a/pkgs/racket-test/tests/racket/contract/arrow-star.rkt b/pkgs/racket-test/tests/racket/contract/arrow-star.rkt
index 0ac04e332a..085b716cf5 100644
--- a/pkgs/racket-test/tests/racket/contract/arrow-star.rkt
+++ b/pkgs/racket-test/tests/racket/contract/arrow-star.rkt
@@ -16,8 +16,6 @@
   (test/no-error '(->* ((flat-contract integer?)) () #:pre #t (flat-contract integer?) #:post #t))
   (test/no-error '(->* (any/c) () #:pre/desc #t (flat-contract integer?) #:post/desc #t))
   
-  
-  
   (test/spec-passed
    'contract-arrow-star0a
    '(contract (->* (integer?) () integer?)
diff --git a/pkgs/racket-test/tests/racket/contract/helpers.rkt b/pkgs/racket-test/tests/racket/contract/helpers.rkt
index aad8d4d65c..7e1a234c97 100644
--- a/pkgs/racket-test/tests/racket/contract/helpers.rkt
+++ b/pkgs/racket-test/tests/racket/contract/helpers.rkt
@@ -72,38 +72,34 @@
 	                              1 1 '() '(#:y #:z))
               #f)
 
-
-(check-equal? (->-valid-app-shapes #'(-> integer? integer?))
+(define (->-shapes arg)
+  (define-values (a b) (->-valid-app-shapes arg))
+  a)
+(check-equal? (->-shapes #'(-> integer? integer?))
               (valid-app-shapes '(1) '() '()))
-(check-equal? (->-valid-app-shapes #'(-> integer? boolean? integer?))
+(check-equal? (->-shapes #'(-> integer? boolean? integer?))
               (valid-app-shapes '(2) '() '()))
-(check-equal? (->-valid-app-shapes #'(-> integer? #:x any/c integer?))
+(check-equal? (->-shapes #'(-> integer? #:x any/c integer?))
               (valid-app-shapes '(1) '(#:x) '()))
-(check-equal? (->-valid-app-shapes #'(-> integer? (... ...) any))
+(check-equal? (->-shapes #'(-> integer? (... ...) any))
               (valid-app-shapes 0 '() '()))
-(check-equal? (->-valid-app-shapes #'(-> integer? integer? (... ...) any))
+(check-equal? (->-shapes #'(-> integer? integer? (... ...) any))
               (valid-app-shapes 1 '() '()))
-(check-equal? (->-valid-app-shapes #'(-> integer? integer? (... ...) integer? any))
+(check-equal? (->-shapes #'(-> integer? integer? (... ...) integer? any))
               (valid-app-shapes 2 '() '()))
-(check-equal? (->-valid-app-shapes #'(-> integer? integer? (... ...) integer? boolean? char? any))
+(check-equal? (->-shapes #'(-> integer? integer? (... ...) integer? boolean? char? any))
               (valid-app-shapes 4 '() '()))
-(check-equal? (->-valid-app-shapes #'(-> integer? boolean? char? (... ...) integer? char? any))
+(check-equal? (->-shapes #'(-> integer? boolean? char? (... ...) integer? char? any))
               (valid-app-shapes 4 '() '()))
 
-(check-equal? (->*-valid-app-shapes #'(->* (integer? #:x any/c #:y any/c) integer?))
+(define (->*-shapes arg)
+  (define-values (a b) (->*-valid-app-shapes arg))
+  a)
+(check-equal? (->*-shapes #'(->* (integer? #:x any/c #:y any/c) integer?))
               (valid-app-shapes '(1) '(#:x #:y) '()))
-(check-equal? (->*-valid-app-shapes #'(->* () (integer? #:x any/c #:y any/c) integer?))
+(check-equal? (->*-shapes #'(->* () (integer? #:x any/c #:y any/c) integer?))
               (valid-app-shapes '(0 1) '() '(#:x #:y)))
-(check-equal? (->*-valid-app-shapes #'(->* (any/c) (any/c) #:rest any/c integer?))
-              (valid-app-shapes '(1 2 . 3) '() '()))
-
-(check-equal? (->i-valid-app-shapes #'(->i () () [r any/c]))
-              (valid-app-shapes '(0) '() '()))
-(check-equal? (->*-valid-app-shapes #'(->i ([p integer?] #:x [x any/c] #:y [y any/c]) [r any/c]))
-              (valid-app-shapes '(1) '(#:x #:y) '()))
-(check-equal? (->*-valid-app-shapes #'(->i () ([p integer?] #:x [x any/c] #:y [y any/c]) [r any/c]))
-              (valid-app-shapes '(0 1) '() '(#:x #:y)))
-(check-equal? (->*-valid-app-shapes #'(->i ([m any/c]) ([o any/c]) #:rest [r any/c] [r any/c]))
+(check-equal? (->*-shapes #'(->* (any/c) (any/c) #:rest any/c integer?))
               (valid-app-shapes '(1 2 . 3) '() '()))
 
 (check-true  (valid-argument-list? #'(f x) (valid-app-shapes '(1 2 . 3) '() '())))
diff --git a/racket/collects/racket/contract/base.rkt b/racket/collects/racket/contract/base.rkt
index 855bf88b0d..a4bfb460dc 100644
--- a/racket/collects/racket/contract/base.rkt
+++ b/racket/collects/racket/contract/base.rkt
@@ -34,8 +34,7 @@
  matches-arity-exactly?
  keywords-match
  bad-number-of-results
- (for-syntax check-tail-contract
-             parse-leftover->*)
+ (for-syntax check-tail-contract)
  tail-marks-match?
  values/drop
  arity-checking-wrapper
diff --git a/racket/collects/racket/contract/combinator.rkt b/racket/collects/racket/contract/combinator.rkt
index d71593cd22..367dfb038b 100644
--- a/racket/collects/racket/contract/combinator.rkt
+++ b/racket/collects/racket/contract/combinator.rkt
@@ -75,7 +75,6 @@
  contract-continuation-mark-key
  with-contract-continuation-mark
 
- (struct-out wrapped-extra-arg-arrow)
  contract-custom-write-property-proc
  (rename-out [contract-custom-write-property-proc custom-write-property-proc])
  
diff --git a/racket/collects/racket/contract/private/arr-i-parse.rkt b/racket/collects/racket/contract/private/arr-i-parse.rkt
index d3c8070ca4..dbf71ba637 100644
--- a/racket/collects/racket/contract/private/arr-i-parse.rkt
+++ b/racket/collects/racket/contract/private/arr-i-parse.rkt
@@ -632,33 +632,8 @@ code does the parsing and validation of the syntax.
       [_
        (raise-syntax-error #f "bad syntax" stx)])))
 
-(define (->i-valid-app-shapes stx)
-  (define an-istx (parse-->i stx))
-  (define mans 0)
-  (define opts 0)
-  (define man-kwds '())
-  (define opt-kwds '())
-  (for ([arg (in-list (istx-args an-istx))])
-    (define kwd (arg-kwd arg))
-    (define opt? (arg-optional? arg))
-    (cond
-      [(and kwd opt?)
-       (set! opt-kwds (cons kwd opt-kwds))]
-      [(and kwd (not opt?))
-       (set! man-kwds (cons kwd man-kwds))]
-      [(and (not kwd) opt?)
-       (set! opts (+ opts 1))]
-      [(and (not kwd) (not opt?))
-       (set! mans (+ mans 1))]))
-  (valid-app-shapes-from-man/opts mans 
-                                  opts
-                                  (istx-rst an-istx)
-                                  man-kwds
-                                  opt-kwds))
-
 (provide
  parse-->i
- ->i-valid-app-shapes
  (struct-out istx)
  (struct-out arg/res)
  (struct-out arg)
diff --git a/racket/collects/racket/contract/private/arrow-common.rkt b/racket/collects/racket/contract/private/arrow-common.rkt
index 5cbc8518f7..4fc087d558 100644
--- a/racket/collects/racket/contract/private/arrow-common.rkt
+++ b/racket/collects/racket/contract/private/arrow-common.rkt
@@ -33,14 +33,14 @@
 ;; kwd-infos : (listof kwd-info)
 ;; rest : (or/c #f contract?)
 ;; pre? : (or/c #f 'pre 'pre/desc)
+;; pre-thunk : (or/c #f thunk)
 ;; rngs : (listof contract?)
 ;; post? : (or/c #f 'post 'post/desc)
-;; plus-one-arity-function : procedure? -- special, +1 argument wrapper that accepts neg-party
+;; post-thunk : (or/c #f thunk)
 ;; chaperone-constructor ; procedure? -- function that builds a projection tailored to this arrow
 ;; method? : boolean?
-(define-struct base-> (min-arity doms kwd-infos rest pre? rngs post?
-                                 plus-one-arity-function chaperone-constructor
-                                 method?)
+(define-struct base-> (min-arity doms kwd-infos rest pre? pre-thunk rngs post? post-thunk
+                                 chaperone-constructor method?)
   #:property prop:custom-write custom-write-property-proc)
 
 (define-struct unsupplied-arg ())
diff --git a/racket/collects/racket/contract/private/arrow-higher-order.rkt b/racket/collects/racket/contract/private/arrow-higher-order.rkt
index 1a2d535cc5..fd2817e2cc 100644
--- a/racket/collects/racket/contract/private/arrow-higher-order.rkt
+++ b/racket/collects/racket/contract/private/arrow-higher-order.rkt
@@ -21,7 +21,10 @@
          ->-proj
          check-pre-cond
          check-post-cond
-         arity-checking-wrapper)
+         check-pre-cond/desc
+         check-post-cond/desc
+         arity-checking-wrapper
+         build-subcontract-late-negs)
 
 (define-for-syntax (build-chaperone-constructor/real ;; (listof (or/c #f stx))
                                                      ;; #f => syntactically known to be any/c
@@ -41,14 +44,20 @@
                 [(mandatory-dom-kwd-proj ...) (nvars (length mandatory-dom-kwds) 'mandatory-dom-proj)]
                 [(optional-dom-kwd-proj ...) (nvars (length optional-dom-kwds) 'optional-dom-proj)]
                 [(rng-proj ...) (if rngs (generate-temporaries rngs) '())]
-                [(rest-proj ...) (if rest (generate-temporaries '(rest-proj)) '())])
+                [(rest-proj ...) (if rest (generate-temporaries '(rest-proj)) '())]
+                [(pre-thunk pre/desc-thunk post-thunk post/desc-thunk)
+                 (generate-temporaries '(pre-thunk pre/desc-thunk post-thunk post/desc-thunk))])
     #`(λ (blame f neg-party blame-party-info is-impersonator? rng-ctcs
-                mandatory-dom-proj ...  
-                optional-dom-proj ... 
+                mandatory-dom-proj ...
+                optional-dom-proj ...
                 rest-proj ...
-                mandatory-dom-kwd-proj ... 
-                optional-dom-kwd-proj ... 
-                rng-proj ...)
+                mandatory-dom-kwd-proj ...
+                optional-dom-kwd-proj ...
+                #,@(if pre (list #'pre-thunk) (list))
+                #,@(if pre/desc (list #'pre/desc-thunk) (list))
+                rng-proj ...
+                #,@(if post (list #'post-thunk) (list))
+                #,@(if post/desc (list #'post/desc-thunk) (list)))
         (define blame+neg-party (cons blame neg-party))
         #,(create-chaperone
            #'blame #'neg-party #'blame+neg-party #'blame-party-info #'is-impersonator? #'f #'rng-ctcs
@@ -62,41 +71,47 @@
            (map list 
                 optional-dom-kwds
                 (syntax->list #'(optional-dom-kwd-proj ...)))
-           pre pre/desc
+           (if pre #'pre-thunk #f)
+           (if pre/desc #'pre/desc-thunk #f)
            (if rest (car (syntax->list #'(rest-proj ...))) #f)
            (if rngs (syntax->list #'(rng-proj ...)) #f)
-           post post/desc
+           (if post #'post-thunk #f)
+           (if post/desc #'post/desc-thunk #f)
            method?))))
 
 
-(define (check-pre-cond pre blame neg-party blame+neg-party val)
+(define (check-pre-cond pre blame+neg-party val)
   (with-contract-continuation-mark
    blame+neg-party
    (unless (pre)
-     (raise-blame-error (blame-swap blame)
-                        #:missing-party neg-party
+     (raise-blame-error (blame-swap (car blame+neg-party))
+                        #:missing-party (cdr blame+neg-party)
                         val "#:pre condition"))))
 
-(define (check-post-cond post blame neg-party blame+neg-party val)
+(define (check-post-cond post blame+neg-party val)
   (with-contract-continuation-mark
    blame+neg-party
    (unless (post)
-     (raise-blame-error blame
-                        #:missing-party neg-party
+     (raise-blame-error (car blame+neg-party)
+                        #:missing-party (cdr blame+neg-party)
                         val "#:post condition"))))
 
-(define (check-pre-cond/desc post blame neg-party val)
-  (handle-pre-post/desc-string #t post blame neg-party val))
-(define (check-post-cond/desc post blame neg-party val)
-  (handle-pre-post/desc-string #f post blame neg-party val))
-(define (handle-pre-post/desc-string pre? thunk blame neg-party val)
-  (define condition-result (thunk))
+(define (check-pre-cond/desc post blame+neg-party val)
+  (handle-pre-post/desc-string #t post blame+neg-party val))
+(define (check-post-cond/desc post blame+neg-party val)
+  (handle-pre-post/desc-string #f post blame+neg-party val))
+(define (handle-pre-post/desc-string pre? thunk blame+neg-party val)
+  (define condition-result
+    (with-contract-continuation-mark blame+neg-party
+      (thunk)))
   (cond
     [(equal? condition-result #t) 
      (void)]
     [else
      (define msg
        (arrow:pre-post/desc-result->string condition-result pre? '->*))
+     (define blame (car blame+neg-party))
+     (define neg-party (cdr blame+neg-party))
      (raise-blame-error (if pre? (blame-swap blame) blame)
                         #:missing-party neg-party
                         val "~a" msg)]))
@@ -117,16 +132,16 @@
     (with-syntax ([(pre ...) 
                    (cond
                      [pre
-                      (list #`(check-pre-cond #,pre blame neg-party blame+neg-party val))]
+                      (list #`(check-pre-cond #,pre blame+neg-party val))]
                      [pre/desc
-                      (list #`(check-pre-cond/desc #,pre/desc blame neg-party val))]
+                      (list #`(check-pre-cond/desc #,pre/desc blame+neg-party val))]
                      [else null])]
                   [(post ...)
                    (cond
                      [post
-                      (list #`(check-post-cond #,post blame neg-party blame+neg-party val))]
+                      (list #`(check-post-cond #,post blame+neg-party val))]
                      [post/desc
-                      (list #`(check-post-cond/desc #,post/desc blame neg-party val))]
+                      (list #`(check-post-cond/desc #,post/desc blame+neg-party val))]
                      [else null])])
       (with-syntax ([(dom-x ...) (generate-temporaries doms)]
                     [(opt-dom-ctc ...) opt-doms]
@@ -541,8 +556,8 @@
 
 (define (->-proj is-impersonator? ctc
                  ;; fields of the 'ctc' struct
-                 min-arity doms kwd-infos rest pre? rngs post?
-                 plus-one-arity-function chaperone-constructor method?
+                 min-arity doms kwd-infos rest pre? pre-thunk rngs post? post-thunk
+                 chaperone-constructor method?
                  late-neg?)
   (define has-c-c-support?
     (->-contract-has-collapsible-support? ctc))
@@ -558,65 +573,24 @@
          (andmap any/c? doms)
          (= optionals-length 0)))
   (λ (orig-blame)
-    (define rng-blame (arrow:blame-add-range-context orig-blame))
-    (define swapped-domain (blame-add-context orig-blame "the domain of" #:swap? #t))
+    (define-values (partial-doms
+                    partial-rests
+                    man-then-opt-partial-kwds
+                    partial-ranges
+                    c-c-doms
+                    maybe-c-c-ranges)
+      (build-subcontract-late-negs orig-blame doms rest rngs kwd-infos method?))
+    (define the-args (append partial-doms
+                             partial-rests
+                             man-then-opt-partial-kwds
+                             (if pre-thunk (list pre-thunk) '())
+                             partial-ranges
+                             (if post-thunk (list post-thunk) '())))
 
-    ;; if the ctc supports c-c mode, there are only positional args
-    (define-values (partial-doms c-c-doms)
-      (for/lists (projs ses)
-                 ([dom (in-list doms)]
-                  [n (in-naturals 1)])
-        (define dom-blame
-          (blame-add-context orig-blame
-                             (nth-argument-of (if method? (sub1 n) n))
-                             #:swap? #t))
-        (define prepared (get/build-collapsible-late-neg-projection dom))
-        (prepared dom-blame)))
-
-    (define rest-blame
-      (if (ellipsis-rest-arg-ctc? rest)
-          (blame-swap orig-blame)
-          (blame-add-context orig-blame "the rest argument of"
-                             #:swap? #t)))
-    (define partial-rest (and rest
-                              ((get/build-late-neg-projection rest)
-                               rest-blame)))
-    (define-values (partial-ranges maybe-c-c-ranges)
-      (cond
-        [rngs
-         (for/lists (proj c-c)
-                    ([rng (in-list rngs)])
-           (define prepared (get/build-collapsible-late-neg-projection rng))
-           (prepared rng-blame))]
-        [else (values '() #f)]))
-    (define partial-kwds 
-      (for/list ([kwd-info (in-list kwd-infos)]
-                 [kwd (in-list kwd-infos)])
-        ((get/build-late-neg-projection (kwd-info-ctc kwd-info))
-         (blame-add-context orig-blame
-                            (format "the ~a argument of" (kwd-info-kwd kwd))
-                            #:swap? #t))))
-    (define man-then-opt-partial-kwds
-      (append (for/list ([partial-kwd (in-list partial-kwds)]
-                         [kwd-info (in-list kwd-infos)]
-                         #:when (kwd-info-mandatory? kwd-info))
-                partial-kwd)
-              (for/list ([partial-kwd (in-list partial-kwds)]
-                         [kwd-info (in-list kwd-infos)]
-                         #:unless (kwd-info-mandatory? kwd-info))
-                partial-kwd)))
     (define c-c-mergable
       (and has-c-c-support?
            (build-collapsible-arrow (car maybe-c-c-ranges) c-c-doms ctc orig-blame chaperone?)))
-    (define the-args (append partial-doms
-                             (if partial-rest (list partial-rest) '())
-                             man-then-opt-partial-kwds
-                             partial-ranges))
-    (define plus-one-constructor-args
-      (append partial-doms
-              man-then-opt-partial-kwds
-              partial-ranges
-              (if partial-rest (list partial-rest) '())))
+
     (define blame-party-info (arrow:get-blame-party-info orig-blame))
     (define (successfully-got-the-right-kind-of-function val neg-party)
       (define old-c-c-prop (get-impersonator-prop:collapsible val #f))
@@ -718,31 +692,74 @@
            (or c-c-mergable (build-collapsible-leaf arrow-higher-order:lnp ctc orig-blame)))])]
       [else
        (define (arrow-higher-order:vfp val)
-         (define-values (normal-proc proc-with-no-result-checking expected-number-of-results)
-           (apply plus-one-arity-function orig-blame val plus-one-constructor-args))
          (cond
            [(do-arity-checking orig-blame val doms rest min-arity kwd-infos method?)
             =>
             (λ (neg-party-acceptor)
-              ;; probably don't need to include the wrapped-extra-arrow wrapper
-              ;; here, but it is easier to reason about the contract-out invariant
-              ;; with it here
-              (wrapped-extra-arg-arrow neg-party-acceptor normal-proc))]
+              neg-party-acceptor)]
            [else
-            (wrapped-extra-arg-arrow
-             (λ (neg-party)
-               (successfully-got-the-right-kind-of-function val neg-party))
-             (if (equal? (procedure-result-arity val) expected-number-of-results)
-                 proc-with-no-result-checking
-                 normal-proc))]))
+            (λ (neg-party)
+              (successfully-got-the-right-kind-of-function val neg-party))]))
        (if okay-to-do-only-arity-check?
            (λ (val)
              (cond
                [(arrow:procedure-arity-exactly/no-kwds val min-arity)
-                (define-values (normal-proc proc-with-no-result-checking expected-number-of-results)
-                  (apply plus-one-arity-function orig-blame val plus-one-constructor-args))
-                (wrapped-extra-arg-arrow 
-                 (λ (neg-party) val)
-                 normal-proc)]
+                (λ (neg-party) val)]
                [else (arrow-higher-order:vfp val)]))
            arrow-higher-order:vfp)])))
+
+(define (build-subcontract-late-negs orig-blame doms rest rngs kwd-infos method?)
+  (define rng-blame (arrow:blame-add-range-context orig-blame))
+  (define swapped-domain (blame-add-context orig-blame "the domain of" #:swap? #t))
+
+  ;; if the ctc supports c-c mode, there are only positional args
+  (define-values (partial-doms c-c-doms)
+    (for/lists (projs ses)
+               ([dom (in-list doms)]
+                [n (in-naturals 1)])
+      (define dom-blame
+        (blame-add-context orig-blame
+                           (nth-argument-of (if method? (sub1 n) n))
+                           #:swap? #t))
+      (define prepared (get/build-collapsible-late-neg-projection dom))
+      (prepared dom-blame)))
+
+  (define rest-blame
+    (if (ellipsis-rest-arg-ctc? rest)
+        (blame-swap orig-blame)
+        (blame-add-context orig-blame "the rest argument of"
+                           #:swap? #t)))
+  (define partial-rest (and rest
+                            ((get/build-late-neg-projection rest)
+                             rest-blame)))
+  (define-values (partial-ranges maybe-c-c-ranges)
+    (cond
+      [rngs
+       (for/lists (proj c-c)
+                  ([rng (in-list rngs)])
+         (define prepared (get/build-collapsible-late-neg-projection rng))
+         (prepared rng-blame))]
+      [else (values '() #f)]))
+  (define partial-kwds
+    (for/list ([kwd-info (in-list kwd-infos)]
+               [kwd (in-list kwd-infos)])
+      ((get/build-late-neg-projection (kwd-info-ctc kwd-info))
+       (blame-add-context orig-blame
+                          (format "the ~a argument of" (kwd-info-kwd kwd))
+                          #:swap? #t))))
+  (define man-then-opt-partial-kwds
+    (append (for/list ([partial-kwd (in-list partial-kwds)]
+                       [kwd-info (in-list kwd-infos)]
+                       #:when (kwd-info-mandatory? kwd-info))
+              partial-kwd)
+            (for/list ([partial-kwd (in-list partial-kwds)]
+                       [kwd-info (in-list kwd-infos)]
+                       #:unless (kwd-info-mandatory? kwd-info))
+              partial-kwd)))
+
+  (values partial-doms
+          (if partial-rest (list partial-rest) '())
+          man-then-opt-partial-kwds
+          partial-ranges
+          c-c-doms
+          maybe-c-c-ranges))
\ No newline at end of file
diff --git a/racket/collects/racket/contract/private/arrow-val-first.rkt b/racket/collects/racket/contract/private/arrow-val-first.rkt
index 75d5b3d54b..019d11be3f 100644
--- a/racket/collects/racket/contract/private/arrow-val-first.rkt
+++ b/racket/collects/racket/contract/private/arrow-val-first.rkt
@@ -1,4 +1,15 @@
 #lang racket/base
+
+#|
+
+TODO: find the places where the functions are constructed and called for plus1 and chaperone.
+(to be able to add the pre/post conditions as arguments instead of inlining them into the wrappers)
+
+plus1 call:  build->*-plus-one-acceptor
+plus1 arg list construction: build-plus-one-arity-function/real
+
+|#
+
 (require (for-syntax racket/base
                      "application-arity-checking.rkt"
                      "arr-util.rkt")
@@ -20,12 +31,26 @@
          base->? base->-name base->-rngs base->-doms
          dynamic->*
          arity-checking-wrapper
-         (for-syntax parse-leftover->*)
          (for-syntax ->-arity-check-only->?
                      ->*-arity-check-only->?
                      ->-valid-app-shapes
                      ->*-valid-app-shapes)
-         (rename-out [-predicate/c predicate/c]))
+         (rename-out [-predicate/c predicate/c])
+         build->*-plus-one-acceptor)
+
+(begin-for-syntax
+  (struct parsed->* (man-dom       ;; syntax?[(id ...)]
+                     man-dom-kwds  ;; syntax?[((kwd id) ..)]
+                     opt-dom       ;; syntax?[(id ...)]
+                     opt-dom-kwds  ;; syntax?[((kwd id) ..)]
+                     rest-ctc      ;; (or/c #f syntax?[id])
+                     pre           ;; (or/c #f syntax?[id])
+                     pre/desc      ;; (or/c #f syntax?[id])
+                     rng-ctcs      ;; (or/c #f syntax?[(id ...)])
+                     post          ;; (or/c #f syntax?[id])
+                     post/desc     ;; (or/c #f syntax?[id])
+                     lets)         ;; syntax?[([id expr] ...)]
+    #:prefab))
 
 (define-for-syntax (->-arity-check-only->? stx)
   (syntax-case stx (any any/c)
@@ -67,11 +92,11 @@
             [else success ...])))])))
 
 (define-for-syntax popular-keys
-  ;; of the 6075 contracts that get compiled during
-  ;; 'raco setup' of main-distribution and main-distribution-test,
-  ;; these are all the ones that appear at least 60 times, as of
-  ;; January 2016. Plus the ones that appear at least 10 times in
-  ;; contracts that TR generates for plot-gui-lib, as of October 2017
+  ;; the most popular contract shapes as of January 2016 from
+  ;; the main distribution package; plus some that TR generates
+  ;; for plot-gui-lib as of October 2017; as of July 2019, using
+  ;; these popular keys appears to save about 10% of the disk
+  ;; space taken by .zo files during the main-distribution build
   `((() 0 () () #f 1)
     (() 0 () () #f #f)
     ((#f) 0 () () #f 1)
@@ -126,7 +151,7 @@
                                                'popular-chaperone-key-id)))))]))
 (generate-popular-key-ids popular-key-ids)
 
-(define-for-syntax (build-plus-one-arity-function+chaperone-constructor
+(define-for-syntax (argument-details->popular-keys-table-entry/info
                     pre-regular-args
                     optional-args
                     mandatory-kwds
@@ -145,44 +170,114 @@
       (syntax-case stx (any/c)
         [any/c #f]
         [else stx])))
-  (define key (and (not pre) (not pre/desc)
-                   (not post) (not post/desc)
-                   (list (map not regular-args/no-any/c)
-                         (length optional-args)
-                         (map syntax-e mandatory-kwds)
-                         (map syntax-e optional-kwds)
-                         (and rest #t)
-                         (and rngs (if (syntax? rngs)
-                                       (length (syntax->list rngs))
-                                       (length rngs))))))
+  (define key
+    (and (not pre) (not pre/desc)
+         (not post) (not post/desc)
+         (list (map not regular-args/no-any/c)
+               (length optional-args)
+               (map syntax-e mandatory-kwds)
+               (map syntax-e optional-kwds)
+               (and rest #t)
+               (and rngs (if (syntax? rngs)
+                             (length (syntax->list rngs))
+                             (length rngs))))))
+  (define entry-in-table (and key (member key popular-keys)))
+  (define index (and entry-in-table
+                     (- (length popular-keys) (length entry-in-table))))
+  (values (and index (list-ref popular-key-ids index))
+          regular-args/no-any/c
+          regular-args))
+
+(define-for-syntax (build-code-for-chaperone-constructor
+                    a-parsed->*
+                    method?)
+
+  (define pre-regular-args (parsed->*-man-dom a-parsed->*))
+  (define optional-args (parsed->*-opt-dom a-parsed->*))
+  (define mandatory-kwds
+    (with-syntax ([((mandatory-dom-kwd mandatory-dom-kwd-ctc) ...)
+                   (parsed->*-man-dom-kwds a-parsed->*)])
+      (syntax->list #'(mandatory-dom-kwd ...))))
+  (define optional-kwds
+    (with-syntax ([((optional-dom-kwd optional-dom-kwd-ctc) ...)
+                   (parsed->*-opt-dom-kwds a-parsed->*)])
+      (syntax->list #'(optional-dom-kwd ...))))
+  (define rest (parsed->*-rest-ctc a-parsed->*))
+  (define rngs (parsed->*-rng-ctcs a-parsed->*))
+  (define pre (parsed->*-pre a-parsed->*))
+  (define pre/desc (parsed->*-pre/desc a-parsed->*))
+  (define post (parsed->*-post a-parsed->*))
+  (define post/desc (parsed->*-post/desc a-parsed->*))
+
+  (define-values (ids regular-args/no-any/c regular-args)
+    (argument-details->popular-keys-table-entry/info pre-regular-args
+                                                     optional-args
+                                                     mandatory-kwds
+                                                     optional-kwds
+                                                     pre pre/desc
+                                                     rest
+                                                     rngs
+                                                     post post/desc
+                                                     method?))
   (cond
-    [(and key (member key popular-keys))
-     =>
-     (λ (l)
-       (define index (- (length popular-keys) (length l)))
-       (define ids (list-ref popular-key-ids index))
-       (values (list-ref ids 0) (list-ref ids 1)))]
+    [ids (list-ref ids 1)]
     [else
-     (values (build-plus-one-arity-function/real
-              regular-args
-              optional-args
-              mandatory-kwds
-              optional-kwds
-              pre pre/desc
-              rest
-              rngs
-              post post/desc
-              method?)
-             (build-chaperone-constructor/real
-              regular-args/no-any/c
-              optional-args
-              mandatory-kwds
-              optional-kwds
-              pre pre/desc
-              rest
-              rngs
-              post post/desc
-              method?))]))
+     (build-chaperone-constructor/real
+      regular-args/no-any/c
+      optional-args
+      mandatory-kwds
+      optional-kwds
+      pre pre/desc
+      rest
+      rngs
+      post post/desc
+      method?)]))
+
+(define-for-syntax (build-code-for-plus-one-arity-function
+                    a-parsed->*
+                    method?)
+
+  (define pre-regular-args (parsed->*-man-dom a-parsed->*))
+  (define optional-args (parsed->*-opt-dom a-parsed->*))
+  (define mandatory-kwds
+    (with-syntax ([((mandatory-dom-kwd mandatory-dom-kwd-ctc) ...)
+                   (parsed->*-man-dom-kwds a-parsed->*)])
+      (syntax->list #'(mandatory-dom-kwd ...))))
+  (define optional-kwds
+    (with-syntax ([((optional-dom-kwd optional-dom-kwd-ctc) ...)
+                   (parsed->*-opt-dom-kwds a-parsed->*)])
+      (syntax->list #'(optional-dom-kwd ...))))
+  (define rest (parsed->*-rest-ctc a-parsed->*))
+  (define rngs (parsed->*-rng-ctcs a-parsed->*))
+
+  (define pre (parsed->*-pre a-parsed->*))
+  (define pre/desc (parsed->*-pre/desc a-parsed->*))
+  (define post (parsed->*-post a-parsed->*))
+  (define post/desc (parsed->*-post/desc a-parsed->*))
+
+  (define-values (ids regular-args/no-any/c regular-args)
+    (argument-details->popular-keys-table-entry/info pre-regular-args
+                                                     optional-args
+                                                     mandatory-kwds
+                                                     optional-kwds
+                                                     pre pre/desc
+                                                     rest
+                                                     rngs
+                                                     post post/desc
+                                                     method?))
+  (cond
+    [ids (list-ref ids 0)]
+    [else
+     (build-plus-one-arity-function/real
+      regular-args
+      optional-args
+      mandatory-kwds
+      optional-kwds
+      pre pre/desc
+      rest
+      rngs
+      post post/desc
+      method?)]))
 
 (define-syntax (build-populars stx)
   (syntax-case stx ()
@@ -221,19 +316,14 @@
                        rng-vars
                        #f #f #f))
                   (define #,(syntax-local-introduce chaperone-id)
-                    #,(let ([ans (build-chaperone-constructor/real
-                                  mans/no-any/c opts
-                                  mandatory-kwds
-                                  optional-kwds
-                                  #f #f
-                                  rest
-                                  rng-vars
-                                  #f #f #f)])
-                        #;
-                        (when (equal? key (list '(#t) 0 '() '() #f 1))
-                          ((dynamic-require 'racket/pretty 'pretty-write) (syntax->datum ans))
-                          (exit))
-                        ans))))
+                    #,(build-chaperone-constructor/real
+                       mans/no-any/c opts
+                       mandatory-kwds
+                       optional-kwds
+                       #f #f
+                       rest
+                       rng-vars
+                       #f #f #f))))
          (define popular-chaperone-key-table
            (make-hash
             (list #,@(for/list ([id (in-list popular-key-ids)]
@@ -283,13 +373,19 @@
       (with-syntax ([(wrapper-args ...) #'(neg-party arg-x ... formal-kwd-args ...)]
                     [(the-call ...) #`(f #,@(reverse normal-arg-vars) kwd-arg-exps ...)]
                     [(pre-check ...)
-                     (if pre 
-                         (list #`(check-pre-cond #,pre blame neg-party (cons blame neg-party) f))
-                         (list))]
+                     (cond
+                       [pre 
+                        (list #`(check-pre-cond #,pre blame+neg-party f))]
+                       [pre/desc
+                        (list #`(check-pre-cond/desc #,pre/desc blame+neg-party f))]
+                       [else (list)])]
                     [(post-check ...)
-                     (if post
-                         (list #`(check-post-cond #,post blame neg-party (cons blame neg-party) f))
-                         (list))]
+                     (cond
+                       [post
+                        (list #`(check-post-cond #,post blame+neg-party f))]
+                       [post/desc
+                        (list #`(check-post-cond/desc #,post/desc blame+neg-party f))]
+                       [else (list)])]
                     [(restb) (generate-temporaries '(rest-args))])
         (define (make-body-proc range-checking?)
           (cond
@@ -373,8 +469,8 @@
                                       (rb res-x neg-party)
                                       ...))))]))]
                        #`[#,the-args
-                          pre-check ...
                           (let ([blame+neg-party (cons blame neg-party)])
+                            pre-check ...
                             (let-values (#,let-values-clause)
                               #,full-call))]))
                  (cons the-clause
@@ -394,37 +490,66 @@
             [else
              #`(make-checking-proc f blame
                                    #,(if pre pre #'#f)
+                                   #,(if pre/desc pre/desc #'#f)
                                    '(#,@mandatory-kwds) (list kb ...)
-                                   '(#,@optional-kwds) (list okb ...) 
+                                   '(#,@optional-kwds) (list okb ...)
                                    #,(length regular-args) (list regb ... optb ...)
                                    #,(if rest #'restb #'#f)
                                    #,(if post post #'#f)
+                                   #,(if post/desc post/desc #'#f)
                                    #,(if rngs #'(list rb ...) #'#f)
                                    #,method?)]))
-        (define body-proc (make-body-proc #t))
-        (define body-proc/no-range-checking (make-body-proc #f))
         (define number-of-rngs (and rngs (with-syntax ([rngs rngs]) (length (syntax->list #'rngs)))))
-        #`(λ (blame f regb ... optb ... kb ... okb ... rb ... #,@(if rest (list #'restb) '()))
-            (values
-             (procedure-specialize
-              #,body-proc)
-             #,(if rngs
-                   #`(procedure-specialize
-                      #,body-proc/no-range-checking)
-                   #'shouldnt-be-called)
-             '#,(if rngs number-of-rngs 'there-is-no-range-contract)))))))
+        #`(λ (f)
+            (λ (blame regb ... optb ... kb ... okb ...
+                      #,@(if pre (list pre) '())
+                      #,@(if pre/desc (list pre/desc) '())
+                      #,@(if rest (list #'restb) '())
+                      rb ...
+                      #,@(if post (list post) '())
+                      #,@(if post/desc (list post/desc) '()))
+              (procedure-specialize
+               #,(if rngs
+                     #`(if (equal? #,number-of-rngs (procedure-result-arity f))
+                           #,(make-body-proc #f)
+                           #,(make-body-proc #t))
+                     (make-body-proc #t)))))))))
 
-(define (shouldnt-be-called . args)
-  (error 'arrow-val-first.rkt
-         (string-append
-          "this function should not ever be called because"
-          " procedure-result-arity shouldn't return 'there-is-no-range-contract")))
+(define (build->*-plus-one-acceptor plus-one-arity-wrapper-maker
+                                    blame
+                                    ->stct)
+  (define-values (partial-doms
+                  partial-rests
+                  man-then-opt-partial-kwds
+                  partial-ranges
+                  c-c-doms
+                  maybe-c-c-ranges)
+    (build-subcontract-late-negs blame
+                                 (base->-doms ->stct)
+                                 (base->-rest ->stct)
+                                 (base->-rngs ->stct)
+                                 (base->-kwd-infos ->stct)
+                                 #f))
+  (define plus-one-constructor-args
+    (append partial-doms
+            man-then-opt-partial-kwds
+            partial-rests
+            (if (base->-pre-thunk ->stct)
+                (list (base->-pre-thunk ->stct))
+                '())
+            partial-ranges
+            (if (base->-post-thunk ->stct)
+                (list (base->-post-thunk ->stct))
+                '())))
+  (apply plus-one-arity-wrapper-maker
+         blame
+         plus-one-constructor-args))
 
-(define (make-checking-proc f blame pre
+(define (make-checking-proc f blame pre pre/desc
                             original-mandatory-kwds kbs
                             original-optional-kwds okbs
                             minimum-arg-count rbs rest-ctc
-                            post rngs
+                            post post/desc rngs
                             method?)
   (make-keyword-procedure
    (λ (actual-kwds actual-kwd-args neg-party . regular-args)
@@ -480,15 +605,18 @@
             [else
              (cons ((car rbs) (car regular-args) neg-party)
                    (loop (cdr regular-args) (cdr rbs)))]))))
-     (define complete-blame (blame-add-missing-party blame neg-party))
-     (when pre (check-pre-cond pre blame neg-party complete-blame f))
+     (define blame+neg-party (cons blame neg-party))
+     (when pre (check-pre-cond pre blame+neg-party f))
+     (when pre/desc (check-pre-cond/desc pre blame+neg-party f))
      (cond
        [rngs
         (define results (call-with-values mk-call list))
         (define rng-len (length rngs))
         (unless (= (length results) rng-len)
-          (bad-number-of-results complete-blame f rng-len results))
-        (when post (check-post-cond post blame neg-party complete-blame f))
+          (bad-number-of-results (blame-add-missing-party blame neg-party)
+                                 f rng-len results))
+        (when post (check-post-cond post blame+neg-party f))
+        (when post/desc (check-post-cond post/desc blame+neg-party f))
         (apply
          values
          (for/list ([result (in-list results)]
@@ -577,6 +705,22 @@
             [(keyword<? opt-kwd kwd)
              (loop mandatory-kwds (cdr optional-kwds) kwds)])])])))
 
+(define-for-syntax (parse-> stx this->)
+  (syntax-case stx ()
+    [(_ args ... rng)
+     (let ()
+       (define-values (regular-args kwds kwd-args let-bindings ellipsis-info)
+         (parse-arrow-args stx (syntax->list #'(args ...)) this->))
+       (define (add-pos-obligations stxes)
+         (for/list ([stx (in-list stxes)])
+           (syntax-property stx 'racket/contract:positive-position this->)))
+       (define rngs
+         (syntax-case #'rng (any values)
+           [any #f]
+           [(values rng ...) (add-pos-obligations (syntax->list #'(rng ...)))]
+           [rng (add-pos-obligations (list #'rng))]))
+       (values regular-args kwds kwd-args let-bindings ellipsis-info rngs))]))
+
 (define-for-syntax (parse-arrow-args stx args this->)
   (let loop ([args args]
              [regular-args '()]
@@ -674,17 +818,26 @@
 
 (define-for-syntax (->-valid-app-shapes stx)
   (syntax-case stx ()
-    [(_ args ...)
+    [(_ args ... rng)
      (let ()
-       (define this-> (gensym 'this->))
-       (define-values (regular-args kwds kwd-args let-bindings ellipsis-info)
-         (parse-arrow-args stx (syntax->list #'(args ...)) this->))
-       (define arg-count (- (length regular-args) 1))
-       (valid-app-shapes (if ellipsis-info
-                             (+ arg-count (- (length ellipsis-info) 1))
-                             (list arg-count))
-                         (map syntax->datum kwds)
-                         '()))]))
+       (define-values (regular-args kwds kwd-args let-bindings ellipsis-info rngs)
+         (parse-> stx (gensym 'this->)))
+       (define arg-count (length regular-args))
+       (define app-shapes
+         (valid-app-shapes (if ellipsis-info
+                               (+ arg-count (length ellipsis-info) -1)
+                               (list arg-count))
+                           (map syntax->datum kwds)
+                           '()))
+       (values app-shapes
+               (build-code-for-plus-one-arity-function
+                (with-syntax ([(kwds ...) kwds]
+                              [(kwd-args ...) kwd-args])
+                  (parsed->* regular-args #'((kwds kwd-args) ...)
+                             '() '()
+                             (and ellipsis-info #t)
+                             #f #f rngs #f #f '()))
+                #f)))]))
 
 (define-syntax (->/c stx)
   (syntax-case stx ()
@@ -696,19 +849,16 @@
     [(_ args ... rng)
      (let ()
        (define this-> (gensym 'this->))
-       (define-values (regular-args kwds kwd-args let-bindings ellipsis-info)
-         (parse-arrow-args stx (syntax->list #'(args ...)) this->))
-       (define (add-pos-obligations stxes)
-         (for/list ([stx (in-list stxes)])
-           (syntax-property stx 'racket/contract:positive-position this->)))
-       (define rngs
-         (syntax-case #'rng (any values)
-           [any #f]
-           [(values rng ...) (add-pos-obligations (syntax->list #'(rng ...)))]
-           [rng (add-pos-obligations (list #'rng))]))
-       (define-values (plus-one-arity-function chaperone-constructor)
-         (build-plus-one-arity-function+chaperone-constructor 
-          regular-args '() kwds '() #f #f (and ellipsis-info #t) rngs #f #f
+       (define-values (regular-args kwds kwd-args let-bindings ellipsis-info rngs)
+         (parse-> stx this->))
+       (define chaperone-constructor
+         (build-code-for-chaperone-constructor
+          (with-syntax ([(kwds ...) kwds]
+                        [(kwd-args ...) kwd-args])
+            (parsed->* regular-args #'((kwds kwd-args) ...)
+                       '() '()
+                       (and ellipsis-info #t) #f #f rngs #f #f
+                       '()))
           method?))
        (syntax-property
         #`(let #,let-bindings
@@ -723,14 +873,12 @@
                     (quasisyntax/loc stx
                       (build-nullary-very-simple-->
                        #,(car rngs)
-                       #,plus-one-arity-function
                        #,chaperone-constructor))]
                    [(and (equal? rng-count 1) (= doms-count 1))
                     (quasisyntax/loc stx
                       (build-unary-very-simple-->
                        #,(car regular-args)
                        #,(car rngs)
-                       #,plus-one-arity-function
                        #,chaperone-constructor))]
                    [else
                     (quasisyntax/loc stx
@@ -739,7 +887,6 @@
                        #,(if rngs
                              #`(list #,@rngs)
                              #'#f)
-                       #,plus-one-arity-function
                        #,chaperone-constructor))])]
                 [else
                  (quasisyntax/loc stx
@@ -750,7 +897,6 @@
                     #,(if rngs
                           #`(list #,@rngs)
                           #'#f)
-                    #,plus-one-arity-function
                     #,chaperone-constructor
                     #,(if ellipsis-info
                           #`(ellipsis-rest-arg #,(length regular-args) #,@ellipsis-info)
@@ -810,31 +956,32 @@
   (syntax-case stx ()
     [(_ (raw-mandatory-dom ...) . other)
      (let ()
-       (define-values (raw-optional-doms rest-ctc pre pre/desc rng-ctcs post post/desc)
+       (define-values (raw-optional-doms rest-ctc pre pre/desc rng-ctcs post post/desc
+                                         additional-lets)
          (parse-leftover->* stx #'other))
        (with-syntax ([(man-dom
                        man-dom-kwds
-                       man-lets)
+                       (man-lets ...))
                       (:split-doms stx '->* #'(raw-mandatory-dom ...) this->*)]
                      [(opt-dom
                        opt-dom-kwds
-                       opt-lets)
-                      (:split-doms stx '->* raw-optional-doms this->*)])
+                       (opt-lets ...))
+                      (:split-doms stx '->* raw-optional-doms this->*)]
+                     [(additional-lets ...) additional-lets])
          ;; call sort-keywords for the duplicate variable check
          (sort-keywords stx (append (syntax->list #'man-dom-kwds) (syntax->list #'opt-dom-kwds)))
-         (values
-          #'man-dom
-          #'man-dom-kwds
-          #'man-lets
-          #'opt-dom
-          #'opt-dom-kwds
-          #'opt-lets
-          rest-ctc pre pre/desc rng-ctcs post post/desc)))]))
+         (parsed->* (syntax->list #'man-dom)
+                    #'man-dom-kwds
+                    (syntax->list #'opt-dom)
+                    #'opt-dom-kwds
+                    rest-ctc pre pre/desc rng-ctcs post post/desc
+                    #'(man-lets ... opt-lets ... additional-lets ...))))]))
 
 ;; -> (values raw-optional-doms rest-ctc pre rng-ctc post)
 ;; rest-ctc (or/c #f syntax) -- #f means no rest contract, syntax is the contract
 ;; rng-ctc (or/c #f syntax) -- #f means `any', syntax is a sequence of result values
 (define-for-syntax (parse-leftover->* stx leftover)
+  (define additional-lets '())
   (let*-values ([(raw-optional-doms leftover)
                  (syntax-case leftover ()
                    [(kwd . rst)
@@ -857,17 +1004,25 @@
                          (not (keyword? #'another-thing)))
                     (raise-syntax-error
                      #f
-                     "expected the #:rest keyword to be followed only by the range (possibly with pre- and post-conditions)"
+                     (string-append
+                      "expected the #:rest keyword to be followed only by the range"
+                      " (possibly with pre- and post-conditions)")
                      stx #'another-thing)]
                    [(#:rest rest-expr . leftover)
-                    (values #'rest-expr #'leftover)]
+                    (with-syntax ([(rest-x) (generate-temporaries #'(rest-expr))])
+                      (set! additional-lets (cons #'[rest-x rest-expr] additional-lets))
+                      (values #'rest-x #'leftover))]
                    [_ (values #f leftover)])]
                 [(pre pre/desc leftover)
                  (syntax-case leftover ()
                    [(#:pre pre-expr . leftover)
-                    (values #'pre-expr #f #'leftover)]
+                    (with-syntax ([(pre-x) (generate-temporaries #'(pre-expr))])
+                      (set! additional-lets (cons #`[pre-x (λ () pre-expr)] additional-lets))
+                      (values #'pre-x #f #'leftover))]
                    [(#:pre/desc pre-expr . leftover)
-                    (values #f #'pre-expr #'leftover)]
+                    (with-syntax ([(pre-x) (generate-temporaries #'(pre-expr))])
+                      (set! additional-lets (cons #`[pre-x (λ () pre-expr)] additional-lets))
+                      (values #f #'pre-x #'leftover))]
                    [_ (values #f #f leftover)])]
                 [(rng leftover)
                  (syntax-case leftover (any values)
@@ -885,31 +1040,36 @@
                 [(post post/desc leftover)
                  (syntax-case leftover ()
                    [(#:post post-expr . leftover)
-                    (values #'post-expr #f #'leftover)]
+                    (with-syntax ([(post-x) (generate-temporaries #'(post-expr))])
+                      (set! additional-lets (cons #`[post-x (λ () post-expr)] additional-lets))
+                      (values #'post-x #f #'leftover))]
                    [(#:post/desc post-expr . leftover)
-                    (values #f #'post-expr #'leftover)]
+                    (with-syntax ([(post-x) (generate-temporaries #'(post-expr))])
+                      (set! additional-lets (cons #`[post-x (λ () post-expr)] additional-lets))
+                      (values #f #'post-x #'leftover))]
                    [else
                     (values #f #f leftover)])])
     (syntax-case leftover ()
-      [() (values raw-optional-doms rst pre pre/desc rng post post/desc)]
-      [(x . y) (raise-syntax-error #f "expected the contract to end, but found an extra sub-piece" stx #'x)])))
+      [() (values raw-optional-doms rst pre pre/desc rng post post/desc
+                  (reverse additional-lets))]
+      [(x . y) (raise-syntax-error #f "expected the contract to end, but found an extra sub-piece"
+                                   stx #'x)])))
 
 (define-for-syntax (->*-valid-app-shapes stx)
   (define this->* (gensym 'this->*))
-  (define-values (man-dom man-dom-kwds man-lets
-                          opt-dom opt-dom-kwds opt-lets
-                          rest-ctc pre pre/desc rng-ctcs post post/desc)
-    (parse->* stx this->*))
-  (with-syntax ([((mandatory-dom-kwd mandatory-dom-kwd-ctc) ...) man-dom-kwds]
-                [((optional-dom-kwd optional-dom-kwd-ctc) ...) opt-dom-kwds])
-    (cond
-      [(or pre pre/desc post post/desc) #f]
-      [else
-       (valid-app-shapes-from-man/opts (length (syntax->list man-dom))
-                                       (length (syntax->list opt-dom))
-                                       rest-ctc
-                                       (syntax->datum #'(mandatory-dom-kwd ...))
-                                       (syntax->datum #'(optional-dom-kwd ...)))])))
+  (define a-parsed->* (parse->* stx this->*))
+  (with-syntax ([((mandatory-dom-kwd mandatory-dom-kwd-ctc) ...)
+                 (parsed->*-man-dom-kwds a-parsed->*)]
+                [((optional-dom-kwd optional-dom-kwd-ctc) ...)
+                 (parsed->*-opt-dom-kwds a-parsed->*)])
+    (values (valid-app-shapes-from-man/opts (length (parsed->*-man-dom a-parsed->*))
+                                            (length (parsed->*-opt-dom a-parsed->*))
+                                            (parsed->*-rest-ctc a-parsed->*)
+                                            (syntax->datum #'(mandatory-dom-kwd ...))
+                                            (syntax->datum #'(optional-dom-kwd ...)))
+            (build-code-for-plus-one-arity-function
+             a-parsed->*
+             #f))))
 
 (define-syntax (->* stx)
   (syntax-case stx ()
@@ -918,68 +1078,45 @@
 
 (define-for-syntax (->*-internal stx method?)
   (define this->* (gensym 'this->*))
-  (define-values (man-dom man-dom-kwds man-lets
-                          opt-dom opt-dom-kwds opt-lets
-                          rest-ctc pre pre/desc rng-ctcs post post/desc)
-    (parse->* stx this->*))
-  (with-syntax ([(mandatory-dom ...) man-dom]
-                [((mandatory-dom-kwd mandatory-dom-kwd-ctc) ...) man-dom-kwds]
-                [(mandatory-let-bindings ...) man-lets]
-                [(optional-dom ...) opt-dom]
-                [((optional-dom-kwd optional-dom-kwd-ctc) ...) opt-dom-kwds]
-                [(optional-let-bindings ...) opt-lets]
-                [(pre-x post-x) (generate-temporaries '(pre-cond post-cond))])
-    (with-syntax ([((kwd dom opt?) ...) #'((mandatory-dom-kwd mandatory-dom-kwd-ctc #f) ...
-                                           (optional-dom-kwd optional-dom-kwd-ctc #t) ...)]
-                  [(pre-let-binding ...) (if (or pre pre/desc)
-                                             (list #`[pre-x (λ () #,(or pre pre/desc))])
-                                             (list))]
-                  [(post-let-binding ...) (if (or post post/desc)
-                                              (list #`[post-x (λ () #,(or post post/desc))])
-                                              (list))])
-      (define-values (plus-one-arity-function chaperone-constructor)
-        (build-plus-one-arity-function+chaperone-constructor
-         (syntax->list #'(mandatory-dom ...))
-         (syntax->list #'(optional-dom ...))
-         (syntax->list #'(mandatory-dom-kwd ...))
-         (syntax->list #'(optional-dom-kwd ...))
-         (and pre #'pre-x)
-         (and pre/desc #'pre-x)
-         rest-ctc
-         rng-ctcs
-         (and post #'post-x)
-         (and post/desc #'post-x)
-         method?))
-      (syntax-property
-       #`(let (mandatory-let-bindings ...
-                                      optional-let-bindings ...
-                                      pre-let-binding ...
-                                      post-let-binding ...)
-           (build--> '->*
-                     (list mandatory-dom ...)
-                     (list optional-dom ...)
-                     '(mandatory-dom-kwd ...)
-                     (list mandatory-dom-kwd-ctc ...)
-                     '(optional-dom-kwd ...)
-                     (list optional-dom-kwd-ctc ...)
-                     #,rest-ctc
-                     #,(cond [pre #''pre] [pre/desc #''pre/desc] [else #'#f])
-                     #,(if rng-ctcs
-                           #`(list #,@(for/list ([rng-ctc (in-list (syntax->list rng-ctcs))])
-                                        (syntax-property rng-ctc
-                                                         'racket/contract:positive-position
-                                                         this->*)))
-                           #'#f)
-                     #,(cond [post #''post] [post/desc #''post/desc] [else #'#f])
-                     #,plus-one-arity-function 
-                     #,chaperone-constructor
-                     #,method?))
+  (define a-parsed->* (parse->* stx this->*))
+  (with-syntax ([((mandatory-dom-kwd mandatory-dom-kwd-ctc) ...) (parsed->*-man-dom-kwds a-parsed->*)]
+                [((optional-dom-kwd optional-dom-kwd-ctc) ...) (parsed->*-opt-dom-kwds a-parsed->*)]
+                [(let-bindings ...) (parsed->*-lets a-parsed->*)])
+    (define pre (parsed->*-pre a-parsed->*))
+    (define pre/desc (parsed->*-pre/desc a-parsed->*))
+    (define post (parsed->*-post a-parsed->*))
+    (define post/desc (parsed->*-post/desc a-parsed->*))
+    (define rest-ctc (parsed->*-rest-ctc a-parsed->*))
+    (define rng-ctcs (parsed->*-rng-ctcs a-parsed->*))
+    (define chaperone-constructor (build-code-for-chaperone-constructor a-parsed->* method?))
+    (syntax-property
+     #`(let (let-bindings ...)
+         (build--> '->*
+                   (list #,@(parsed->*-man-dom a-parsed->*))
+                   (list #,@(parsed->*-opt-dom a-parsed->*))
+                   '(mandatory-dom-kwd ...)
+                   (list mandatory-dom-kwd-ctc ...)
+                   '(optional-dom-kwd ...)
+                   (list optional-dom-kwd-ctc ...)
+                   #,rest-ctc
+                   #,(cond [pre #''pre] [pre/desc #''pre/desc] [else #'#f])
+                   #,(or pre pre/desc #'#f)
+                   #,(if rng-ctcs
+                         #`(list #,@(for/list ([rng-ctc (in-list (syntax->list rng-ctcs))])
+                                      (syntax-property rng-ctc
+                                                       'racket/contract:positive-position
+                                                       this->*)))
+                         #'#f)
+                   #,(cond [post #''post] [post/desc #''post/desc] [else #'#f])
+                   #,(or post post/desc #'#f)
+                   #,chaperone-constructor
+                   #,method?))
 
-       'racket/contract:contract
-       (vector this->*
-               ;; the -> in the original input to this guy
-               (list (car (syntax-e stx)))
-               '())))))
+     'racket/contract:contract
+     (vector this->*
+             ;; the -> in the original input to this guy
+             (list (car (syntax-e stx)))
+             '()))))
 
 (define (wrong-number-of-results-blame blame neg-party val reses expected-values)
   (define length-reses (length reses))
@@ -992,7 +1129,6 @@
    (if (= 1 expected-values) "" "s")))
 
 (define (build-nullary-very-simple--> _rng
-                                      plus-one-arity-function
                                       chaperone-constructor)
   (define rng (coerce-contract '-> _rng))
   (cond
@@ -1001,20 +1137,17 @@
      ->void-contract]
     [(chaperone-contract? rng)
      (make--> 0
-              '() '() #f #f
-              (list rng) #f
-              plus-one-arity-function
+              '() '() #f #f #f
+              (list rng) #f #f
               chaperone-constructor
               #f)]
     [else
-     (make-impersonator-> 0 '() '() #f #f
-                          (list rng) #f
-                          plus-one-arity-function
+     (make-impersonator-> 0 '() '() #f #f #f
+                          (list rng) #f #f
                           chaperone-constructor
                           #f)]))
 
 (define (build-unary-very-simple--> _dom _rng
-                                    plus-one-arity-function
                                     chaperone-constructor)
   (define dom (coerce-contract '-> _dom))
   (define rng (coerce-contract '-> _rng))
@@ -1026,23 +1159,20 @@
     [(and (chaperone-contract? dom)
           (chaperone-contract? rng))
      (make--> 1
-              (list dom) '() #f #f
-              (list rng) #f
-              plus-one-arity-function
+              (list dom) '() #f #f #f
+              (list rng) #f #f
               chaperone-constructor
               #f)]
     [else
      (make-impersonator-> 1
-                          (list dom) '() #f #f
-                          (list rng) #f
-                          plus-one-arity-function
+                          (list dom) '() #f #f #f
+                          (list rng) #f #f
                           chaperone-constructor
                           #f)]))
 
 ;; INVARIANT: this is not called when `build-unary-very-simple-->`
 ;; or `build-nullary-very-simple-->` could have been
 (define (build-very-simple--> raw-regular-doms raw-rngs
-                              plus-one-arity-function
                               chaperone-constructor)
   (define regular-doms
     (for/list ([dom (in-list raw-regular-doms)])
@@ -1055,23 +1185,20 @@
     [(and (andmap chaperone-contract? regular-doms)
           (andmap chaperone-contract? (or rngs '())))
      (make--> (length raw-regular-doms)
-              regular-doms '() #f #f
-              rngs #f
-              plus-one-arity-function
+              regular-doms '() #f #f #f
+              rngs #f #f
               chaperone-constructor
               #f)]
     [else
      (make-impersonator-> (length raw-regular-doms)
-                          regular-doms '() #f #f
-                          rngs #f
-                          plus-one-arity-function
+                          regular-doms '() #f #f #f
+                          rngs #f #f
                           chaperone-constructor
                           #f)]))
 
 (define (build-simple--> raw-regular-doms
                          mandatory-kwds mandatory-raw-kwd-doms
                          raw-rngs
-                         plus-one-arity-function
                          chaperone-constructor
                          raw-rest-ctc
                          method?)
@@ -1080,8 +1207,7 @@
             mandatory-kwds mandatory-raw-kwd-doms
             '() '()
             raw-rest-ctc
-            #f raw-rngs #f
-            plus-one-arity-function
+            #f #f raw-rngs #f #f
             chaperone-constructor
             method?))
 
@@ -1090,8 +1216,9 @@
                   mandatory-kwds mandatory-raw-kwd-doms
                   optional-kwds optional-raw-kwd-doms
                   raw-rest-ctc
-                  pre-cond raw-rngs post-cond
-                  plus-one-arity-function
+                  pre-cond pre-cond-thunk
+                  raw-rngs
+                  post-cond post-cond-thunk
                   chaperone-constructor
                   method?)
   (define raw-regular-doms
@@ -1144,16 +1271,16 @@
           (andmap (λ (x) (chaperone-contract? (kwd-info-ctc x))) kwd-infos)
           (andmap chaperone-contract? (or rngs '())))
      (make--> (length raw-regular-doms)
-              regular-doms kwd-infos rest-ctc pre-cond
-              rngs post-cond
-              plus-one-arity-function
+              regular-doms kwd-infos rest-ctc
+              pre-cond pre-cond-thunk
+              rngs post-cond post-cond-thunk
               chaperone-constructor
               method?)]
     [else
      (make-impersonator-> (length raw-regular-doms)
-                          regular-doms kwd-infos rest-ctc pre-cond
-                          rngs post-cond
-                          plus-one-arity-function
+                          regular-doms kwd-infos rest-ctc
+                          pre-cond pre-cond-thunk
+                          rngs post-cond post-cond-thunk
                           chaperone-constructor
                           method?)]))
 
@@ -1169,6 +1296,8 @@
   ;; leave these out for now
   (define pre-cond #f)
   (define post-cond #f)
+  (define pre-cond-thunk #f)
+  (define post-cond-thunk #f)
   
   (define-syntax-rule (check-list e) (check-list/proc e 'e))
   (define (check-list/proc e name)
@@ -1226,13 +1355,6 @@
           [(null? _args) (error 'plug-one-arity-function-dynamic->* "internal error")]
           [else (cons (car _args) (loop (- n 1) (cdr _args)))]))))
   
-  (define (plus-one-arity-function blame f . args)
-    (define f
-      (make-keyword-procedure
-       (λ (kwds kwd-args . regular-args)
-         (error 'plus-one-arity-function "not implemented for dynamic->*"))))
-    (values f f 'not-a-number-so-it-doesnt-match-any-result-from-procedure-result-arity))
-  
   (define min-arity (length mandatory-domain-contracts))
   (define optionals (length optional-domain-contracts))
   (define rng-len (and range-contracts (length range-contracts)))
@@ -1317,8 +1439,7 @@
             mandatory-keywords mandatory-keyword-contracts
             optional-keywords optional-keyword-contracts
             rest-contract
-            pre-cond range-contracts post-cond
-            plus-one-arity-function
+            pre-cond pre-cond-thunk range-contracts post-cond post-cond-thunk
             build-chaperone-constructor
             #f)) ; not a method contract
 
@@ -1539,9 +1660,10 @@
                (base->-kwd-infos ->stct)
                (base->-rest ->stct)
                (base->-pre? ->stct)
+               (base->-pre-thunk ->stct)
                (base->-rngs ->stct)
                (base->-post? ->stct)
-               (base->-plus-one-arity-function ->stct)
+               (base->-post-thunk ->stct)
                (base->-chaperone-constructor ->stct)
                (base->-method? ->stct)
                #f)))
@@ -1553,9 +1675,10 @@
                (base->-kwd-infos ->stct)
                (base->-rest ->stct)
                (base->-pre? ->stct)
+               (base->-pre-thunk ->stct)
                (base->-rngs ->stct)
                (base->-post? ->stct)
-               (base->-plus-one-arity-function ->stct)
+               (base->-post-thunk ->stct)
                (base->-chaperone-constructor ->stct)
                (base->-method? ->stct)
                #t)))
@@ -1622,7 +1745,7 @@
        (not (base->-pre? that))
        (not (base->-post? this))
        (not (base->-post? that))))
-     
+
 (define-struct (-> base->) ()
   #:property prop:chaperone-contract (make-property #f))
 
@@ -1641,31 +1764,9 @@
                     (error '->void-contract "expected the 0th key to be ~s" desired-key))
                   (define ids (list-ref popular-key-ids expected-index))
                   (list-ref ids 1))])
-    (make--> 0 '() '() #f #f
+    (make--> 0 '() '() #f #f #f
              (list (coerce-contract 'whatever void?))
-             #f
-             (λ (blame f _ignored)
-               (values
-                (λ (neg-party)
-                  (call-with-values/check-range
-                   (λ () (f))
-                   (case-lambda
-                     [(rng)
-                      (if (void? rng)
-                          rng
-                          (raise-blame-error blame #:missing-party neg-party rng
-                                             '(expected: "void?" given: "~e")
-                                             rng))]
-                     [args
-                      (wrong-number-of-results-blame blame neg-party f args 1)])))
-                (λ (neg-party)
-                  (let ([rng (f)])
-                    (if (void? rng)
-                        rng
-                        (raise-blame-error blame #:missing-party neg-party rng
-                                           '(expected: "void?" given: "~e")
-                                           rng))))
-                1))
+             #f #f
              (get-chaperone-constructor)
              #f))) ; not a method contract
 
@@ -1682,22 +1783,9 @@
        (check-result blame neg-party rng)]
       [args
        (wrong-number-of-results-blame blame neg-party f args 1)]))
-  (constructor 1 (list any/c) '() #f #f
+  (constructor 1 (list any/c) '() #f #f #f
                (list (coerce-contract 'whatever boolean?))
-               #f
-               (λ (blame f _ignored-dom-contract _ignored-rng-contract)
-                 (values
-                  (λ (neg-party argument)
-                    (call-with-values/check-range
-                     (λ () (f argument))
-                     (case-lambda
-                       [(rng)
-                        (check-result blame neg-party rng)]
-                       [args
-                        (wrong-number-of-results-blame blame neg-party f args 1)])))
-                  (λ (neg-party argument)
-                    (check-result blame neg-party (f argument)))
-                  1))
+               #f #f
                (λ (blame f neg-party
                          _ignored-blame-party-info
                          _ignored-is-impersonator?
diff --git a/racket/collects/racket/contract/private/guts.rkt b/racket/collects/racket/contract/private/guts.rkt
index 13fd2adb5d..892a55e0a7 100644
--- a/racket/collects/racket/contract/private/guts.rkt
+++ b/racket/collects/racket/contract/private/guts.rkt
@@ -64,7 +64,6 @@
          collapsible-contract-continuation-mark-key
          with-collapsible-contract-continuation-mark
          
-         (struct-out wrapped-extra-arg-arrow)
          contract-custom-write-property-proc
          (rename-out [contract-custom-write-property-proc custom-write-property-proc])
 
@@ -448,9 +447,6 @@
   (let-syntax ([m (λ (x) #`(list #,@(known-good-contracts)))])
     (m)))
 
-(struct wrapped-extra-arg-arrow (real-func extra-neg-party-argument)
-  #:property prop:procedure 0)
-
 (define-syntax (define/final-prop stx)
   (syntax-case stx ()
     [(_ header bodies ...)
diff --git a/racket/collects/racket/contract/private/provide.rkt b/racket/collects/racket/contract/private/provide.rkt
index 832366e92b..9472377fac 100644
--- a/racket/collects/racket/contract/private/provide.rkt
+++ b/racket/collects/racket/contract/private/provide.rkt
@@ -3,7 +3,8 @@
 (provide provide/contract
          provide/contract-for-contract-out
          define-module-boundary-contract
-         (protect-out (for-syntax true-provide/contract
+         (protect-out (for-syntax build-definition-of-plus-one-acceptor ;; used in test suite
+                                  true-provide/contract
                                   ;make-provide/contract-transformer
                                   provide/contract-info?
                                   provide/contract-info-contract-id
@@ -318,25 +319,16 @@
                                                         contract-error-name
                                                         pos-module-source
                                                         context-limit)
-  (define-values (arrow? the-valid-app-shapes)
-    (syntax-case ctrct (-> ->* ->i)
-      [(-> . _) 
-       (not (->-arity-check-only->? ctrct))
-       (values #t (->-valid-app-shapes ctrct))]
-      [(->* . _)
-       (cond
-         [(->*-arity-check-only->? ctrct) (values #f #f)]
-         [else
-          (define shapes (->*-valid-app-shapes ctrct))
-          (if shapes
-              (values #t shapes)
-              (values #f #f))])]
-      [(->i . _) (values #t (->i-valid-app-shapes ctrct))]
-      [_ (values #f #f)]))
   (with-syntax ([id id]
                 [(partially-applied-id extra-neg-party-argument-fn contract-id blame-id) 
                  (generate-temporaries (list 'idX 'idY 'idZ 'idB))]
                 [ctrct ctrct])
+    (define-values (arrow? definition-of-plus-one-acceptor the-valid-app-shapes)
+      (build-definition-of-plus-one-acceptor #'ctrct
+                                             #'id
+                                             #'extra-neg-party-argument-fn
+                                             #'contract-id
+                                             #'blame-id))
     (syntax-local-lift-module-end-declaration
      #`(begin 
          (define-values (partially-applied-id blame-id)
@@ -347,9 +339,7 @@
                            #,srcloc-expr
                            #,context-limit))
          #,@(if arrow?
-                (list #`(define extra-neg-party-argument-fn 
-                          (wrapped-extra-arg-arrow-extra-neg-party-argument
-                           partially-applied-id)))
+                (list definition-of-plus-one-acceptor)
                 (list))))
 
     #`(begin
@@ -376,6 +366,42 @@
                    (quote-syntax partially-applied-id)
                    (quote-syntax blame-id)))))))
 
+(define-for-syntax (build-definition-of-plus-one-acceptor ctrct
+                                                          id
+                                                          extra-neg-party-argument-fn
+                                                          contract-id
+                                                          blame-id)
+  (define-values (arrow? the-valid-app-shapes
+                         build-plus-one-acceptor
+                         plus-one-arity-function-code)
+    (syntax-case ctrct (-> ->* ->i)
+      [(-> . _) 
+       (not (->-arity-check-only->? ctrct))
+       (let ()
+         (define-values (valid-app-shapes plus-one-arity-function-code)
+           (->-valid-app-shapes ctrct))
+         (values #t
+                 valid-app-shapes
+                 #'build->*-plus-one-acceptor
+                 plus-one-arity-function-code))]
+      [(->* . _)
+       (cond
+         [(->*-arity-check-only->? ctrct) (values #f #f #f #f)]
+         [else
+          (define-values (shapes plus-one-arity-function-code)
+            (->*-valid-app-shapes ctrct))
+          (if shapes
+              (values #t shapes #'build->*-plus-one-acceptor plus-one-arity-function-code)
+              (values #f #f #f #f))
+          ])]
+      [_ (values #f #f #f #f)]))
+  (values arrow?
+          #`(define #,extra-neg-party-argument-fn
+              (#,build-plus-one-acceptor (#,plus-one-arity-function-code #,id)
+                                         #,blame-id
+                                         #,contract-id))
+          the-valid-app-shapes))
+
 (define-syntax (define-module-boundary-contract stx)
   (cond
     [(equal? (syntax-local-context) 'module-begin)
diff --git a/racket/collects/racket/private/class-c-new.rkt b/racket/collects/racket/private/class-c-new.rkt
index abcb0e5549..754776cbe7 100644
--- a/racket/collects/racket/private/class-c-new.rkt
+++ b/racket/collects/racket/private/class-c-new.rkt
@@ -4,8 +4,6 @@
          "class-wrapped.rkt"
          "../contract/base.rkt"
          "../contract/combinator.rkt"
-         (only-in "../contract/private/guts.rkt"
-                  wrapped-extra-arg-arrow?)
          (for-syntax racket/base
                      syntax/name
                      syntax/stx))
@@ -206,17 +204,14 @@
       (define projd-mth (w/blame m-mth))
       (hash-set! neg-acceptors-ht mth-name projd-mth)
       (define neg-extra-arg
-        (cond
-          [(wrapped-extra-arg-arrow? projd-mth)
-           (wrapped-extra-arg-arrow-extra-neg-party-argument projd-mth)]
-          [else 
-           ;; if some contract doesn't subscribe to the wrapped-extra-arg-arrow
-           ;; protocol, then make an inefficient wrapper for it.
-           (make-keyword-procedure
-            (λ (kwds kwd-args neg-party . args)
-              (keyword-apply (projd-mth neg-party) kwds kwd-args args))
-            (λ (neg-party . args)
-              (apply (projd-mth neg-party) args)))]))
+        ;; the way extra args worked changed so we cannot use it here anymore
+        ;; keep an inefficient wrapper (but maybe this whole approach should
+        ;; go away)
+        (make-keyword-procedure
+         (λ (kwds kwd-args neg-party . args)
+           (keyword-apply (projd-mth neg-party) kwds kwd-args args))
+         (λ (neg-party . args)
+           (apply (projd-mth neg-party) args))))
       (vector-set! neg-extra-arg-vec mth-idx neg-extra-arg)))
   
   (define absent-methods (ext-class/c-contract-absent-methods this))