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 43bc166f8a..e9583fa296 100644
--- a/pkgs/racket-test/tests/racket/contract/arrow-neg-party.rkt
+++ b/pkgs/racket-test/tests/racket/contract/arrow-neg-party.rkt
@@ -270,4 +270,19 @@
       (->* (any/c) (#:kw any/c) any)
       (λ (x #:kw [kw 0]) x))
      'neg 42)
-   42))
+   42)
+
+  (test/pos-blame
+   '->neg-party23
+   '((neg-party-fn
+      (-> any/c boolean?)
+      (λ (x) 1))
+     'neg 1))
+
+  (test/spec-passed/result
+   '->neg-party24
+   '((neg-party-fn
+      (-> any/c boolean?)
+      (λ (x) #t))
+     'neg 1)
+   #t))
diff --git a/pkgs/racket-test/tests/racket/contract/arrow.rkt b/pkgs/racket-test/tests/racket/contract/arrow.rkt
index 4876bc1233..8191ff0f9b 100644
--- a/pkgs/racket-test/tests/racket/contract/arrow.rkt
+++ b/pkgs/racket-test/tests/racket/contract/arrow.rkt
@@ -353,6 +353,30 @@
   (test/spec-passed
    'predicate/c4
    '((contract predicate/c (λ (x) #t) 'pos 'neg) 12))
+  (test/spec-passed/result
+   'predicate/c5
+   '(let ()
+      (struct s ())
+      (eq? (contract (-> any/c boolean?) s? 'pos 'neg) s?))
+   #t)
+  (test/spec-passed/result
+   'predicate/c6
+   '(let ()
+      (struct s ())
+      (eq? (contract predicate/c s? 'pos 'neg) s?))
+   #t)
+  (test/pos-blame
+   'predicate/c7
+   '(contract (-> any/c boolean?) 1 'pos 'neg))
+  (test/pos-blame
+   'predicate/c8
+   '(contract (-> any/c boolean?) (λ (x y) 1) 'pos 'neg))
+  (test/pos-blame
+   'predicate/c9
+   '((contract (-> any/c boolean?) (λ (x) 1) 'pos 'neg) 12))
+  (test/spec-passed
+   'predicate/c10
+   '((contract (-> any/c boolean?) (λ (x) #t) 'pos 'neg) 12))
   
   ;; this test ensures that no contract wrappers
   ;; are created for struct predicates
diff --git a/pkgs/racket-test/tests/racket/contract/name.rkt b/pkgs/racket-test/tests/racket/contract/name.rkt
index a077488eb7..4c93ca5860 100644
--- a/pkgs/racket-test/tests/racket/contract/name.rkt
+++ b/pkgs/racket-test/tests/racket/contract/name.rkt
@@ -47,6 +47,8 @@
              (->* (integer? boolean?) () (values char? any/c)))
   (test-name '(-> integer? boolean? any) (->* (integer? boolean?) () any))
   (test-name '(-> integer? boolean? #:x string? any) (-> integer? #:x string? boolean? any))
+  (test-name '(-> any/c boolean?) (-> any/c boolean?))
+  (test-name 'predicate/c predicate/c)
 
   (test-name '(->* (integer?) (string?) #:rest any/c (values char? any/c))
               (->* (integer?) (string?) #:rest any/c (values char? any/c)))
diff --git a/racket/collects/racket/contract/base.rkt b/racket/collects/racket/contract/base.rkt
index d0d34b5ed1..3992d7610a 100644
--- a/racket/collects/racket/contract/base.rkt
+++ b/racket/collects/racket/contract/base.rkt
@@ -35,6 +35,7 @@
              -> ->*)
  (rename-out [->2 ->] [->*2 ->*])
  dynamic->*
+ predicate/c
  
  (all-from-out "private/arr-i.rkt"
                "private/box.rkt"
diff --git a/racket/collects/racket/contract/private/arrow-higher-order.rkt b/racket/collects/racket/contract/private/arrow-higher-order.rkt
index f8b8f4ae64..bcff1fc39d 100644
--- a/racket/collects/racket/contract/private/arrow-higher-order.rkt
+++ b/racket/collects/racket/contract/private/arrow-higher-order.rkt
@@ -406,20 +406,23 @@
 
     (define (successfully-got-the-right-kind-of-function val neg-party)
       (define chap/imp-func (apply chaperone-constructor orig-blame val neg-party the-args))
-      (if post?
-          (chaperone-or-impersonate-procedure
-           val
-           chap/imp-func
-           impersonator-prop:contracted ctc
-           impersonator-prop:blame (blame-add-missing-party orig-blame neg-party))
-          (chaperone-or-impersonate-procedure
-           val
-           chap/imp-func
-           impersonator-prop:contracted ctc
-           impersonator-prop:blame (blame-add-missing-party orig-blame neg-party)
-           impersonator-prop:application-mark (cons arrow:contract-key 
-                                                    ;; is this right?
-                                                    partial-ranges))))
+      (cond
+        [chap/imp-func
+         (if post?
+             (chaperone-or-impersonate-procedure
+              val
+              chap/imp-func
+              impersonator-prop:contracted ctc
+              impersonator-prop:blame (blame-add-missing-party orig-blame neg-party))
+             (chaperone-or-impersonate-procedure
+              val
+              chap/imp-func
+              impersonator-prop:contracted ctc
+              impersonator-prop:blame (blame-add-missing-party orig-blame neg-party)
+              impersonator-prop:application-mark (cons arrow:contract-key 
+                                                       ;; is this right?
+                                                       partial-ranges)))]
+        [else val]))
     
     (cond
       [late-neg?
diff --git a/racket/collects/racket/contract/private/arrow-val-first.rkt b/racket/collects/racket/contract/private/arrow-val-first.rkt
index c77351bd24..bac9983107 100644
--- a/racket/collects/racket/contract/private/arrow-val-first.rkt
+++ b/racket/collects/racket/contract/private/arrow-val-first.rkt
@@ -18,10 +18,11 @@
          (for-syntax ->2-handled?
                      ->*2-handled?
                      ->-valid-app-shapes
-                     ->*-valid-app-shapes))
+                     ->*-valid-app-shapes)
+         (rename-out [-predicate/c predicate/c]))
 
 (define-for-syntax (->2-handled? stx)
-  (syntax-case stx (any values any/c)
+  (syntax-case stx (any values any/c boolean?)
     [(_ args ...)
      (syntax-parameter-value #'arrow:making-a-method)
      #f]
@@ -781,6 +782,18 @@
           (flat-contract? (car rngs))
           (eq? void? (flat-contract-predicate (car rngs))))
      ->void-contract]
+    [(and (pair? regular-doms)
+          (null? (cdr regular-doms))
+          (any/c? (car regular-doms))
+          (null? kwd-infos)
+          (not rest-ctc)
+          (not pre-cond)
+          (not post-cond)
+          (pair? rngs)
+          (null? (cdr rngs))
+          (flat-contract? (car rngs))
+          (eq? boolean? (flat-contract-predicate (car rngs))))
+     any/c->boolean-contract]
     [(and (andmap chaperone-contract? regular-doms)
           (andmap (λ (x) (chaperone-contract? (kwd-info-ctc x))) kwd-infos)
           (andmap chaperone-contract? (or rngs '())))
@@ -1061,62 +1074,65 @@
      (λ (fuel) (values void '()))]))
 
 (define (base->-name ctc)
-  (define rngs (base->-rngs ctc))
-  (define rng-sexp
-    (cond
-      [(not rngs) 'any]
-      [(= 1 (length rngs))
-       (contract-name (car rngs))]
-      [else
-       `(values ,@(map contract-name rngs))]))
   (cond
-    [(and (andmap kwd-info-mandatory? (base->-kwd-infos ctc))
-          (= (base->-min-arity ctc)
-             (length (base->-doms ctc)))
-          (not (base->-rest ctc))
-          (not (base->-pre? ctc))
-          (not (base->-post? ctc)))
-     `(-> ,@(map contract-name (base->-doms ctc))
-          ,@(apply
-             append
-             (for/list ([kwd-info (base->-kwd-infos ctc)])
-               (list (kwd-info-kwd kwd-info) 
-                     (contract-name (kwd-info-ctc kwd-info)))))
-          ,rng-sexp)]
+    [(predicate/c? ctc) 'predicate/c]
     [else
-     (define (take l n) (reverse (list-tail (reverse l) (- (length l) n))))
-     (define mandatory-args
-       `(,@(map contract-name (take (base->-doms ctc) (base->-min-arity ctc)))
-         ,@(apply
-            append
-            (for/list ([kwd-info (base->-kwd-infos ctc)]
-                       #:when (kwd-info-mandatory? kwd-info))
-              (list (kwd-info-kwd kwd-info) 
-                    (contract-name (kwd-info-ctc kwd-info)))))))
-     
-     (define optional-args
-       `(,@(map contract-name (list-tail (base->-doms ctc) (base->-min-arity ctc)))
-         ,@(apply
-            append
-            (for/list ([kwd-info (base->-kwd-infos ctc)]
-                       #:when (not (kwd-info-mandatory? kwd-info)))
-              (list (kwd-info-kwd kwd-info) 
-                    (contract-name (kwd-info-ctc kwd-info)))))))
-     
-     `(->* ,mandatory-args 
-           ,@(if (null? optional-args)
-                 '()
-                 (list optional-args))
-           ,@(if (base->-rest ctc)
-                 (list '#:rest (contract-name (base->-rest ctc)))
-                 (list))
-           ,@(if (base->-pre? ctc)
-                 (list '#:pre '...)
-                 (list))
-           ,rng-sexp
-           ,@(if (base->-post? ctc)
-                 (list '#:post '...)
-                 (list)))]))
+     (define rngs (base->-rngs ctc))
+     (define rng-sexp
+       (cond
+         [(not rngs) 'any]
+         [(= 1 (length rngs))
+          (contract-name (car rngs))]
+         [else
+          `(values ,@(map contract-name rngs))]))
+     (cond
+       [(and (andmap kwd-info-mandatory? (base->-kwd-infos ctc))
+             (= (base->-min-arity ctc)
+                (length (base->-doms ctc)))
+             (not (base->-rest ctc))
+             (not (base->-pre? ctc))
+             (not (base->-post? ctc)))
+        `(-> ,@(map contract-name (base->-doms ctc))
+             ,@(apply
+                append
+                (for/list ([kwd-info (base->-kwd-infos ctc)])
+                  (list (kwd-info-kwd kwd-info)
+                        (contract-name (kwd-info-ctc kwd-info)))))
+             ,rng-sexp)]
+       [else
+        (define (take l n) (reverse (list-tail (reverse l) (- (length l) n))))
+        (define mandatory-args
+          `(,@(map contract-name (take (base->-doms ctc) (base->-min-arity ctc)))
+            ,@(apply
+               append
+               (for/list ([kwd-info (base->-kwd-infos ctc)]
+                          #:when (kwd-info-mandatory? kwd-info))
+                 (list (kwd-info-kwd kwd-info) 
+                       (contract-name (kwd-info-ctc kwd-info)))))))
+        
+        (define optional-args
+          `(,@(map contract-name (list-tail (base->-doms ctc) (base->-min-arity ctc)))
+            ,@(apply
+               append
+               (for/list ([kwd-info (base->-kwd-infos ctc)]
+                          #:when (not (kwd-info-mandatory? kwd-info)))
+                 (list (kwd-info-kwd kwd-info) 
+                       (contract-name (kwd-info-ctc kwd-info)))))))
+        
+        `(->* ,mandatory-args
+              ,@(if (null? optional-args)
+                    '()
+                    (list optional-args))
+              ,@(if (base->-rest ctc)
+                    (list '#:rest (contract-name (base->-rest ctc)))
+                    (list))
+              ,@(if (base->-pre? ctc)
+                    (list '#:pre '...)
+                    (list))
+              ,rng-sexp
+              ,@(if (base->-post? ctc)
+                    (list '#:post '...)
+                    (list)))])]))
 
 (define ((->-first-order ctc) x)
   (define l (base->-min-arity ctc))
@@ -1204,6 +1220,11 @@
   prop:chaperone-contract
   (make-property build-chaperone-contract-property chaperone-procedure))
 
+(define-struct (predicate/c base->) ()
+  #:property
+  prop:chaperone-contract
+  (make-property build-chaperone-contract-property chaperone-procedure))
+
 (define-struct (impersonator-> base->) ()
   #:property
   prop:contract
@@ -1212,8 +1233,11 @@
 (define ->void-contract
   (let-syntax ([get-chaperone-constructor
                 (λ (_)
-                  ;; relies on the popular key (0 0 () () #f 1) appearing first
-                  (define ids (list-ref popular-key-ids 0))
+                  (define desired-key '(0 0 () () #f 1))
+                  (define expected-index 0)
+                  (unless (equal? desired-key (list-ref popular-keys expected-index))
+                    (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
              (list (coerce-contract 'whatever void?))
@@ -1232,3 +1256,51 @@
                     [args
                      (wrong-number-of-results-blame blame neg-party f args 1)]))))
              (get-chaperone-constructor))))
+
+(define (mk-any/c->boolean-contract constructor)
+  (define (rng-checker f blame neg-party)
+    (case-lambda
+      [(rng)
+       (if (boolean? rng)
+           rng
+           (raise-blame-error blame #:missing-party neg-party rng
+                              '(expected: "boolean?" given: "~e")
+                              rng))]
+      [args
+       (wrong-number-of-results-blame blame neg-party f args 1)]))
+  (constructor 1 (list any/c) '() #f #f
+               (list (coerce-contract 'whatever boolean?))
+               #f
+               (λ (blame f _ignored-dom-contract _ignored-rng-contract)
+                 (λ (neg-party argument)
+                   (call-with-values
+                    (λ () (f argument))
+                    (rng-checker f blame neg-party))))
+               (λ (blame f neg-party _ignored-dom-contract _ignored-rng-contract)
+                 (unless (procedure? f)
+                   (raise-blame-error
+                    blame #:missing-party neg-party f
+                    '(expected: "a procedure" given: "~e")
+                    f))
+                 (unless (procedure-arity-includes? f 1)
+                   (raise-blame-error
+                    blame #:missing-party neg-party f
+                    '(expected: "a procedure that accepts 1 non-keyword argument"
+                                given: "~e")
+                    f))
+                 (cond
+                   [(struct-predicate-procedure? f) #f]
+                   [(equal? (procedure-arity f) 1)
+                    (λ (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 f kwds))
+                       (unless (= 1 (length other))
+                         (arrow:raise-wrong-number-of-args-error blame f (length other) 1 1 1))
+                       (values (rng-checker f blame neg-party) '() (car other))))]))))
+
+(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 8f0202189c..6d25281615 100644
--- a/racket/collects/racket/contract/private/arrow.rkt
+++ b/racket/collects/racket/contract/private/arrow.rkt
@@ -21,7 +21,6 @@
          base->-doms/c
          unconstrained-domain->
          the-unsupplied-arg
-         (rename-out [-predicate/c predicate/c])
          unsupplied-arg?
          making-a-method
          method-contract?
@@ -40,7 +39,9 @@
          arity-checking-wrapper
          unspecified-dom
          blame-add-range-context
-         blame-add-nth-arg-context)
+         blame-add-nth-arg-context
+         raise-no-keywords-arg
+         raise-wrong-number-of-args-error)
 
 (define-syntax-parameter making-a-method #f)
 (define-syntax-parameter method-contract? #f)
@@ -394,16 +395,6 @@
          basic-lambda
          kwd-lambda)]
     [else
-     (define arity-string 
-       (if max-arity
-           (cond
-             [(= min-method-arity max-method-arity)
-              (format "~a non-keyword argument~a" min-method-arity (if (= min-method-arity 1) "" "s"))]
-             [(= (+ min-method-arity 1) max-method-arity) 
-              (format "~a or ~a non-keyword arguments" min-method-arity max-method-arity)]
-             [else
-              (format "~a to ~a non-keyword arguments" min-method-arity max-method-arity)])
-           (format "at least ~a non-keyword argument~a" min-method-arity (if (= min-method-arity 1) "" "s"))))
      (define-values (vr va) (procedure-keywords val))
      (define all-kwds (append req-kwd opt-kwd))
      (define (valid-number-of-args? args)
@@ -413,31 +404,16 @@
      (define kwd-checker
        (if (and (null? req-kwd) (null? opt-kwd))
            (λ (kwds kwd-args . args)
-             (raise-blame-error (blame-swap blame) val
-                                (list 'expected:
-                                      "no keywords"
-                                      'given:
-                                      (apply
-                                       string-append
-                                       (let loop ([kwds kwds])
-                                         (cond
-                                           [(null? kwds) '()]
-                                           [(null? (cdr kwds))
-                                            (list "#:" (keyword->string (car kwds)))]
-                                           [else
-                                            (list* "#:"
-                                                   (keyword->string (car kwds))
-                                                   " "
-                                                   (loop (cdr kwds)))]))))))
+             (raise-no-keywords-arg blame val kwds))
            (λ (kwds kwd-args . args)
              (with-continuation-mark
               contract-continuation-mark-key blame
               (let ()
              (define args-len (length args))
              (unless (valid-number-of-args? args)
-               (raise-blame-error (blame-swap blame) val
-                                  '(received: "~a argument~a" expected: "~a")
-                                  args-len (if (= args-len 1) "" "s") arity-string))
+               (raise-wrong-number-of-args-error
+                blame val
+                args-len max-arity min-method-arity max-method-arity))
              
              ;; these two for loops are doing O(n^2) work that could be linear 
              ;; (since the keyword lists are sorted)
@@ -460,9 +436,9 @@
               (let ()
              (unless (valid-number-of-args? args)
                (define args-len (length args))
-               (raise-blame-error (blame-swap blame) val
-                                  '(received: "~a argument~a" expected: "~a")
-                                  args-len (if (= args-len 1) "" "s") arity-string))
+               (raise-wrong-number-of-args-error
+                blame val
+                args-len max-arity min-method-arity max-method-arity))
              (apply basic-lambda args))))
            (λ args
              (raise-blame-error (blame-swap blame) val
@@ -472,6 +448,41 @@
          (make-keyword-procedure kwd-checker basic-checker-name)
          basic-checker-name)]))
 
+(define (raise-wrong-number-of-args-error
+         blame val
+         args-len max-arity min-method-arity max-method-arity)
+  (define arity-string 
+    (if max-arity
+        (cond
+          [(= min-method-arity max-method-arity)
+           (format "~a non-keyword argument~a" min-method-arity (if (= min-method-arity 1) "" "s"))]
+          [(= (+ min-method-arity 1) max-method-arity) 
+           (format "~a or ~a non-keyword arguments" min-method-arity max-method-arity)]
+          [else
+           (format "~a to ~a non-keyword arguments" min-method-arity max-method-arity)])
+        (format "at least ~a non-keyword argument~a" min-method-arity (if (= min-method-arity 1) "" "s"))))
+  (raise-blame-error (blame-swap blame) val
+                     '(received: "~a argument~a" expected: "~a")
+                     args-len (if (= args-len 1) "" "s") arity-string))
+
+(define (raise-no-keywords-arg blame val given-kwds)
+  (raise-blame-error (blame-swap blame) val
+                     (list 'expected:
+                           "no keywords"
+                           'given:
+                           (apply
+                            string-append
+                            (let loop ([kwds given-kwds])
+                              (cond
+                                [(null? kwds) '()]
+                                [(null? (cdr kwds))
+                                 (list "#:" (keyword->string (car kwds)))]
+                                [else
+                                 (list* "#:"
+                                        (keyword->string (car kwds))
+                                        " "
+                                        (loop (cdr kwds)))]))))))
+
 ;; pre : (or/c #f (-> any)) -- checks the pre-condition, if there is one.
 ;; post : (or/c #f (-> any)) -- checks the post-condition, if there is one.
 ;; doms : (listof contract)
@@ -1822,34 +1833,6 @@
      (λ (x) (send o m x)))))
 
 
-(define predicate/c-private->ctc
-  (let-syntax ([m (λ (stx)
-                    ;; we don't use -> directly here to avoid a circularity, since
-                    ;; (-> any/c boolean?) expands into the identifier -predicate/c
-                    (syntax-case stx ()
-                      [(_ arg)
-                       #`(syntax-parameterize ((making-a-method #f)) #,(->/proc/main #'arg))]))])
-    (let ([predicate/c (m (-> any/c boolean?))])
-      predicate/c)))
-
-(struct predicate/c ()
-  #:property prop:custom-write custom-write-property-proc
-  #:property prop:chaperone-contract
-  (build-chaperone-contract-property
-   #:projection (let ([pc (contract-struct-projection predicate/c-private->ctc)])
-                  (λ (ctc)
-                    (λ (blame)
-                      (let ([proj (pc blame)])
-                        (λ (val)
-                          (if (struct-predicate-procedure? val)
-                              val
-                              (proj val)))))))
-   #:name (lambda (ctc) 'predicate/c)
-   #:first-order (let ([f (contract-struct-first-order predicate/c-private->ctc)]) (λ (ctc) f))
-   #:stronger (λ (this that) (contract-struct-stronger? predicate/c-private->ctc that))))
-
-(define -predicate/c (predicate/c))
-
 (define-syntax (-> stx) 
   (syntax-case stx (any any/c boolean?)
     [(_ any/c ... any)
@@ -1860,10 +1843,6 @@
           '(-> #,@(build-list dom-len (λ (x) 'any/c)) any)
           (λ (x) 
             (procedure-arity-includes?/no-kwds x #,dom-len))))]
-    [(_ any/c boolean?)
-     ;; special case (-> any/c boolean?) to use predicate/c
-     (not (syntax-parameter-value #'making-a-method))
-     #'-predicate/c]
     [_
      #`(syntax-parameterize ((making-a-method #f)) #,(->/proc/main stx))]))
 
diff --git a/racket/collects/racket/contract/private/misc.rkt b/racket/collects/racket/contract/private/misc.rkt
index 2adcd4cedb..7477a0e1aa 100644
--- a/racket/collects/racket/contract/private/misc.rkt
+++ b/racket/collects/racket/contract/private/misc.rkt
@@ -32,7 +32,7 @@
          parameter/c
          procedure-arity-includes/c
          
-         any/c
+         any/c  any/c?
          any
          none/c
          make-none/c
diff --git a/racket/collects/racket/contract/private/opters.rkt b/racket/collects/racket/contract/private/opters.rkt
index 763f8677f2..14d849abee 100644
--- a/racket/collects/racket/contract/private/opters.rkt
+++ b/racket/collects/racket/contract/private/opters.rkt
@@ -434,7 +434,7 @@
     [(_ content) (opt/listof-ctc #'content #t opt/i opt/info)]))
 
 
-(define-for-syntax (predicate/c-optres opt/info)
+(define-for-syntax (predicate/c-optres opt/info has-name-predicate/c?)
   (build-optres
    #:exp
    (with-syntax ((val (opt/info-val opt/info))
@@ -472,7 +472,9 @@
    #:opt #f
    #:stronger-ribs null
    #:chaperone #t
-   #:name #''predicate/c))
+   #:name (if has-name-predicate/c?
+              #''predicate/c
+              #''(-> any/c boolean?))))
 
 ;;
 ;; arrow opter
@@ -698,7 +700,7 @@
         #:chaperone #t
         #:name #`'(-> #,@(build-list (syntax-e #'n) (λ (x) 'any/c)) any)))]
     [(_ any/c boolean?)
-     (predicate/c-optres opt/info)]
+     (predicate/c-optres opt/info #f)]
     [(_ dom ... (values rng ...))
      (if (ormap (λ (x) (keyword? (syntax-e x))) (syntax->list #'(dom ...)))
          (opt/unknown opt/i opt/info stx) ;; give up if there is a mandatory keyword 
@@ -737,7 +739,7 @@
 
 (define opt->/c-cm-key (gensym 'opt->/c-cm-key))
 
-(define/opter (predicate/c opt/i opt/info stx) (predicate/c-optres opt/info))
+(define/opter (predicate/c opt/i opt/info stx) (predicate/c-optres opt/info #t))
 
 (define (handle-non-exact-procedure val dom-len blame exact-proc)
   (check-procedure val #f dom-len 0 '() '() blame)