diff --git a/collects/racket/function.rkt b/collects/racket/function.rkt index ad34a29b9a..a5deb1a183 100644 --- a/collects/racket/function.rkt +++ b/collects/racket/function.rkt @@ -83,8 +83,6 @@ (define curryr (make-curry #t)) (define (normalized-arity? a) - (unless (procedure-arity? a) - (raise-argument-error 'normalized-arity? "procedure-arity?" a)) (or (null? a) (arity? a) (and (list? a) @@ -160,7 +158,7 @@ (for/and {[i (in-range n min-at-least)]} (arity-supports-number? arity i))])])) -(define (arity-includes? one two) +(define (unchecked-arity-includes? one two) (cond [(exact-nonnegative-integer? two) (arity-supports-number? one two)] @@ -168,7 +166,20 @@ (arity-supports-at-least? one (arity-at-least-value two))] [(list? two) (for/and {[elem (in-list two)]} - (arity-includes? one elem))])) + (unchecked-arity-includes? one elem))])) + +(define (arity-includes? one two) + (unless (procedure-arity? one) + (raise-argument-error 'arity-includes? "procedure-arity?" 0 one two)) + (unless (procedure-arity? two) + (raise-argument-error 'arity-includes? "procedure-arity?" 1 one two)) + (unchecked-arity-includes? one two)) (define (arity=? one two) - (and (arity-includes? one two) (arity-includes? two one))) + (unless (procedure-arity? one) + (raise-argument-error 'arity=? "procedure-arity?" 0 one two)) + (unless (procedure-arity? two) + (raise-argument-error 'arity=? "procedure-arity?" 1 one two)) + (and + (unchecked-arity-includes? one two) + (unchecked-arity-includes? two one))) diff --git a/collects/racket/private/norm-arity.rkt b/collects/racket/private/norm-arity.rkt index 8ef8de12a7..246b7f8abd 100644 --- a/collects/racket/private/norm-arity.rkt +++ b/collects/racket/private/norm-arity.rkt @@ -37,6 +37,8 @@ ;; - if there is only one possibility, it is returned by itself (ie, ;; not in a list) (define (normalize-arity arity) + (unless (procedure-arity? arity) + (raise-argument-error 'normalize-arity "procedure-arity?" arity)) (if (pair? arity) (let* ([reversed (reverse-sort-arity arity)] [normalized (normalize-reversed-arity reversed '())] diff --git a/collects/scribblings/reference/procedures.scrbl b/collects/scribblings/reference/procedures.scrbl index 69756be16b..aa7692132f 100644 --- a/collects/scribblings/reference/procedures.scrbl +++ b/collects/scribblings/reference/procedures.scrbl @@ -126,8 +126,7 @@ the @exnraise[exn:fail:contract]. (keyword-apply f #:z 7 '(#:y) '(2) '(1)) ]} -@defproc[(procedure-arity [proc procedure?]) - (and/c procedure-arity? normalized-arity?)]{ +@defproc[(procedure-arity [proc procedure?]) normalized-arity?]{ Returns information about the number of by-position arguments accepted by @racket[proc]. See also @racket[procedure-arity?] and @@ -612,7 +611,7 @@ arguments, and following steps add arguments to the left of these. (map (curryr list 'foo) '(1 2 3)) ]} -@defproc[(normalized-arity? [arity procedure-arity?]) boolean?]{ +@defproc[(normalized-arity? [arity any/c]) boolean?]{ A normalized arity has one of the following forms: @itemize[ @@ -625,8 +624,9 @@ or} followed by a single @racket[arity-at-least] instance whose value is greater than the preceding integer by at least 2.} ] -Any two normalized arity values that are @racket[arity=?] must also be -@racket[equal?]. +Every normalized arity is a valid procedure arity and satisfies +@racket[procedure-arity?]. Any two normalized arity values that are +@racket[arity=?] must also be @racket[equal?]. @mz-examples[#:eval fun-eval (normalized-arity? (arity-at-least 1)) @@ -639,8 +639,7 @@ Any two normalized arity values that are @racket[arity=?] must also be } @defproc[(normalize-arity [arity procedure-arity?]) - (and/c procedure-arity? normalized-arity? - (lambda (x) (arity=? x arity)))]{ + (and/c normalized-arity? (lambda (x) (arity=? x arity)))]{ Produces a normalized form of @racket[arity]. See also @racket[normalized-arity?] and @racket[arity=?].