Add a char-in flat contract
This commit is contained in:
parent
7d434d266e
commit
aa4c57bf9a
|
@ -253,6 +253,12 @@ An alias for @racket[between/c].}
|
||||||
Returns a flat contract that requires the input to be an exact integer
|
Returns a flat contract that requires the input to be an exact integer
|
||||||
between @racket[j] and @racket[k], inclusive.}
|
between @racket[j] and @racket[k], inclusive.}
|
||||||
|
|
||||||
|
@defproc[(char-in [a char?] [b char?]) flat-contract?]{
|
||||||
|
|
||||||
|
Returns a flat contract that requires the input to be a character whose
|
||||||
|
code point number is between the code point numbers of @racket[a] and
|
||||||
|
@racket[b], inclusive.}
|
||||||
|
|
||||||
|
|
||||||
@defthing[natural-number/c flat-contract?]{
|
@defthing[natural-number/c flat-contract?]{
|
||||||
|
|
||||||
|
|
|
@ -41,6 +41,10 @@
|
||||||
(test-flat-contract '(integer-in 0 10) 10 3/2)
|
(test-flat-contract '(integer-in 0 10) 10 3/2)
|
||||||
(test-flat-contract '(integer-in 0 10) 1 1.0)
|
(test-flat-contract '(integer-in 0 10) 1 1.0)
|
||||||
(test-flat-contract '(integer-in 1 1) 1 1.0)
|
(test-flat-contract '(integer-in 1 1) 1 1.0)
|
||||||
|
(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) #\b "b")
|
||||||
|
(test-flat-contract '(char-in #\a #\a) #\a #\b)
|
||||||
(test-flat-contract '(real-in 1 10) 3/2 20)
|
(test-flat-contract '(real-in 1 10) 3/2 20)
|
||||||
(test-flat-contract '(string-len/c 3) "ab" "abc")
|
(test-flat-contract '(string-len/c 3) "ab" "abc")
|
||||||
(test-flat-contract 'natural-number/c 5 -1)
|
(test-flat-contract 'natural-number/c 5 -1)
|
||||||
|
|
|
@ -17,6 +17,7 @@
|
||||||
not/c
|
not/c
|
||||||
=/c >=/c <=/c </c >/c between/c
|
=/c >=/c <=/c </c >/c between/c
|
||||||
integer-in
|
integer-in
|
||||||
|
char-in
|
||||||
real-in
|
real-in
|
||||||
natural-number/c
|
natural-number/c
|
||||||
string-len/c
|
string-len/c
|
||||||
|
@ -550,6 +551,16 @@
|
||||||
(and/c start exact?)
|
(and/c start exact?)
|
||||||
(integer-in-ctc start end)))
|
(integer-in-ctc start end)))
|
||||||
|
|
||||||
|
(define (char-in a b)
|
||||||
|
(check-two-args 'char-in a b char? char?)
|
||||||
|
(let* ([x (char->integer a)]
|
||||||
|
[y (char->integer b)]
|
||||||
|
[ctc (integer-in x y)])
|
||||||
|
(flat-named-contract
|
||||||
|
`(char-in ,a ,b)
|
||||||
|
(λ (c) (and (char? c)
|
||||||
|
(ctc (char->integer c)))))))
|
||||||
|
|
||||||
(define/final-prop (real-in start end)
|
(define/final-prop (real-in start end)
|
||||||
(check-two-args 'real-in start end real? real?)
|
(check-two-args 'real-in start end real? real?)
|
||||||
(make-real-in-s start end))
|
(make-real-in-s start end))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user