fix a bug in recent and/c improvements and add proper printing for integer-in
This commit is contained in:
parent
fe9288d0d5
commit
f5c5db3b3d
|
@ -58,6 +58,7 @@
|
||||||
(test-flat-contract '(and/c exact-integer? (between/c -10 10)) -1 -11)
|
(test-flat-contract '(and/c exact-integer? (between/c -10 10)) -1 -11)
|
||||||
(test-flat-contract '(and/c exact-integer? (between/c -10.5 10.5)) -10 -11)
|
(test-flat-contract '(and/c exact-integer? (between/c -10.5 10.5)) -10 -11)
|
||||||
(test-flat-contract '(and/c exact-integer? (between/c -10.5 10.5)) 10 11)
|
(test-flat-contract '(and/c exact-integer? (between/c -10.5 10.5)) 10 11)
|
||||||
|
(test-flat-contract '(and/c exact-integer? (<=/c 0)) -1 -3/2)
|
||||||
(test-flat-contract '(char-in #\a #\z) #\a #\Z)
|
(test-flat-contract '(char-in #\a #\z) #\a #\Z)
|
||||||
(test-flat-contract '(char-in #\a #\z) #\z #\A)
|
(test-flat-contract '(char-in #\a #\z) #\z #\A)
|
||||||
(test-flat-contract '(char-in #\a #\z) #\b "b")
|
(test-flat-contract '(char-in #\a #\z) #\b "b")
|
||||||
|
|
|
@ -234,7 +234,7 @@
|
||||||
[(between/c-s? other)
|
[(between/c-s? other)
|
||||||
(define other-low (between/c-s-low other))
|
(define other-low (between/c-s-low other))
|
||||||
(define other-high (between/c-s-high other))
|
(define other-high (between/c-s-high other))
|
||||||
(integer-in (exact-ceiling (if (= other-low -inf.0) #f other-low))
|
(integer-in (if (= other-low -inf.0) #f (exact-ceiling other-low))
|
||||||
(if (= other-high +inf.0) #f (exact-floor other-high)))]
|
(if (= other-high +inf.0) #f (exact-floor other-high)))]
|
||||||
[else (make-first-order-and/c contracts preds)])]
|
[else (make-first-order-and/c contracts preds)])]
|
||||||
[else
|
[else
|
||||||
|
@ -249,6 +249,7 @@
|
||||||
(define (exact-ceiling x) (ceiling (inexact->exact x)))
|
(define (exact-ceiling x) (ceiling (inexact->exact x)))
|
||||||
|
|
||||||
(struct integer-in-ctc (start end)
|
(struct integer-in-ctc (start end)
|
||||||
|
#:property prop:custom-write custom-write-property-proc
|
||||||
#:property prop:flat-contract
|
#:property prop:flat-contract
|
||||||
(build-flat-contract-property
|
(build-flat-contract-property
|
||||||
#:name (λ (ctc)
|
#:name (λ (ctc)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user