diff --git a/racket/collects/racket/contract/private/arr-i.rkt b/racket/collects/racket/contract/private/arr-i.rkt
index bd04b22e2e..bd9fbd4382 100644
--- a/racket/collects/racket/contract/private/arr-i.rkt
+++ b/racket/collects/racket/contract/private/arr-i.rkt
@@ -1089,17 +1089,29 @@ evaluted left-to-right.)
 
 (begin-encourage-inline
   (define (un-dep/chaperone orig-ctc obj blame neg-party)
-    (let ([ctc (coerce-contract '->i orig-ctc)])
-      (unless (chaperone-contract? ctc)
-        (raise-argument-error '->i
-                              "chaperone-contract?"
-                              orig-ctc))
-      (((get/build-late-neg-projection ctc) blame) obj neg-party))))
+    (cond
+      [(and (procedure? orig-ctc)
+            (procedure-arity-includes? orig-ctc 1))
+       (if (orig-ctc obj)
+           obj
+           (raise-predicate-blame-error-failure blame obj neg-party
+                                                (object-name orig-ctc)))]
+      [else
+       (define ctc (coerce-chaperone-contract '->i orig-ctc))
+       (((get/build-late-neg-projection ctc) blame) obj neg-party)])))
 
 (begin-encourage-inline
   (define (un-dep orig-ctc obj blame neg-party)
-    (let ([ctc (coerce-contract '->i orig-ctc)])
-      (((get/build-late-neg-projection ctc) blame) obj neg-party))))
+    (cond
+      [(and (procedure? orig-ctc)
+            (procedure-arity-includes? orig-ctc 1))
+       (if (orig-ctc obj)
+           obj
+           (raise-predicate-blame-error-failure blame obj neg-party
+                                                (object-name orig-ctc)))]
+      [else
+       (define ctc (coerce-contract '->i orig-ctc))
+       (((get/build-late-neg-projection ctc) blame) obj neg-party)])))
 
 (define-for-syntax (mk-used-indy-vars an-istx)
   (let ([vars (make-free-identifier-mapping)])
diff --git a/racket/collects/racket/contract/private/guts.rkt b/racket/collects/racket/contract/private/guts.rkt
index 7a8f4ba1fc..b21feca9a6 100644
--- a/racket/collects/racket/contract/private/guts.rkt
+++ b/racket/collects/racket/contract/private/guts.rkt
@@ -74,7 +74,9 @@
 
          contract-first-order-okay-to-give-up?
          contract-first-order-try-less-hard
-         contract-first-order-only-try-so-hard)
+         contract-first-order-only-try-so-hard
+
+         raise-predicate-blame-error-failure)
 
 (define (contract-custom-write-property-proc stct port mode)
   (define (write-prefix)
@@ -617,10 +619,7 @@
         (λ (v neg-party)
           (if (p? v)
               v
-              (raise-blame-error blame v #:missing-party neg-party
-                                 '(expected: "~s" given: "~e")
-                                 name
-                                 v))))))
+              (raise-predicate-blame-error-failure blame v neg-party name))))))
    #:generate (λ (ctc)
                  (let ([generate (predicate-contract-generate ctc)])
                    (cond
@@ -635,6 +634,12 @@
    #:list-contract? (λ (ctc) (or (equal? (predicate-contract-pred ctc) null?)
                                  (equal? (predicate-contract-pred ctc) empty?)))))
 
+(define (raise-predicate-blame-error-failure blame v neg-party predicate-name)
+  (raise-blame-error blame v #:missing-party neg-party
+                     '(expected: "~s" given: "~e")
+                     predicate-name
+                     v))
+
 (define (check-flat-named-contract predicate) (coerce-flat-contract 'flat-named-contract predicate))
 (define (check-flat-contract predicate) (coerce-flat-contract 'flat-contract predicate))
 (define (build-flat-contract name pred [generate #f])