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

nats/e -> nat/e

Browse Source
This commit is contained in:
Max New 2014-04-12 17:18:49 -05:00 committed by Robby Findler
parent 68421f05dd
commit f309685999
3 changed files with 51 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/redex-pkgs/redex-lib/redex/private/enum.rkt
View File

@ -121,7 +121,7 @@
[`any any/e]
[`number num/e]
[`string string/e]
[`natural nats/e]
[`natural nat/e]
[`integer integer/e]
[`real real/e]
[`boolean bool/e]

33
pkgs/redex-pkgs/redex-lib/redex/private/enumerator.rkt
View File

@ -58,9 +58,9 @@
take/e
fold-enum
nats/e
nat/e
range/e
nats+/e
nat+/e
;; Base type enumerators
any/e
@ -216,14 +216,11 @@
(define (fin/e . args) (from-list/e (remove-duplicates args)))
(define nats/e
(define nat/e
(enum +inf.0
identity
(λ (n)
(unless (>= n 0)
(redex-error 'encode "Not a natural"))
n)))
(define ints/e
identity))
(define int/e
(enum +inf.0
(λ (n)
(if (even? n)
@ -785,24 +782,24 @@
(cond [(> low high) (redex-error 'range/e "invalid range: ~s, ~s" low high)]
[(infinite? high)
(if (infinite? low)
ints/e
int/e
(map/e
(λ (n)
(+ n low))
(λ (n)
(- n low))
nats/e))]
nat/e))]
[(infinite? low)
(map/e
(λ (n)
(- high n))
(λ (n)
(+ high n))
nats/e)]
nat/e)]
[else
(map/e (λ (n) (+ n low))
(λ (n) (- n low))
(take/e nats/e (+ 1 (- high low))))]))
(take/e nat/e (+ 1 (- high low))))]))
;; thunk/e : Nat or +-Inf, ( -> enum a) -> enum a
(define (thunk/e s thunk)
@ -1070,7 +1067,7 @@
[1 (const/e `(,bound))]
[_
(define smallers/e (loop (sub1 len)))
(define bounded/e (take/e nats/e (add1 bound)))
(define bounded/e (take/e nat/e (add1 bound)))
(define first-max/e
(map/e
(curry cons bound)
@ -1081,7 +1078,7 @@
(define first-not-max/e
(match bound
[0 empty/e]
[_ (cons/e (take/e nats/e bound)
[_ (cons/e (take/e nat/e bound)
smallers/e)]))
(define (first-max? l)
((first l) . = . bound))
@ -1103,12 +1100,12 @@
(define layer/e (bounded-list/e k layer))
(decode layer/e (n . - . smallest))))
(define (nats+/e n)
(define (nat+/e n)
(map/e (λ (k)
(+ k n))
(λ (k)
(- k n))
nats/e))
nat/e))
;; fail/e : exn -> enum ()
;; returns an enum that calls a thunk
@ -1124,7 +1121,7 @@
test
(require rackunit)
(provide check-bijection?
ints/e
int/e
find-size
list->inc-set
inc-set->list)
@ -1180,7 +1177,7 @@
(define from-1/e
(map/e add1
sub1
nats/e))
nat/e))
(define integer/e
(disj-sum/e (cons (const/e 0) zero?)

69
pkgs/redex-pkgs/redex-test/redex/tests/enumerator-test.rkt
View File

@ -37,7 +37,7 @@
(check-bijection? e)))
;; map test
(define nats+1 (nats+/e 1))
(define nats+1 (nat+/e 1))
(test-begin
(check-equal? (size nats+1) +inf.0)
@ -48,17 +48,17 @@
(test-begin
(check-exn exn:fail?
(λ ()
(decode nats/e -1))))
(decode nat/e -1))))
;; ints checks
(test-begin
(check-eq? (decode ints/e 0) 0) ; 0 -> 0
(check-eq? (decode ints/e 1) 1) ; 1 -> 1
(check-eq? (decode ints/e 2) -1) ; 2 -> 1
(check-eq? (encode ints/e 0) 0)
(check-eq? (encode ints/e 1) 1)
(check-eq? (encode ints/e -1) 2)
(check-bijection? ints/e)) ; -1 -> 2, -3 -> 4
(check-eq? (decode int/e 0) 0) ; 0 -> 0
(check-eq? (decode int/e 1) 1) ; 1 -> 1
(check-eq? (decode int/e 2) -1) ; 2 -> 1
(check-eq? (encode int/e 0) 0)
(check-eq? (encode int/e 1) 1)
(check-eq? (encode int/e -1) 2)
(check-bijection? int/e)) ; -1 -> 2, -3 -> 4
;; sum tests
(define evens/e
@ -87,9 +87,9 @@
(cons (from-list/e '(0 1 2 3)) number?)))
(define bool-or-nat
(disj-sum/e (cons bools/e boolean?)
(cons nats/e number?)))
(cons nat/e number?)))
(define nat-or-bool
(disj-sum/e (cons nats/e number?)
(disj-sum/e (cons nat/e number?)
(cons bools/e boolean?)))
(define odd-or-even
(disj-sum/e (cons evens/e even?)
@ -136,7 +136,7 @@
(define multi-layered
(disj-sum/e (cons (take/e string/e 5) string?)
(cons (from-list/e '(a b c d)) symbol?)
(cons nats/e number?)
(cons nat/e number?)
(cons bool/e boolean?)
(cons (many/e bool/e) list?)))
@ -165,7 +165,7 @@
(cons (from-list/e '(0 1 2 3)) number?)))
(define bool-or-nat
(disj-append/e (cons bools/e boolean?)
(cons nats/e number?)))
(cons nat/e number?)))
(check-equal? (size bool-or-num) 6)
(check-equal? (decode bool-or-num 0) #t)
@ -191,9 +191,9 @@
(define bool*bool (cons/e bools/e bools/e))
(define 1*b (cons/e (const/e 1) bools/e))
(define b*1 (cons/e bools/e (const/e 1)))
(define bool*nats (cons/e bools/e nats/e))
(define nats*bool (cons/e nats/e bools/e))
(define nats*nats (cons/e nats/e nats/e))
(define bool*nats (cons/e bools/e nat/e))
(define nats*bool (cons/e nat/e bools/e))
(define nats*nats (cons/e nat/e nat/e))
(define ns-equal? (λ (ns ms)
(and (= (car ns)
(car ms))
@ -268,15 +268,15 @@
[expected (list->set approx)])
(equal? actual expected)))
(test-begin
(define n*n (cantor-list/e nats/e nats/e))
(define n*n (cantor-list/e nat/e nat/e))
(check-range? n*n 0 1 '((0 0)))
(check-range? n*n 1 3 '((0 1) (1 0)))
(check-range? n*n 3 6 '((0 2) (1 1) (2 0)))
(check-range? n*n 6 10 '((0 3) (1 2) (2 1) (3 0)))
(check-range? n*n 10 15 '((0 4) (1 3) (2 2) (3 1) (4 0))))
(test-begin
(define n*n*n (cantor-list/e nats/e nats/e nats/e))
(define n*n*n*n (cantor-list/e nats/e nats/e nats/e nats/e))
(define n*n*n (cantor-list/e nat/e nat/e nat/e))
(define n*n*n*n (cantor-list/e nat/e nat/e nat/e nat/e))
(check-range? n*n*n 0 1 '((0 0 0)))
@ -287,17 +287,17 @@
(1 1 1))))
(test-begin
(check-bijection? (cantor-vec/e string/e nats/e real/e))
(check-bijection? (cantor-list/e string/e nats/e real/e))
(check-bijection? (cantor-vec/e string/e nat/e real/e))
(check-bijection? (cantor-list/e string/e nat/e real/e))
(check-bijection? (cantor-list/e)))
(test-begin
(define n*n (box-list/e nats/e nats/e))
(define n*n (box-list/e nat/e nat/e))
(check-range? n*n 0 1 '((0 0)))
(check-range? n*n 1 4 '((0 1) (1 0) (1 1)))
(check-range? n*n 4 9 '((0 2) (1 2) (2 1) (2 0) (2 2))))
(test-begin
(define n*n*n (box-list/e nats/e nats/e nats/e))
(define n*n*n (box-list/e nat/e nat/e nat/e))
(check-range? n*n*n 0 1 '((0 0 0)))
(check-range? n*n*n 1 8 '((0 0 1) (0 1 1) (0 1 0)
@ -314,8 +314,8 @@
(2 2 0) (2 2 1) (2 2 2))))
(test-begin
(check-bijection? (box-vec/e string/e nats/e real/e))
(check-bijection? (box-list/e string/e nats/e real/e))
(check-bijection? (box-vec/e string/e nat/e real/e))
(check-bijection? (box-list/e string/e nat/e real/e))
(check-bijection? (box-list/e)))
;; helper
@ -323,11 +323,12 @@
(check-equal? (list->inc-set '(2 0 1 2)) '(2 3 5 8))
(check-equal? (inc-set->list '(2 3 5 8)) '(2 0 1 2)))
;; mixed finite/infinite list/e tests
(test-begin
(check-bijection? (list/e bool/e (cons/e bool/e bool/e) (fin/e 'foo 'bar 'baz)))
(check-bijection? (list/e nats/e string/e (many/e bool/e)))
(check-bijection? (list/e bool/e nats/e ints/e string/e (cons/e bool/e bool/e))))
(check-bijection? (list/e nat/e string/e (many/e bool/e)))
(check-bijection? (list/e bool/e nat/e int/e string/e (cons/e bool/e bool/e))))
;; multi-arg map/e test
(define sums/e
@ -343,7 +344,7 @@
;; dep/e tests
(define (up-to n)
(take/e nats/e (+ n 1)))
(take/e nat/e (+ n 1)))
(define 3-up
(dep/e
@ -353,13 +354,13 @@
(define from-3
(dep/e
(from-list/e '(0 1 2))
nats+/e))
nat+/e))
(define nats-to
(dep/e nats/e up-to))
(dep/e nat/e up-to))
(define nats-up
(dep/e nats/e nats+/e))
(dep/e nat/e nat+/e))
(test-begin
(check-equal? (size 3-up) 6)
@ -421,7 +422,7 @@
up-to))
(define nats-to-2
(dep/e nats/e up-to))
(dep/e nat/e up-to))
(test-begin
(check-equal? (size 3-up-2) 6)
@ -470,7 +471,7 @@
;; except/e test
(define not-3 (except/e nats/e 3))
(define not-3 (except/e nat/e 3))
(test-begin
(check-equal? (decode not-3 0) 0)
(check-equal? (decode not-3 3) 4)
@ -486,7 +487,7 @@
;; many/e tests
(define natss
(many/e nats/e))
(many/e nat/e))
(check-bijection? natss)
(define emptys/e