suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fixed the comparison contracts so they work right wrt to complex numbers

Browse Source 
svn: r16445
This commit is contained in:
Robby Findler 2009-10-28 16:04:39 +00:00
parent 3c1fa0e0e1
commit 4ddbe71e2d
3 changed files with 19 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/scheme/contract/private/misc.ss
View File

@ -506,7 +506,7 @@
(let ([n (between/c-low ctc)]
[m (between/c-high ctc)])
(λ (x)
(and (number? x)
(and (real? x)
(<= n x m))))))
(define-syntax (check-unary-between/c stx)
@ -527,10 +527,10 @@
(check-unary-between/c '>=/c x)
(make-between/c x +inf.0))
(define (check-between/c x y)
(unless (number? x)
(error 'between/c "expected a number as first argument, got ~e, other arg ~e" x y))
(unless (number? y)
(error 'between/c "expected a number as second argument, got ~e, other arg ~e" y x)))
(unless (real? x)
(error 'between/c "expected a real number as first argument, got ~e, other arg ~e" x y))
(unless (real? y)
(error 'between/c "expected a real number as second argument, got ~e, other arg ~e" y x)))
(define (between/c x y)
(check-between/c x y)
(make-between/c x y))
@ -604,7 +604,7 @@
(that (opt/info-that opt/info)))
(values
(syntax
(if (and (number? val) (comparison val m))
(if (and (real? val) (comparison val m))
val
(raise-contract-error
val
@ -673,11 +673,11 @@
(define (</c x)
(flat-named-contract
`(</c ,x)
(λ (y) (and (number? y) (< y x)))))
(λ (y) (and (real? y) (< y x)))))
(define (>/c x)
(flat-named-contract
`(>/c ,x)
(λ (y) (and (number? y) (> y x)))))
(λ (y) (and (real? y) (> y x)))))
(define natural-number/c
(flat-named-contract

10
collects/scribblings/reference/contracts.scrbl
View File

@ -146,7 +146,7 @@ Accepts a flat contracts or a predicate and returns a flat contract
that checks the inverse of the argument.}
@defproc[(=/c [z number?]) flat-contract?]{
@defproc[(=/c [z real?]) flat-contract?]{
Returns a flat contract that requires the input to be a number and
@scheme[=] to @scheme[z].}
@ -158,18 +158,18 @@ Returns a flat contract that requires the input to be a number and
@scheme[<] to @scheme[n].}
@defproc[(>/c [n number?]) flat-contract?]{
@defproc[(>/c [n real?]) flat-contract?]{
Like @scheme[</c], but for @scheme[>].}
@defproc[(<=/c [n number?]) flat-contract?]{
@defproc[(<=/c [n real?]) flat-contract?]{
Like @scheme[</c], but for @scheme[<=].}
@defproc[(>=/c [n number?]) flat-contract?]{
@defproc[(>=/c [n real?]) flat-contract?]{
Like @scheme[</c], but for @scheme[>=].}
@defproc[(between/c [n number?] [m number?])
@defproc[(between/c [n real?] [m real?])
flat-contract?]{ Returns a flat contract that requires the
input to be a between @scheme[n] and @scheme[m] or equal to
one of them.}

7
collects/tests/mzscheme/contract-test.ss
View File

@ -5340,10 +5340,15 @@ so that propagation occurs.
(test-flat-contract '(not/c integer?) #t 1)
(test-flat-contract '(=/c 2) 2 3)
(test-flat-contract '(>/c 5) 10 5)
(test-flat-contract '(>=/c 5) 5 0)
(test-flat-contract '(<=/c 5) 5 10)
(test-flat-contract '(</c 5) 0 5)
(test-flat-contract '(>/c 5) 10 5)
(test-flat-contract '(=/c 2) 2 0+1i)
(test-flat-contract '(>/c 5) 10 0+1i)
(test-flat-contract '(>=/c 5) 5 0+1i)
(test-flat-contract '(<=/c 5) 5 0+1i)
(test-flat-contract '(</c 5) 0 0+1i)
(test-flat-contract '(integer-in 0 10) 0 11)
(test-flat-contract '(integer-in 0 10) 10 3/2)
(test-flat-contract '(integer-in 0 10) 1 1.0)