From 797f7f7bd2555d2b0e79492edebf9db15371b15e Mon Sep 17 00:00:00 2001
From: Max New <maxsnew@gmail.com>
Date: Mon, 20 May 2013 01:11:04 -0500
Subject: [PATCH] Redex generator supports mismatched names.

Also added mismatched name tests.
---
 collects/redex/private/enum.rkt       | 302 ++++++++++---
 collects/redex/private/enumerator.rkt | 613 +++++++++++++-------------
 collects/redex/tests/enum-test.rkt    |  13 +
 3 files changed, 567 insertions(+), 361 deletions(-)

diff --git a/collects/redex/private/enum.rkt b/collects/redex/private/enum.rkt
index 54fc1abb4e..ce9d90953e 100644
--- a/collects/redex/private/enum.rkt
+++ b/collects/redex/private/enum.rkt
@@ -19,11 +19,19 @@
   [enum? (-> any/c boolean?)]))
 
 (struct lang-enum (enums))
-(struct decomposition (ctx term))
-(struct named (name val))
-(struct named-t (val term))
-(struct name (name) #:transparent)
-(struct unimplemented (msg))
+(struct repeat (n terms) #:transparent)
+(struct decomposition (ctx term) #:transparent)
+(struct named (name val) #:transparent)
+(struct named-t (val term) #:transparent)
+(struct mismatch (name val) #:transparent)
+(struct mismatch-t (vals term) #:transparent)
+
+(struct name-ref (name) #:transparent)
+(struct mismatch-ref (name) #:transparent)
+
+(struct unimplemented (msg) #:transparent)
+(struct named-pats (names map) #:transparent
+        ) ;; listof symbol and hash symbol -o> (or named, mismatched, named-repeat, mismatch-repeat)
 
 (define enum-ith decode)
 
@@ -265,10 +273,10 @@
               (sep-names pat)
               l-enums))
 
-;; sep-names : single-pattern lang -> (assoclist symbol pattern)
+;; sep-names : single-pattern lang -> named-pats
 (define (sep-names pat)
   (let loop ([pat pat]
-             [named-pats '()])
+             [named-pats empty-named-pats])
     (match-a-pattern
      pat
      [`any named-pats]
@@ -285,11 +293,12 @@
      [`hole named-pats]
      ;; names inside nts are separate
      [`(nt ,id) named-pats]
-     [`(name ,name ,pat)
+     [`(name ,n ,pat)
       (loop pat
-            (add-if-new name pat named-pats))]
-     [`(mismatch-name ,name ,pat)
-      (loop pat (cons (unimplemented "mismatch") named-pats))]
+            (add-named n pat named-pats))]
+     [`(mismatch-name ,n ,pat)
+      (loop pat
+            (add-mismatch n pat named-pats))]
      [`(in-hole ,p1 ,p2)
       (loop p2
             (loop p1 named-pats))]
@@ -304,16 +313,84 @@
                   [`(repeat ,pat #f #f)
                    (loop pat named-pats)]
                   [`(repeat ,pat ,name ,mismatch)
-                   (loop pat (cons (unimplemented "named/mismatched repeat") named-pats))]
+                   (loop pat
+                         (add-unimplemented name "named/mismatched repeat" named-pats))]
                   [else (loop sub-pat named-pats)]))
              named-pats
              sub-pats)]
      [(? (compose not pair?))
       named-pats])))
 
-(define (add-if-new k v l)
-  (cond [(assoc-named k l) l]
-        [else (cons (named k v) l)]))
+;; named-pats combinators
+(define empty-named-pats
+  (named-pats '() (hash)))
+
+(define (empty-named-pats? nps)
+  (null? (named-pats-names nps)))
+
+(define (next-named-pats nps)
+  (hash-ref (named-pats-map nps)
+            (car (named-pats-names nps))))
+
+(define (rest-named-pats nps)
+  (named-pats (cdr (named-pats-names nps))
+              (named-pats-map nps)))
+
+(define (member-named-pats name nps)
+  (member name (named-pats-names nps)))
+
+(define (add-named name pat nps)
+  (cond [(member-named-pats name nps)
+         nps]
+        [else
+         (add-named-pats name (named name pat) nps)]))
+(define (add-unimplemented name msg nps)
+  (add-named-pats name
+                  (unimplemented msg)
+                  nps))
+
+(define (add-mismatch n pat nps)
+  (cond [(member-named-pats n nps)
+         (named-pats-set n
+                         (mismatch
+                          n
+                          (cons pat
+                                (mismatch-val
+                                 (hash-ref (named-pats-map nps)
+                                           n))))
+                         nps)]
+        [else
+         (add-named-pats n
+                         (mismatch n (list pat))
+                         nps)]))
+
+(define (named-pats-set n val nps)
+  (named-pats
+   (named-pats-names nps)
+   (hash-set (named-pats-map nps)
+             n val)))
+
+(define (add-named-pats n val nps)
+  (named-pats (cons n (named-pats-names nps))
+              (hash-set (named-pats-map nps) n val)))
+
+(define (reverse-named-pats nps)
+  (named-pats (named-pats-names nps)
+              (foldl
+               (λ (kv m)
+                  (let ([key (car kv)]
+                        [val (cdr kv)])
+                    (hash-set m key
+                              (cond [(named? val)
+                                     val]
+                                    [(mismatch? val)
+                                     (mismatch (mismatch-name val)
+                                               (reverse
+                                                (mismatch-val val)))]
+                                    [(unimplemented? val)
+                                     val]))))
+               (hash)
+               (hash->list (named-pats-map nps)))))
 
 (define (assoc-named n l)
   (cond [(null? l) #f]
@@ -324,14 +401,14 @@
                             n)))
              (assoc-named n (cdr l)))]))
 
-(define (enum-names pat named-pats nt-enums)
-  (let rec ([named-pats named-pats]
+(define (enum-names pat nps nt-enums)
+  (let rec ([nps nps]
             [env (hash)])
-    (cond [(null? named-pats)
+    (cond [(empty-named-pats? nps)
            (pat/enum-with-names pat nt-enums env)]
           [else
-           (let ([cur (car named-pats)])
-             (cond ([named? cur]
+           (let ([cur (next-named-pats nps)])
+             (cond [(named? cur)
                     (let ([name (named-name cur)]
                           [pat (named-val cur)])
                       (map/enum
@@ -352,12 +429,47 @@
                        (dep/enum
                         (pat/enum-with-names pat nt-enums env)
                         (λ (term)
-                           (rec (cdr named-pats)
+                           (rec (rest-named-pats nps)
                                 (hash-set env
                                           name
-                                          term)))))))
-                   [else (error/enum 'unimplemented
-                                     (unimplemented-msg cur))]))])))
+                                          term))))))]
+                   [(mismatch? cur)
+                    (let ([name (mismatch-name cur)])
+                      (map/enum
+                       (λ (ts)
+                          (mismatch name
+                                    (mismatch-t (car ts)
+                                                (cdr ts))))
+                       (λ (n)
+                          (if (equal? (mismatch-name n)
+                                      name)
+                              (let ([val (mismatch-val n)])
+                                (cons (mismatch-t-vals val)
+                                      (mismatch-t-term val)))
+                              (error 'wrong-name
+                                     "expected ~a, got ~a"
+                                     name
+                                     (named-name n))))
+                       (dep/enum
+                        (fold-enum
+                         (λ (excepts pat)
+                            (except/enum
+                             (pat/enum-with-names pat
+                                                  nt-enums
+                                                  (hash-set env
+                                                            (mismatch-name cur)
+                                                            excepts))
+                             excepts))
+                         (mismatch-val cur))
+                        (λ (terms)
+                           (rec (rest-named-pats nps)
+                                (hash-set env
+                                          name
+                                          terms))))))]
+                   [(unimplemented? cur)
+                    (error/enum 'unimplemented
+                                (unimplemented-msg cur))]
+                   [else (error 'unexpected "expected name, mismatch or unimplemented, got: ~a in ~a" cur nps)]))])))
 
 (define (pat/enum-with-names pat nt-enums named-terms)
   (let loop ([pat pat])
@@ -375,7 +487,7 @@
      [`boolean bool/enum]
      [`variable var/enum]
      [`(variable-except ,s ...)
-      (apply except/enum var/enum s)]
+      (except/enum var/enum s)]
      [`(variable-prefix ,s)
       ;; todo
       (error/enum 'unimplemented "var-prefix")]
@@ -386,9 +498,9 @@
      [`(nt ,id)
       (hash-ref nt-enums id)]
      [`(name ,n ,pat)
-      (const/enum (name n))]
-     [`(mismatch-name ,name ,pat)
-      (error/enum 'unimplemented "mismatch-name")]
+      (const/enum (name-ref n))]
+     [`(mismatch-name ,n ,pat)
+      (const/enum (mismatch-ref n))]
      [`(in-hole ,p1 ,p2) ;; untested
       (map/enum
        (λ (ts)
@@ -408,33 +520,29 @@
       (unsupported/enum pat)]
      [`(list ,sub-pats ...)
       ;; enum-list
-      (map/enum
-       flatten-1
-       identity
-       (list/enum
-        (map
-         (λ (sub-pat)
-            (match sub-pat
-              [`(repeat ,pat #f #f)
-               (map/enum
-                cdr
-                (λ (ts)
-                   (cons (length ts)
-                         ts))
-                (dep/enum
-                 nats
-                 (λ (n)
-                    (list/enum
-                     (build-list n (const (loop pat)))))))]
-              [`(repeat ,pat ,name #f)
-               (error/enum 'unimplemented "named-repeat")]
-              [`(repeat ,pat #f ,mismatch)
-               (error/enum 'unimplemented "mismatch-repeat")]
-              [else (map/enum
-                     list
-                     car
-                     (loop sub-pat))]))
-         sub-pats)))]
+      (list/enum
+       (map
+        (λ (sub-pat)
+           (match sub-pat
+             [`(repeat ,pat #f #f)
+              (map/enum
+               (λ (n-ts)
+                  (repeat (car n-ts)
+                          (cdr n-ts)))
+               (λ (rep)
+                  (cons (repeat-n rep)
+                        (repeat-terms rep)))
+               (dep/enum
+                nats
+                (λ (n)
+                   (list/enum
+                    (build-list n (const (loop pat)))))))]
+             [`(repeat ,pat ,name #f)
+              (error/enum 'unimplemented "named-repeat")]
+             [`(repeat ,pat #f ,mismatch)
+              (error/enum 'unimplemented "mismatch-repeat")]
+             [else (loop sub-pat)]))
+        sub-pats))]
      [(? (compose not pair?)) 
       (const/enum pat)])))
 
@@ -475,10 +583,9 @@
                       (λ (n) (- (- n) 1))
                       nats)))
 
-(define real/enum (from-list/enum '(0.0 1.5 123.112354)))
+(define real/enum (from-list/enum '(0.5 1.5 123.112354)))
 (define num/enum
-  (sum/enum natural/enum
-            integer/enum
+  (sum/enum integer/enum
             real/enum))
 
 (define bool/enum
@@ -499,10 +606,27 @@
 (define (to-term aug)
   (cond [(named? aug)
          (rep-name aug)]
+        [(mismatch? aug)
+         (rep-mismatches aug)]
         [(decomposition? aug)
          (plug-hole aug)]
+        [(repeat? aug)
+         (map-repeat to-term
+                     aug)]
+        [(list? aug)
+         (expand-repeats
+          (map to-term aug))]
         [else aug]))
 
+(define (expand-repeats sub-terms)
+  (append*
+   (map
+    (λ (t)
+       (cond [(repeat? t)
+              (repeat-terms t)]
+             [else (list t)]))
+    sub-terms)))
+
 (define (rep-name s)
   (to-term
    (let* ([n (named-name s)]
@@ -510,10 +634,10 @@
           [val (named-t-val v)]
           [term (named-t-term v)])
      (let loop ([term term])
-       (cond [(and (name? term)
-                   (equal? (name-name term) n))
+       (cond [(and (name-ref? term)
+                   (equal? (name-ref-name term) n))
               val]
-             [(cons? term)
+             [(list? term)
               (map loop term)]
              [(named? term)
               (map-named loop
@@ -521,13 +645,48 @@
              [(decomposition? term)
               (map-decomp loop
                           term)]
+             [(mismatch? term)
+              (map-mismatch loop
+                            term)]
+             [(repeat? term)
+              (map-repeat loop
+                          term)]
              [else term])))))
 
+(define (rep-mismatches m)
+  (to-term
+   (let* ([name (mismatch-name m)]
+          [v (mismatch-val m)]
+          [vals (mismatch-t-vals v)]
+          [term (mismatch-t-term v)])
+     (let ([vals vals])
+       (let loop ([term term])
+         (cond [(and (mismatch-ref? term)
+                     (equal? (mismatch-ref-name term) name))
+                (begin0
+                    (car vals)
+                  (set! vals (cdr vals)))]
+               [(list? term)
+                (map loop term)]
+               [(named? term)
+                (map-named loop
+                           term)]
+               [(decomposition? term)
+                (map-decomp loop
+                            term)]
+               [(mismatch? term)
+                (map-mismatch loop
+                              term)]
+               [(repeat? term)
+                (map-repeat loop
+                            term)]
+               [else term]))))))
+
 (define (plug-hole ctx term)
   (to-term
    (let loop ([ctx ctx])
      (cond [(hole? ctx) term]
-           [(cons? ctx) (map loop ctx)]
+           [(list? ctx) (map loop ctx)]
            [(named? )])
      (match
        ctx
@@ -544,7 +703,18 @@
 
 (define (map-named f n)
   (let ([v (named-val n)])
-   (named (named-name n)
-          (named-t
-           (named-t-val v)
-           (f (named-t-term v))))))
+    (named (named-name n)
+           (named-t
+            (named-t-val v)
+            (f (named-t-term v))))))
+
+(define (map-mismatch f m)
+  (let ([v (mismatch-val m)])
+    (mismatch (mismatch-name m)
+              (mismatch-t
+               (mismatch-t-vals v)
+               (f (mismatch-t-term v))))))
+
+(define (map-repeat f r)
+  (repeat (repeat-n r)
+          (map f (repeat-terms r))))
diff --git a/collects/redex/private/enumerator.rkt b/collects/redex/private/enumerator.rkt
index a63d2d0ee8..9e5293858c 100644
--- a/collects/redex/private/enumerator.rkt
+++ b/collects/redex/private/enumerator.rkt
@@ -26,7 +26,7 @@
          to-list
          take/enum
          drop/enum
-         foldl-enum
+         fold-enum
          display-enum
 
          nats
@@ -80,28 +80,24 @@
         (λ (x) (encode e x))))
 
 ;; except/enum : enum a, a -> enum a
-(define except/enum
-  (case-lambda
-    [(e) e]
-    [(e a . rest)
-     (let ([excepted
-            (begin
-              (unless (> (size e) 0)
-                (error 'empty-enum))
-              (with-handlers ([exn:fail? (λ (_)
-                                            (apply except/enum e rest))])
-                (let ([m (encode e a)])
-                  (enum (- (size e) 1)
-                        (λ (n)
-                           (if (< n m)
-                               (decode e n)
-                               (decode e (+ n 1))))
-                        (λ (x)
-                           (let ([n (encode e x)])
-                             (cond [(< n m) n]
-                                   [(> n m) (- n 1)]
-                                   [else (error 'excepted)])))))))])
-       (apply except/enum excepted rest))]))
+(define (except/enum e excepts)
+  (cond [(empty? excepts) e]
+        [else
+         (except/enum
+          (begin
+            (with-handlers ([exn:fail? (λ (_) e)])
+              (let ([m (encode e (car excepts))])
+                (enum (- (size e) 1)
+                      (λ (n)
+                         (if (< n m)
+                             (decode e n)
+                             (decode e (+ n 1))))
+                      (λ (x)
+                         (let ([n (encode e x)])
+                           (cond [(< n m) n]
+                                 [(> n m) (- n 1)]
+                                 [else (error 'excepted)])))))))
+          (cdr excepts))]))
 
 ;; to-list : enum a -> listof a
 ;; better be finite
@@ -141,11 +137,6 @@
         (λ (x)
            (- (encode e x) n))))
 
-;; foldl-enum : enum a, b, (a,b -> b) -> b
-;; better be a finite enum
-(define (foldl-enum f id e)
-  (foldl f id (to-list e)))
-
 ;; display-enum : enum a, Nat -> void
 (define (display-enum e n)
   (for ([i (range n)])
@@ -509,7 +500,32 @@
         [else ;; both infinite, same as prod/enum
          (dep/enum e f)]))
 
+;; fold-enum : ((listof a), b -> enum a), (listof b) -> enum (listof a)
+(define (fold-enum f l)
+  (map/enum
+   reverse
+   reverse
+   (let loop ([l l]
+              [acc (const/enum '())])
+     (cond [(empty? l) acc]
+           [else
+            (loop
+             (cdr l)
+             (flip-dep/enum
+              acc
+              (λ (xs)
+                 (f xs (car l)))))]))))
 
+;; flip-dep/enum : enum a (a -> enum b) -> enum (b,a)
+(define (flip-dep/enum e f)
+  (map/enum
+   (λ (ab)
+      (cons (cdr ab)
+            (car ab)))
+   (λ (ba)
+      (cons (cdr ba)
+            (car ba)))
+   (dep/enum e f)))
 
 ;; more utility enums
 ;; nats of course
@@ -585,305 +601,312 @@
 
 
 (module+
-  test
-  (require rackunit)
-  (provide check-bijection?)
-  (define confidence 1000)
-  (define nums (build-list confidence identity))
-  (define-simple-check (check-bijection? e)
-    (let ([nums (build-list (if (<= (enum-size e) confidence)
-                                (enum-size e)
-                                confidence)
-                            identity)])
-      (andmap =
-              nums
-              (map (λ (n)
-                      (encode e (decode e n)))
-                   nums))))
+ test
+ (require rackunit)
+ (provide check-bijection?)
+ (define confidence 1000)
+ (define nums (build-list confidence identity))
+ (define-simple-check (check-bijection? e)
+   (let ([nums (build-list (if (<= (enum-size e) confidence)
+                               (enum-size e)
+                               confidence)
+                           identity)])
+     (andmap =
+             nums
+             (map (λ (n)
+                     (encode e (decode e n)))
+                  nums))))
 
-  ;; const/enum tests
-  (let ([e (const/enum 17)])
-    (test-begin
-     (check-eq? (decode e 0) 17)
-     (check-exn exn:fail? 
-                (λ ()
-                   (decode e 1)))
-     (check-eq? (encode e 17) 0)
-     (check-exn exn:fail?
-                (λ ()
-                   (encode e 0)))
-     (check-bijection? e)))
+ ;; const/enum tests
+ (let ([e (const/enum 17)])
+   (test-begin
+    (check-eq? (decode e 0) 17)
+    (check-exn exn:fail? 
+               (λ ()
+                  (decode e 1)))
+    (check-eq? (encode e 17) 0)
+    (check-exn exn:fail?
+               (λ ()
+                  (encode e 0)))
+    (check-bijection? e)))
 
-  ;; from-list/enum tests
-  (let ([e (from-list/enum '(5 4 1 8))])
-    (test-begin
-     (check-eq? (decode e 0) 5)
-     (check-eq? (decode e 3) 8)
-     (check-exn exn:fail?
-                (λ () (decode e 4)))
-     (check-eq? (encode e 5) 0)
-     (check-eq? (encode e 8) 3)
-     (check-exn exn:fail?
-                (λ ()
-                   (encode e 17)))
-     (check-bijection? e)))
+ ;; from-list/enum tests
+ (let ([e (from-list/enum '(5 4 1 8))])
+   (test-begin
+    (check-eq? (decode e 0) 5)
+    (check-eq? (decode e 3) 8)
+    (check-exn exn:fail?
+               (λ () (decode e 4)))
+    (check-eq? (encode e 5) 0)
+    (check-eq? (encode e 8) 3)
+    (check-exn exn:fail?
+               (λ ()
+                  (encode e 17)))
+    (check-bijection? e)))
 
-  ;; map test
-  (define nats+1 (nats+/enum 1))
+ ;; map test
+ (define nats+1 (nats+/enum 1))
 
-  (test-begin
-   (check-equal? (size nats+1) +inf.f)
-   (check-equal? (decode nats+1 0) 1)
-   (check-equal? (decode nats+1 1) 2)
-   (check-bijection? nats+1))
-  ;; encode check
-  (test-begin
-   (check-exn exn:fail?
-              (λ ()
-                 (decode nats -1))))
+ (test-begin
+  (check-equal? (size nats+1) +inf.f)
+  (check-equal? (decode nats+1 0) 1)
+  (check-equal? (decode nats+1 1) 2)
+  (check-bijection? nats+1))
+ ;; encode check
+ (test-begin
+  (check-exn exn:fail?
+             (λ ()
+                (decode nats -1))))
 
-  ;; ints checks
-  (test-begin
-   (check-eq? (decode ints 0) 0)  ; 0 -> 0
-   (check-eq? (decode ints 1) 1)  ; 1 -> 1
-   (check-eq? (decode ints 2) -1) ; 2 -> 1
-   (check-eq? (encode ints 0) 0)
-   (check-eq? (encode ints 1) 1)
-   (check-eq? (encode ints -1) 2)
-   (check-bijection? ints))  ; -1 -> 2, -3 -> 4
+ ;; ints checks
+ (test-begin
+  (check-eq? (decode ints 0) 0)         ; 0 -> 0
+  (check-eq? (decode ints 1) 1)         ; 1 -> 1
+  (check-eq? (decode ints 2) -1)        ; 2 -> 1
+  (check-eq? (encode ints 0) 0)
+  (check-eq? (encode ints 1) 1)
+  (check-eq? (encode ints -1) 2)
+  (check-bijection? ints))              ; -1 -> 2, -3 -> 4
 
-  ;; sum tests
-  (test-begin
-   (let ([bool-or-num (sum/enum bools
-                                (from-list/enum '(0 1 2)))]
-         [bool-or-nat (sum/enum bools
-                                nats)]
-         [nat-or-bool (sum/enum nats
-                                bools)]
-         [odd-or-even (sum/enum evens
-                                odds)])
-     (check-equal? (enum-size bool-or-num)
-                   5)
-     (check-equal? (decode bool-or-num 0) #t)
-     (check-equal? (decode bool-or-num 1) #f)
-     (check-equal? (decode bool-or-num 2) 0)
-     (check-exn exn:fail?
-                (λ ()
-                   (decode bool-or-num 5)))
-     (check-equal? (encode bool-or-num #f) 1)
-     (check-equal? (encode bool-or-num 2) 4)
-     (check-bijection? bool-or-num)
+ ;; sum tests
+ (test-begin
+  (let ([bool-or-num (sum/enum bools
+                               (from-list/enum '(0 1 2)))]
+        [bool-or-nat (sum/enum bools
+                               nats)]
+        [nat-or-bool (sum/enum nats
+                               bools)]
+        [odd-or-even (sum/enum evens
+                               odds)])
+    (check-equal? (enum-size bool-or-num)
+                  5)
+    (check-equal? (decode bool-or-num 0) #t)
+    (check-equal? (decode bool-or-num 1) #f)
+    (check-equal? (decode bool-or-num 2) 0)
+    (check-exn exn:fail?
+               (λ ()
+                  (decode bool-or-num 5)))
+    (check-equal? (encode bool-or-num #f) 1)
+    (check-equal? (encode bool-or-num 2) 4)
+    (check-bijection? bool-or-num)
      
-     (check-equal? (enum-size bool-or-nat)
-                   +inf.f)
-     (check-equal? (decode bool-or-nat 0) #t)
-     (check-equal? (decode bool-or-nat 2) 0)
-     (check-bijection? bool-or-nat)
+    (check-equal? (enum-size bool-or-nat)
+                  +inf.f)
+    (check-equal? (decode bool-or-nat 0) #t)
+    (check-equal? (decode bool-or-nat 2) 0)
+    (check-bijection? bool-or-nat)
      
-     (check-equal? (encode bool-or-num #f) 1)
-     (check-equal? (encode bool-or-num 2) 4)
+    (check-equal? (encode bool-or-num #f) 1)
+    (check-equal? (encode bool-or-num 2) 4)
 
-     (check-equal? (enum-size odd-or-even)
-                   +inf.f)
-     (check-equal? (decode odd-or-even 0) 0)
-     (check-equal? (decode odd-or-even 1) 1)
-     (check-equal? (decode odd-or-even 2) 2)
-     (check-exn exn:fail?
-                (λ ()
-                   (decode odd-or-even -1)))
-     (check-equal? (encode odd-or-even 0) 0)   
-     (check-equal? (encode odd-or-even 1) 1)
-     (check-equal? (encode odd-or-even 2) 2)
-     (check-equal? (encode odd-or-even 3) 3)
-     (check-bijection? odd-or-even)))
+    (check-equal? (enum-size odd-or-even)
+                  +inf.f)
+    (check-equal? (decode odd-or-even 0) 0)
+    (check-equal? (decode odd-or-even 1) 1)
+    (check-equal? (decode odd-or-even 2) 2)
+    (check-exn exn:fail?
+               (λ ()
+                  (decode odd-or-even -1)))
+    (check-equal? (encode odd-or-even 0) 0)   
+    (check-equal? (encode odd-or-even 1) 1)
+    (check-equal? (encode odd-or-even 2) 2)
+    (check-equal? (encode odd-or-even 3) 3)
+    (check-bijection? odd-or-even)))
 
-  ;; prod/enum tests
-  (define bool*bool (prod/enum bools bools))
-  (define 1*b (prod/enum (const/enum 1) bools))
-  (define bool*nats (prod/enum bools nats))
-  (define nats*bool (prod/enum nats bools))
-  (define nats*nats (prod/enum nats nats))
-  (define ns-equal? (λ (ns ms)
-                       (and (= (car ns)
-                               (car ms))
-                            (= (cdr ns)
-                               (cdr ms)))))
+ ;; prod/enum tests
+ (define bool*bool (prod/enum bools bools))
+ (define 1*b (prod/enum (const/enum 1) bools))
+ (define bool*nats (prod/enum bools nats))
+ (define nats*bool (prod/enum nats bools))
+ (define nats*nats (prod/enum nats nats))
+ (define ns-equal? (λ (ns ms)
+                      (and (= (car ns)
+                              (car ms))
+                           (= (cdr ns)
+                              (cdr ms)))))
 
-  ;; prod tests
-  (test-begin
+ ;; prod tests
+ (test-begin
 
-   (check-equal? (size 1*b) 2)
-   (check-equal? (decode 1*b 0) (cons 1 #t))
-   (check-equal? (decode 1*b 1) (cons 1 #f))
-   (check-bijection? 1*b)
-   (check-equal? (enum-size bool*bool) 4)
-   (check-equal? (decode bool*bool 0)
-                 (cons #t #t))
-   (check-equal? (decode bool*bool 1)
-                 (cons #t #f))
-   (check-equal? (decode bool*bool 2)
-                 (cons #f #t))
-   (check-equal? (decode bool*bool 3)
-                 (cons #f #f))
-   (check-bijection? bool*bool)
+  (check-equal? (size 1*b) 2)
+  (check-equal? (decode 1*b 0) (cons 1 #t))
+  (check-equal? (decode 1*b 1) (cons 1 #f))
+  (check-bijection? 1*b)
+  (check-equal? (enum-size bool*bool) 4)
+  (check-equal? (decode bool*bool 0)
+                (cons #t #t))
+  (check-equal? (decode bool*bool 1)
+                (cons #t #f))
+  (check-equal? (decode bool*bool 2)
+                (cons #f #t))
+  (check-equal? (decode bool*bool 3)
+                (cons #f #f))
+  (check-bijection? bool*bool)
 
-   (check-equal? (enum-size bool*nats) +inf.f)
-   (check-equal? (decode bool*nats 0)
-                 (cons #t 0))
-   (check-equal? (decode bool*nats 1)
-                 (cons #f 0))
-   (check-equal? (decode bool*nats 2)
-                 (cons #t 1))
-   (check-equal? (decode bool*nats 3)
-                 (cons #f 1))
-   (check-bijection? bool*nats)
+  (check-equal? (enum-size bool*nats) +inf.f)
+  (check-equal? (decode bool*nats 0)
+                (cons #t 0))
+  (check-equal? (decode bool*nats 1)
+                (cons #f 0))
+  (check-equal? (decode bool*nats 2)
+                (cons #t 1))
+  (check-equal? (decode bool*nats 3)
+                (cons #f 1))
+  (check-bijection? bool*nats)
 
-   (check-equal? (enum-size nats*bool) +inf.f)
-   (check-equal? (decode nats*bool 0)
-                 (cons 0 #t))
-   (check-equal? (decode nats*bool 1)
-                 (cons 0 #f))
-   (check-equal? (decode nats*bool 2)
-                 (cons 1 #t))
-   (check-equal? (decode nats*bool 3)
-                 (cons 1 #f))
-   (check-bijection? nats*bool)
+  (check-equal? (enum-size nats*bool) +inf.f)
+  (check-equal? (decode nats*bool 0)
+                (cons 0 #t))
+  (check-equal? (decode nats*bool 1)
+                (cons 0 #f))
+  (check-equal? (decode nats*bool 2)
+                (cons 1 #t))
+  (check-equal? (decode nats*bool 3)
+                (cons 1 #f))
+  (check-bijection? nats*bool)
 
-   (check-equal? (enum-size nats*nats) +inf.f)
-   (check ns-equal?
-          (decode nats*nats 0)
-          (cons 0 0))
-   (check ns-equal?
-          (decode nats*nats 1)
-          (cons 0 1))
-   (check ns-equal?
-          (decode nats*nats 2)
-          (cons 1 0))
-   (check ns-equal?
-          (decode nats*nats 3)
-          (cons 0 2))
-   (check ns-equal?
-          (decode nats*nats 4)
-          (cons 1 1))
-   (check-bijection? nats*nats))
+  (check-equal? (enum-size nats*nats) +inf.f)
+  (check ns-equal?
+         (decode nats*nats 0)
+         (cons 0 0))
+  (check ns-equal?
+         (decode nats*nats 1)
+         (cons 0 1))
+  (check ns-equal?
+         (decode nats*nats 2)
+         (cons 1 0))
+  (check ns-equal?
+         (decode nats*nats 3)
+         (cons 0 2))
+  (check ns-equal?
+         (decode nats*nats 4)
+         (cons 1 1))
+  (check-bijection? nats*nats))
 
 
-  ;; dep/enum tests
-  (define (up-to n)
-    (take/enum nats (+ n 1)))
+ ;; dep/enum tests
+ (define (up-to n)
+   (take/enum nats (+ n 1)))
 
-  (define 3-up
-    (dep/enum
-     (from-list/enum '(0 1 2))
-     up-to))
+ (define 3-up
+   (dep/enum
+    (from-list/enum '(0 1 2))
+    up-to))
 
-  (define from-3
-    (dep/enum
-     (from-list/enum '(0 1 2))
-     nats+/enum))
+ (define from-3
+   (dep/enum
+    (from-list/enum '(0 1 2))
+    nats+/enum))
 
-  (define nats-to
-    (dep/enum nats up-to))
+ (define nats-to
+   (dep/enum nats up-to))
 
-  (define nats-up
-    (dep/enum nats nats+/enum))
+ (define nats-up
+   (dep/enum nats nats+/enum))
 
-  (test-begin
-   (check-equal? (size 3-up) 6)
-   (check-equal? (decode 3-up 0) (cons 0 0))
-   (check-equal? (decode 3-up 1) (cons 1 0))
-   (check-equal? (decode 3-up 2) (cons 1 1))
-   (check-equal? (decode 3-up 3) (cons 2 0))
-   (check-equal? (decode 3-up 4) (cons 2 1))
-   (check-equal? (decode 3-up 5) (cons 2 2))
-   (check-bijection? 3-up)
+ (test-begin
+  (check-equal? (size 3-up) 6)
+  (check-equal? (decode 3-up 0) (cons 0 0))
+  (check-equal? (decode 3-up 1) (cons 1 0))
+  (check-equal? (decode 3-up 2) (cons 1 1))
+  (check-equal? (decode 3-up 3) (cons 2 0))
+  (check-equal? (decode 3-up 4) (cons 2 1))
+  (check-equal? (decode 3-up 5) (cons 2 2))
+  (check-bijection? 3-up)
 
-   (check-equal? (size from-3) +inf.f)
-   (check-equal? (decode from-3 0) (cons 0 0))
-   (check-equal? (decode from-3 1) (cons 1 1))
-   (check-equal? (decode from-3 2) (cons 2 2))
-   (check-equal? (decode from-3 3) (cons 0 1))
-   (check-equal? (decode from-3 4) (cons 1 2))
-   (check-equal? (decode from-3 5) (cons 2 3))
-   (check-equal? (decode from-3 6) (cons 0 2))
-   (check-bijection? from-3)
+  (check-equal? (size from-3) +inf.f)
+  (check-equal? (decode from-3 0) (cons 0 0))
+  (check-equal? (decode from-3 1) (cons 1 1))
+  (check-equal? (decode from-3 2) (cons 2 2))
+  (check-equal? (decode from-3 3) (cons 0 1))
+  (check-equal? (decode from-3 4) (cons 1 2))
+  (check-equal? (decode from-3 5) (cons 2 3))
+  (check-equal? (decode from-3 6) (cons 0 2))
+  (check-bijection? from-3)
 
-   (check-equal? (size nats-to) +inf.f)
-   (check-equal? (decode nats-to 0) (cons 0 0))
-   (check-equal? (decode nats-to 1) (cons 1 0))
-   (check-equal? (decode nats-to 2) (cons 1 1))
-   (check-equal? (decode nats-to 3) (cons 2 0))
-   (check-equal? (decode nats-to 4) (cons 2 1))
-   (check-equal? (decode nats-to 5) (cons 2 2))
-   (check-equal? (decode nats-to 6) (cons 3 0))
-   (check-bijection? nats-to)
+  (check-equal? (size nats-to) +inf.f)
+  (check-equal? (decode nats-to 0) (cons 0 0))
+  (check-equal? (decode nats-to 1) (cons 1 0))
+  (check-equal? (decode nats-to 2) (cons 1 1))
+  (check-equal? (decode nats-to 3) (cons 2 0))
+  (check-equal? (decode nats-to 4) (cons 2 1))
+  (check-equal? (decode nats-to 5) (cons 2 2))
+  (check-equal? (decode nats-to 6) (cons 3 0))
+  (check-bijection? nats-to)
 
-   (check-equal? (size nats-up) +inf.f)
-   (check-equal? (decode nats-up 0) (cons 0 0))
-   (check-equal? (decode nats-up 1) (cons 0 1))
-   (check-equal? (decode nats-up 2) (cons 1 1))
-   (check-equal? (decode nats-up 3) (cons 0 2))
-   (check-equal? (decode nats-up 4) (cons 1 2))
-   (check-equal? (decode nats-up 5) (cons 2 2))
-   (check-equal? (decode nats-up 6) (cons 0 3))
-   (check-equal? (decode nats-up 7) (cons 1 3))
+  (check-equal? (size nats-up) +inf.f)
+  (check-equal? (decode nats-up 0) (cons 0 0))
+  (check-equal? (decode nats-up 1) (cons 0 1))
+  (check-equal? (decode nats-up 2) (cons 1 1))
+  (check-equal? (decode nats-up 3) (cons 0 2))
+  (check-equal? (decode nats-up 4) (cons 1 2))
+  (check-equal? (decode nats-up 5) (cons 2 2))
+  (check-equal? (decode nats-up 6) (cons 0 3))
+  (check-equal? (decode nats-up 7) (cons 1 3))
 
-   (check-bijection? nats-up))
+  (check-bijection? nats-up))
 
-  ;; dep2/enum tests
-  ;; same as dep unless the right side is finite
-  (define 3-up-2
-    (dep2/enum
-     (from-list/enum '(0 1 2))
-     up-to))
+ ;; dep2/enum tests
+ ;; same as dep unless the right side is finite
+ (define 3-up-2
+   (dep2/enum
+    (from-list/enum '(0 1 2))
+    up-to))
 
-  (define nats-to-2
-    (dep2/enum nats up-to))
+ (define nats-to-2
+   (dep2/enum nats up-to))
 
 
-  (test-begin
-   (check-equal? (size 3-up-2) 6)
-   (check-equal? (decode 3-up-2 0) (cons 0 0))
-   (check-equal? (decode 3-up-2 1) (cons 1 0))
-   (check-equal? (decode 3-up-2 2) (cons 1 1))
-   (check-equal? (decode 3-up-2 3) (cons 2 0))
-   (check-equal? (decode 3-up-2 4) (cons 2 1))
-   (check-equal? (decode 3-up-2 5) (cons 2 2))
-   (check-bijection? 3-up-2)
+ (test-begin
+  (check-equal? (size 3-up-2) 6)
+  (check-equal? (decode 3-up-2 0) (cons 0 0))
+  (check-equal? (decode 3-up-2 1) (cons 1 0))
+  (check-equal? (decode 3-up-2 2) (cons 1 1))
+  (check-equal? (decode 3-up-2 3) (cons 2 0))
+  (check-equal? (decode 3-up-2 4) (cons 2 1))
+  (check-equal? (decode 3-up-2 5) (cons 2 2))
+  (check-bijection? 3-up-2)
 
-   (check-equal? (size nats-to-2) +inf.f)
-   (check-equal? (decode nats-to-2 0) (cons 0 0))
-   (check-equal? (decode nats-to-2 1) (cons 1 0))
-   (check-equal? (decode nats-to-2 2) (cons 1 1))
-   (check-equal? (decode nats-to-2 3) (cons 2 0))
-   (check-equal? (decode nats-to-2 4) (cons 2 1))
-   (check-equal? (decode nats-to-2 5) (cons 2 2))
-   (check-equal? (decode nats-to-2 6) (cons 3 0))
-   (check-bijection? nats-to-2)
-   )
+  (check-equal? (size nats-to-2) +inf.f)
+  (check-equal? (decode nats-to-2 0) (cons 0 0))
+  (check-equal? (decode nats-to-2 1) (cons 1 0))
+  (check-equal? (decode nats-to-2 2) (cons 1 1))
+  (check-equal? (decode nats-to-2 3) (cons 2 0))
+  (check-equal? (decode nats-to-2 4) (cons 2 1))
+  (check-equal? (decode nats-to-2 5) (cons 2 2))
+  (check-equal? (decode nats-to-2 6) (cons 3 0))
+  (check-bijection? nats-to-2)
+  )
 
+ ;; take/enum test
+ (define to-2 (up-to 2))
+ (test-begin
+  (check-equal? (size to-2) 3)
+  (check-equal? (decode to-2 0) 0)
+  (check-equal? (decode to-2 1) 1)
+  (check-equal? (decode to-2 2) 2)
+  (check-bijection? to-2))
 
-  ;; take/enum test
-  (define to-2 (up-to 2))
-  (test-begin
-   (check-equal? (size to-2) 3)
-   (check-equal? (decode to-2 0) 0)
-   (check-equal? (decode to-2 1) 1)
-   (check-equal? (decode to-2 2) 2)
-   (check-bijection? to-2))
+ ;; to-list test
+ (test-begin
+  (check-equal? (to-list (up-to 3))
+                '(0 1 2 3)))
 
-  ;; to-list, foldl test
-  (test-begin
-   (check-equal? (to-list (up-to 3))
-                 '(0 1 2 3))
-   (check-equal? (foldl-enum cons '() (up-to 3))
-                 '(3 2 1 0)))
+ ;; except/enum test
+ (define not-3 (except/enum nats '(3)))
+ (test-begin
+  (check-equal? (decode not-3 0) 0)
+  (check-equal? (decode not-3 3) 4)
+  (check-bijection? not-3))
+ (define not-a (except/enum nats '(a)))
+ (test-begin
+  (check-equal? (decode not-a 0) 0)
+  (check-bijection? not-a))
 
-  ;; except/enum test
-  (define not-3 (except/enum nats 3))
-  (test-begin
-   (check-equal? (decode not-3 0) 0)
-   (check-equal? (decode not-3 3) 4))
-  (define not-a (except/enum nats 'a))
-  (test-begin
-   (check-equal? (decode not-a 0) 0)))
+ ;; fold-enum tests
+ (define complicated
+   (fold-enum
+    (λ (excepts n)
+       (except/enum (up-to n) excepts))
+    '(2 4 6)))
+ (check-bijection? complicated))
diff --git a/collects/redex/tests/enum-test.rkt b/collects/redex/tests/enum-test.rkt
index de72ff94b0..4215142e03 100644
--- a/collects/redex/tests/enum-test.rkt
+++ b/collects/redex/tests/enum-test.rkt
@@ -63,4 +63,17 @@
      hole)
   (x (variable-except λ + if0)))
 
+(try-it 100 λv e)
+(try-it 100 λv v)
 (try-it 100 λv E)
+(try-it 25 λv x)
+
+(define-language M
+  (m (x_!_1 x_!_1))
+  (p (number_!_1 number_!_1))
+  (n (p_!_1 p_!_1))
+  (x number))
+
+(try-it 100 M m)
+(try-it 100 M n)
+(try-it 100 M p)