Updated contracts for arity-related functions.

Added contract checking to arity=?, arity-includes?, and normalized-arity.
Removed contract checking from normalize-arity to make it a total predicate.
Updated documentation for normalize-arity to reflect this change.
This commit is contained in:
Carl Eastlund 2013-03-31 10:34:37 -04:00
parent f509420662
commit df00bbb194
3 changed files with 24 additions and 12 deletions

View File

@ -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)))

View File

@ -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 '())]

View File

@ -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=?].