diff --git a/racket/collects/racket/contract/private/arrow-higher-order.rkt b/racket/collects/racket/contract/private/arrow-higher-order.rkt
index 01e0469037..9c1390722c 100644
--- a/racket/collects/racket/contract/private/arrow-higher-order.rkt
+++ b/racket/collects/racket/contract/private/arrow-higher-order.rkt
@@ -154,36 +154,46 @@
                     [(opt-kwd-x ...) (generate-temporaries (map car opt-kwds))]
                     [(rng-late-neg-projs ...) (if rngs rngs '())]
                     [(rng-x ...) (if rngs (generate-temporaries rngs) '())])
-        (with-syntax ([(rng-checker-name ...)
-                       (if rngs
-                           (list (gen-id 'rng-checker))
-                           null)]
-                      [(rng-checker ...)
-                       (if rngs
-                           (list
-                            (with-syntax ([rng-len (length rngs)])
-                              (with-syntax ([rng-results
-                                             #'(values (rng-late-neg-projs rng-x neg-party)
-                                                       ...)])
-                                #'(case-lambda
-                                    [(rng-x ...)
-                                     (with-contract-continuation-mark
-                                      (cons blame neg-party)
-                                      (let ()
-                                        post ...
-                                        rng-results))]
-                                    [args
-                                     (arrow:bad-number-of-results blame val rng-len args
-                                                                  #:missing-party neg-party)]))))
-                           null)])
+
+        (define rng-checker
+          (and rngs
+               (with-syntax ([rng-len (length rngs)]
+                             [rng-results #'(values (rng-late-neg-projs rng-x neg-party) ...)])
+                 #'(case-lambda
+                     [(rng-x ...)
+                      (with-contract-continuation-mark
+                       (cons blame neg-party)
+                       (let ()
+                         post ...
+                         rng-results))]
+                     [args
+                      (arrow:bad-number-of-results blame val rng-len args
+                                                   #:missing-party neg-party)]))))
+        (define (wrap-call-with-values-and-range-checking stx)
+          (if rngs
+              ;; with this version, the unsafe-procedure-chaperone
+              ;; wrappers would work only when the number of values
+              ;; the function returns is known to be a match for
+              ;; what the contract wants.
+              #;
+              #`(let-values ([(rng-x ...) #,stx])
+                  (with-contract-continuation-mark
+                   (cons blame neg-party)
+                   (let ()
+                     post ...
+                     (values (rng-late-neg-projs rng-x neg-party) ...))))
+              #`(call-with-values
+                 (λ () #,stx)
+                 #,rng-checker)
+              stx))
+
           (let* ([min-method-arity (length doms)]
                  [max-method-arity (+ min-method-arity (length opt-doms))]
                  [min-arity (+ (length this-args) min-method-arity)]
                  [max-arity (+ min-arity (length opt-doms))]
                  [req-keywords (map (λ (p) (syntax-e (car p))) req-kwds)]
                  [opt-keywords (map (λ (p) (syntax-e (car p))) opt-kwds)]
-                 [need-apply-values? (or dom-rest (not (null? opt-doms)))]
-                 [no-rng-checking? (not rngs)])
+                 [need-apply? (or dom-rest (not (null? opt-doms)))])
             (with-syntax ([(dom-projd-args ...) #'((dom-ctc dom-x neg-party) ...)]
                           [basic-params
                            (cond
@@ -227,6 +237,7 @@
                              (for/fold ([s #'null])
                                ([tx (in-list (map cdr put-in-reverse))])
                                (tx s)))])
+              
               (with-syntax ([kwd-lam-params
                              (if dom-rest
                                  #'(this-param ...
@@ -239,7 +250,7 @@
                                     kwd-param ...))]
                             [basic-return
                              (let ([inner-stx-gen
-                                    (if need-apply-values?
+                                    (if need-apply?
                                         (λ (s) #`(apply values #,@s 
                                                         this-param ... 
                                                         dom-projd-args ... 
@@ -248,16 +259,41 @@
                                                   #,@s 
                                                   this-param ...
                                                   dom-projd-args ...)))])
-                               (if no-rng-checking?
-                                   (inner-stx-gen #'())
+                               (if rngs
                                    (arrow:check-tail-contract rng-ctcs
                                                               blame-party-info
                                                               neg-party
-                                                              #'(rng-checker-name ...)
-                                                              inner-stx-gen)))]
+                                                              (list rng-checker)
+                                                              inner-stx-gen)
+                                   (inner-stx-gen #'())))]
+                            [basic-unsafe-return
+                             (let ([inner-stx-gen
+                                    (λ (stuff)
+                                      (define the-call/no-marks
+                                        (if need-apply?
+                                            #`(apply val
+                                                     this-param ...
+                                                     dom-projd-args ...
+                                                     opt+rest-uses)
+                                            #`(val this-param ... dom-projd-args ...)))
+                                      (define the-call
+                                        #`(with-continuation-mark arrow:tail-contract-key
+                                            (list* neg-party blame-party-info #,rng-ctcs)
+                                            #,the-call/no-marks))
+                                      (cond
+                                        [(null? (syntax-e stuff)) ;; surely there must a better way
+                                         the-call]
+                                        [else (wrap-call-with-values-and-range-checking the-call)]))])
+                               (if rngs
+                                   (arrow:check-tail-contract rng-ctcs
+                                                              blame-party-info
+                                                              neg-party
+                                                              #'not-a-null
+                                                              inner-stx-gen)
+                                   (inner-stx-gen #'())))]
                             [kwd-return
                              (let* ([inner-stx-gen
-                                     (if need-apply-values?
+                                     (if need-apply?
                                          (λ (s k) #`(apply values 
                                                            #,@s #,@k 
                                                            this-param ...
@@ -275,83 +311,80 @@
                                          (λ (s)
                                            (inner-stx-gen s #'(kwd-results))))])
                                #`(let ([kwd-results kwd-stx])
-                                   #,(if no-rng-checking?
-                                         (outer-stx-gen #'())
+                                   #,(if rngs
                                          (arrow:check-tail-contract rng-ctcs
                                                                     blame-party-info
                                                                     neg-party
-                                                                    #'(rng-checker-name ...)
-                                                                    outer-stx-gen))))])
-                (with-syntax ([basic-lambda-name (gen-id 'basic-lambda)]
-                              [basic-lambda #'(λ basic-params
-                                                ;; Arrow contract domain checking is instrumented
-                                                ;; both here, and in `arity-checking-wrapper'.
-                                                ;; We need to instrument here, because sometimes
-                                                ;; a-c-w doesn't wrap, and just returns us.
-                                                ;; We need to instrument in a-c-w to count arity
-                                                ;; checking time.
-                                                ;; Overhead of double-wrapping has not been
-                                                ;; noticeable in my measurements so far.
-                                                ;;  - stamourv
+                                                                    (list rng-checker)
+                                                                    outer-stx-gen)
+                                         (outer-stx-gen #'()))))])
+
+                ;; Arrow contract domain checking is instrumented
+                ;; both here, and in `arity-checking-wrapper'.
+                ;; We need to instrument here, because sometimes
+                ;; a-c-w doesn't wrap, and just returns us.
+                ;; We need to instrument in a-c-w to count arity
+                ;; checking time.
+                ;; Overhead of double-wrapping has not been
+                ;; noticeable in my measurements so far.
+                ;;  - stamourv
+                (with-syntax ([basic-lambda #'(λ basic-params
                                                 (with-contract-continuation-mark
                                                  (cons blame neg-party)
                                                  (let ()
                                                    pre ... basic-return)))]
+                              [basic-unsafe-lambda #'(λ basic-params
+                                                       (with-contract-continuation-mark
+                                                        (cons blame neg-party)
+                                                        (let ()
+                                                          pre ... basic-unsafe-return)))]
                               [kwd-lambda-name (gen-id 'kwd-lambda)]
                               [kwd-lambda #`(λ kwd-lam-params
                                               (with-contract-continuation-mark
                                                (cons blame neg-party)
                                                (let ()
                                                  pre ... kwd-return)))])
-                  (with-syntax ([(basic-checker-name) (generate-temporaries '(basic-checker))])
-                    (cond
-                      [(and (null? req-keywords) (null? opt-keywords))
-                       #`(let-values ([(rng-checker-name ...) (values rng-checker ...)])
-                           (let ([basic-lambda-name basic-lambda])
-                             (arrow:arity-checking-wrapper val 
-                                                           blame neg-party
-                                                           basic-lambda-name
-                                                           void
-                                                           #,min-method-arity
-                                                           #,max-method-arity
-                                                           #,min-arity
-                                                           #,(if dom-rest #f max-arity)
-                                                           '(req-kwd ...)
-                                                           '(opt-kwd ...))))]
-                      [(pair? req-keywords)
-                       #`(let-values ([(rng-checker-name ...) (values rng-checker ...)])
-                           (let ([kwd-lambda-name kwd-lambda])
-                             (arrow:arity-checking-wrapper val
-                                                           blame neg-party
-                                                           void
-                                                           kwd-lambda-name
-                                                           #,min-method-arity
-                                                           #,max-method-arity
-                                                           #,min-arity
-                                                           #,(if dom-rest #f max-arity)
-                                                           '(req-kwd ...)
-                                                           '(opt-kwd ...))))]
-                      [else
-                       #`(let-values ([(rng-checker-name ...) (values rng-checker ...)])
-                           (let ([basic-lambda-name basic-lambda]
-                                 [kwd-lambda-name kwd-lambda])
-                             (arrow:arity-checking-wrapper val 
-                                                           blame neg-party
-                                                           basic-lambda-name
-                                                           kwd-lambda-name
-                                                           #,min-method-arity
-                                                           #,max-method-arity
-                                                           #,min-arity
-                                                           #,(if dom-rest #f max-arity)
-                                                           '(req-kwd ...)
-                                                           '(opt-kwd ...))))])))))))))))
+                  (cond
+                    [(and (null? req-keywords) (null? opt-keywords))
+                     #`(arrow:arity-checking-wrapper val 
+                                                     blame neg-party
+                                                     basic-lambda basic-unsafe-lambda
+                                                     void
+                                                     #,min-method-arity
+                                                     #,max-method-arity
+                                                     #,min-arity
+                                                     #,(if dom-rest #f max-arity)
+                                                     '(req-kwd ...)
+                                                     '(opt-kwd ...))]
+                    [(pair? req-keywords)
+                     #`(arrow:arity-checking-wrapper val
+                                                     blame neg-party
+                                                     void #t
+                                                     kwd-lambda
+                                                     #,min-method-arity
+                                                     #,max-method-arity
+                                                     #,min-arity
+                                                     #,(if dom-rest #f max-arity)
+                                                     '(req-kwd ...)
+                                                     '(opt-kwd ...))]
+                    [else
+                     #`(arrow:arity-checking-wrapper val 
+                                                     blame neg-party
+                                                     basic-lambda #t
+                                                     kwd-lambda
+                                                     #,min-method-arity
+                                                     #,max-method-arity
+                                                     #,min-arity
+                                                     #,(if dom-rest #f max-arity)
+                                                     '(req-kwd ...)
+                                                     '(opt-kwd ...))])))))))))
 
 (define (maybe-cons-kwd c x r neg-party)
   (if (eq? arrow:unspecified-dom x)
       r
       (cons (c x neg-party) r)))
 
-(define (->-proj chaperone-or-impersonate-procedure ctc
+(define (->-proj chaperone? ctc
                  ;; fields of the 'ctc' struct
                  min-arity doms kwd-infos rest pre? rngs post?
                  plus-one-arity-function chaperone-constructor
@@ -414,10 +447,15 @@
               (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 chap/imp-func (apply chaperone-constructor
-                                   orig-blame val
-                                   neg-party blame-party-info
-                                   rngs the-args))
+      (define-values (chap/imp-func use-unsafe-chaperone-procedure?)
+        (apply chaperone-constructor
+               orig-blame val
+               neg-party blame-party-info
+               rngs the-args))
+      (define chaperone-or-impersonate-procedure
+        (if use-unsafe-chaperone-procedure?
+            (if chaperone? unsafe-chaperone-procedure unsafe-impersonate-procedure)
+            (if chaperone? chaperone-procedure impersonate-procedure)))
       (cond
         [chap/imp-func
          (if (or post? (not rngs))
diff --git a/racket/collects/racket/contract/private/arrow-val-first.rkt b/racket/collects/racket/contract/private/arrow-val-first.rkt
index 32497e22c2..3198fa358e 100644
--- a/racket/collects/racket/contract/private/arrow-val-first.rkt
+++ b/racket/collects/racket/contract/private/arrow-val-first.rkt
@@ -962,11 +962,12 @@
                     (cons result-checker args-dealt-with)
                     args-dealt-with)))))
           
-          (arrow:arity-checking-wrapper f blame neg-party
-                                        interposition-proc interposition-proc
-                                        min-arity max-arity
-                                        min-arity max-arity 
-                                        mandatory-keywords optional-keywords))))
+          (values (arrow:arity-checking-wrapper f blame neg-party
+                                                interposition-proc #f interposition-proc
+                                                min-arity max-arity
+                                                min-arity max-arity 
+                                                mandatory-keywords optional-keywords)
+                  #f))))
   
   (build--> 'dynamic->*
             mandatory-domain-contracts optional-domain-contracts 
@@ -1159,11 +1160,13 @@
        (arrow:keywords-match man-kwds opt-kwds x)
        #t))
 
-(define (make-property build-X-property chaperone-or-impersonate-procedure)
+(define (make-property chaperone?)
+  (define build-X-property
+    (if chaperone? build-chaperone-contract-property build-contract-property))
   (define val-first-proj
     (λ (->stct)
       (maybe-warn-about-val-first ->stct)
-      (->-proj chaperone-or-impersonate-procedure ->stct
+      (->-proj chaperone? ->stct
                (base->-min-arity ->stct)
                (base->-doms ->stct)
                (base->-kwd-infos ->stct)
@@ -1176,7 +1179,7 @@
                #f)))
   (define late-neg-proj
     (λ (->stct)
-      (->-proj chaperone-or-impersonate-procedure ->stct
+      (->-proj chaperone? ->stct
                (base->-min-arity ->stct)
                (base->-doms ->stct)
                (base->-kwd-infos ->stct)
@@ -1227,19 +1230,13 @@
        (not (base->-post? that))))
      
 (define-struct (-> base->) ()
-  #:property
-  prop:chaperone-contract
-  (make-property build-chaperone-contract-property chaperone-procedure))
+  #:property prop:chaperone-contract (make-property #t))
 
 (define-struct (predicate/c base->) ()
-  #:property
-  prop:chaperone-contract
-  (make-property build-chaperone-contract-property chaperone-procedure))
+  #:property prop:chaperone-contract (make-property #t))
 
 (define-struct (impersonator-> base->) ()
-  #:property
-  prop:contract
-  (make-property build-contract-property impersonate-procedure))
+  #:property prop:contract (make-property #f))
 
 (define ->void-contract
   (let-syntax ([get-chaperone-constructor
@@ -1303,25 +1300,27 @@
                     '(expected: "a procedure that accepts 1 non-keyword argument"
                                 given: "~e")
                     f))
-                 (cond
-                   [(and (struct-predicate-procedure? f)
-                         (not (impersonator? f)))
-                    #f]
-                   [(and (equal? (procedure-arity f) 1)
-                         (let-values ([(required mandatory) (procedure-keywords f)])
-                           (and (null? required)
-                                (null? mandatory))))
-                    (λ (arg)
-                      (values (rng-checker f blame neg-party) arg))]
-                   [(procedure-arity-includes? f 1)
-                    (make-keyword-procedure
-                     (λ (kwds kwd-args . other)
-                       (unless (null? kwds)
-                         (arrow:raise-no-keywords-arg blame #:missing-party neg-party f kwds))
-                       (unless (= 1 (length other))
-                         (arrow:raise-wrong-number-of-args-error #:missing-party neg-party
-                                                                 blame f (length other) 1 1 1))
-                       (values (rng-checker f blame neg-party) (car other))))]))))
+                 (values (cond
+                           [(and (struct-predicate-procedure? f)
+                                 (not (impersonator? f)))
+                            #f]
+                           [(and (equal? (procedure-arity f) 1)
+                                 (let-values ([(required mandatory) (procedure-keywords f)])
+                                   (and (null? required)
+                                        (null? mandatory))))
+                            (λ (arg)
+                              (values (rng-checker f blame neg-party) arg))]
+                           [(procedure-arity-includes? f 1)
+                            (make-keyword-procedure
+                             (λ (kwds kwd-args . other)
+                               (unless (null? kwds)
+                                 (arrow:raise-no-keywords-arg blame #:missing-party neg-party f kwds))
+                               (unless (= 1 (length other))
+                                 (arrow:raise-wrong-number-of-args-error
+                                  #:missing-party neg-party
+                                  blame f (length other) 1 1 1))
+                               (values (rng-checker f blame neg-party) (car other))))])
+                         #f))))
 
 (define -predicate/c (mk-any/c->boolean-contract predicate/c))
 (define any/c->boolean-contract (mk-any/c->boolean-contract make-->))
diff --git a/racket/collects/racket/contract/private/arrow.rkt b/racket/collects/racket/contract/private/arrow.rkt
index 384784b4a1..b1ddfbb09d 100644
--- a/racket/collects/racket/contract/private/arrow.rkt
+++ b/racket/collects/racket/contract/private/arrow.rkt
@@ -398,7 +398,7 @@
                        #`(let-values ([(rng-checker-name ...) (values/drop rng-checker ...)])
                            (let ([basic-lambda-name basic-lambda])
                              (arity-checking-wrapper val blame neg-party
-                                                     basic-lambda-name
+                                                     basic-lambda-name #f
                                                      void
                                                      #,min-method-arity
                                                      #,max-method-arity
@@ -410,7 +410,7 @@
                        #`(let-values ([(rng-checker-name ...) (values/drop rng-checker ...)])
                            (let ([kwd-lambda-name kwd-lambda])
                              (arity-checking-wrapper val blame neg-party
-                                                     void
+                                                     void #f
                                                      kwd-lambda-name
                                                      #,min-method-arity
                                                      #,max-method-arity
@@ -423,7 +423,7 @@
                            (let ([basic-lambda-name basic-lambda]
                                  [kwd-lambda-name kwd-lambda])
                              (arity-checking-wrapper val blame neg-party
-                                                     basic-lambda-name
+                                                     basic-lambda-name #f
                                                      kwd-lambda-name
                                                      #,min-method-arity
                                                      #,max-method-arity
@@ -433,15 +433,25 @@
                                                      '(opt-kwd ...))))])))))))))))
 
 ;; should we pass both the basic-lambda and the kwd-lambda?
-(define (arity-checking-wrapper val blame neg-party basic-lambda kwd-lambda
+;; if basic-unsafe-lambda is #f, returns only the one value,
+;; namely the chaperone wrapper. Otherwise, returns two values,
+;; a procedure and a boolean indicating it the procedure is the
+;; basic-unsafe-lambda or not; note that basic-unsafe-lambda might
+;; also be #f, but that happens only when we know that basic-lambda
+;; can't be chosen (because there are keywords involved)
+(define (arity-checking-wrapper val blame neg-party basic-lambda basic-unsafe-lambda kwd-lambda
                                 min-method-arity max-method-arity min-arity max-arity 
                                 req-kwd opt-kwd)
   ;; should not build this unless we are in the 'else' case (and maybe not at all)
   (cond
     [(matches-arity-exactly? val min-arity max-arity req-kwd opt-kwd)
-     (if (and (null? req-kwd) (null? opt-kwd)) 
-         basic-lambda
-         kwd-lambda)]
+     (if (and (null? req-kwd) (null? opt-kwd))
+         (if basic-unsafe-lambda
+             (values basic-unsafe-lambda #t)
+             basic-lambda)
+         (if basic-unsafe-lambda
+             (values kwd-lambda #f)
+             kwd-lambda))]
     [else
      (define-values (vr va) (procedure-keywords val))
      (define all-kwds (append req-kwd opt-kwd))
@@ -493,9 +503,13 @@
              (raise-blame-error (blame-swap blame) #:missing-party neg-party val
                                 "expected required keyword ~a"
                                 (car req-kwd)))))
-     (if (or (not va) (pair? vr) (pair? va))
-         (make-keyword-procedure kwd-checker basic-checker-name)
-         basic-checker-name)]))
+     (define proc
+       (if (or (not va) (pair? vr) (pair? va))
+           (make-keyword-procedure kwd-checker basic-checker-name)
+           basic-checker-name))
+     (if basic-unsafe-lambda
+         (values proc #f)
+         proc)]))
 
 (define (raise-wrong-number-of-args-error
          blame #:missing-party [missing-party #f] val