From 63023611ad5c3f896f64aac971516d7473290fc2 Mon Sep 17 00:00:00 2001
From: Max New <maxsnew@gmail.com>
Date: Wed, 13 Nov 2013 19:45:20 -0600
Subject: [PATCH] Revert mismatch name support and move base type enumerators

---
 .../redex-lib/redex/private/enum.rkt          | 140 +----------------
 .../redex-lib/redex/private/enumerator.rkt    | 142 +++++++++++++++++-
 .../redex/private/preprocess-pat.rkt          |   1 +
 .../redex-test/redex/tests/enum-test.rkt      |  17 ++-
 4 files changed, 156 insertions(+), 144 deletions(-)

diff --git a/pkgs/redex-pkgs/redex-lib/redex/private/enum.rkt b/pkgs/redex-pkgs/redex-lib/redex/private/enum.rkt
index 634b3ff835..1154e5611a 100644
--- a/pkgs/redex-pkgs/redex-lib/redex/private/enum.rkt
+++ b/pkgs/redex-pkgs/redex-lib/redex/private/enum.rkt
@@ -7,8 +7,6 @@
          racket/match
          racket/set
 
-         math/flonum
-
          "enumerator.rkt"
          "env.rkt"
          "error.rkt"
@@ -97,7 +95,7 @@
      [`any any/e]
      [`number num/e]
      [`string string/e]
-     [`natural natural/e]
+     [`natural nats/e]
      [`integer integer/e]
      [`real real/e]
      [`boolean bool/e]
@@ -105,16 +103,7 @@
      [`(variable-except ,s ...)
       (apply except/e var/e s)]
      [`(variable-prefix ,s)
-      (define as-str (symbol->string s))
-      (map/e (compose string->symbol
-                      (curry string-append as-str)
-                      symbol->string)
-             (compose string->symbol
-                      list->string
-                      (curry (flip drop) (string-length as-str))
-                      string->list
-                      symbol->string)
-             var/e)]
+      (var-prefix/e s)]
      [`variable-not-otherwise-mentioned
       unused/e]
      [`hole (const/e the-hole)]
@@ -123,7 +112,9 @@
      [`(name ,n ,pat)
       (const/e (name-ref n))]
      [`(mismatch-name ,n ,tag)
-      (const/e (misname-ref n tag))]
+      (unsupported "mismatch patterns")
+      ;; (const/e (misname-ref n tag))
+      ]
      [`(in-hole ,p1 ,p2)
       (map/e decomp
              (match-lambda
@@ -264,124 +255,3 @@
   (λ (x)
      (for/list ([f (in-list fs)])
        (f x))))
-
-;; Base Type enumerators
-(define natural/e nats/e)
-
-(define (between? x low high)
-  (and (>= x low)
-       (<= x high)))
-(define (range-with-pred/e-p low high)
-  (cons (range/e low high)
-        (λ (n) (between? n low high))))
-(define low/e-p
-  (range-with-pred/e-p #x61 #x7a))
-(define up/e-p
-  (range-with-pred/e-p #x41 #x5a))
-(define bottom/e-p
-  (range-with-pred/e-p #x0 #x40))
-(define mid/e-p
-  (range-with-pred/e-p #x5b #x60))
-(define above1/e-p
-  (range-with-pred/e-p #x7b #xd7FF))
-(define above2/e-p
-  (range-with-pred/e-p #xe000 #x10ffff))
-
-(define char/e
-  (map/e
-   integer->char
-   char->integer
-   (disj-sum/e #:append? #t
-               low/e-p
-               up/e-p
-               bottom/e-p
-               mid/e-p
-               above1/e-p
-               above2/e-p)))
-
-(define string/e
-  (map/e
-   list->string
-   string->list
-   (many/e char/e)))
-
-(define from-1/e
-  (map/e add1
-         sub1
-         nats/e))
-
-(define integer/e
-  (disj-sum/e #:alternate? #t
-              (cons (const/e 0) zero?)
-              (cons from-1/e (λ (n) (> n 0)))
-              (cons (map/e - - from-1/e)
-                    (λ (n) (< n 0)))))
-
-;; The last 3 here are -inf.0, +inf.0 and +nan.0
-;; Consider moving those to the beginning
-(define weird-flonums/e-p
-  (cons (from-list/e '(+inf.0 -inf.0 +nan.0))
-        (λ (n)
-           (and (flonum? n)
-                (or (infinite? n)
-                    (nan? n))))))
-(define normal-flonums/e-p
-  (cons (take/e (map/e
-                 ordinal->flonum
-                 flonum->ordinal
-                 integer/e)
-                (+ 1 (* 2 9218868437227405311)))
-        (λ (n)
-           (and (flonum? n)
-                (nor (infinite? n)
-                     (nan? n))))))
-(define float/e
-  (disj-sum/e #:append? #t
-              weird-flonums/e-p
-              normal-flonums/e-p))
-
-(define real/e
-  (disj-sum/e #:alternate? #t
-              (cons integer/e exact-integer?)
-              (cons float/e flonum?)))
-
-(define non-real/e
-  (map/e make-rectangular
-         (λ (z)
-            (values (real-part z)
-                    (imag-part z)))
-         real/e
-         (except/e real/e 0 0.0)))
-
-(define num/e
-  (disj-sum/e #:alternate? #t
-              (cons real/e real?)
-              (cons non-real/e complex?)))
-
-(define bool/e
-  (from-list/e '(#t #f)))
-
-(define var/e
-  (map/e
-   (compose string->symbol list->string)
-   (compose string->list symbol->string)
-   (many1/e char/e)))
-
-(define base/e
-  (disj-sum/e #:alternate? #t
-              (cons (const/e '()) null?)
-              (cons num/e number?)
-              (cons string/e string?)
-              (cons bool/e boolean?)
-              (cons var/e symbol?)))
-
-(define any/e
-  (fix/e +inf.f
-         (λ (any/e)
-            (disj-sum/e #:alternate? #t
-                        (cons base/e (negate pair?))
-                        (cons (cons/e any/e any/e) pair?)))))
-
-(define (flip f)
-  (λ (x y)
-     (f y x)))
diff --git a/pkgs/redex-pkgs/redex-lib/redex/private/enumerator.rkt b/pkgs/redex-pkgs/redex-lib/redex/private/enumerator.rkt
index 0783db2fd3..6f6b3f7fd1 100644
--- a/pkgs/redex-pkgs/redex-lib/redex/private/enumerator.rkt
+++ b/pkgs/redex-pkgs/redex-lib/redex/private/enumerator.rkt
@@ -8,6 +8,7 @@
          racket/promise
 
          data/gvector
+         math/flonum
 
          "error.rkt")
 
@@ -43,7 +44,17 @@
 
          nats/e
          range/e
-         nats+/e)
+         nats+/e
+
+         ;; Base type enumerators
+         any/e
+         var/e
+         var-prefix/e
+         num/e
+         integer/e
+         bool/e
+         real/e
+         string/e)
 
 ;; an enum a is a struct of < Nat or +Inf, Nat -> a, a -> Nat >
 (struct enum
@@ -817,3 +828,132 @@
              (map (λ (n)
                      (encode e (decode e n)))
                   nums)))))
+;; Base Type enumerators
+(define (between? x low high)
+  (and (>= x low)
+       (<= x high)))
+(define (range-with-pred/e-p low high)
+  (cons (range/e low high)
+        (λ (n) (between? n low high))))
+(define low/e-p
+  (range-with-pred/e-p #x61 #x7a))
+(define up/e-p
+  (range-with-pred/e-p #x41 #x5a))
+(define bottom/e-p
+  (range-with-pred/e-p #x0 #x40))
+(define mid/e-p
+  (range-with-pred/e-p #x5b #x60))
+(define above1/e-p
+  (range-with-pred/e-p #x7b #xd7FF))
+(define above2/e-p
+  (range-with-pred/e-p #xe000 #x10ffff))
+
+(define char/e
+  (map/e
+   integer->char
+   char->integer
+   (disj-sum/e #:append? #t
+               low/e-p
+               up/e-p
+               bottom/e-p
+               mid/e-p
+               above1/e-p
+               above2/e-p)))
+
+(define string/e
+  (map/e
+   list->string
+   string->list
+   (many/e char/e)))
+
+(define from-1/e
+  (map/e add1
+         sub1
+         nats/e))
+
+(define integer/e
+  (disj-sum/e #:alternate? #t
+              (cons (const/e 0) zero?)
+              (cons from-1/e (λ (n) (> n 0)))
+              (cons (map/e - - from-1/e)
+                    (λ (n) (< n 0)))))
+
+;; The last 3 here are -inf.0, +inf.0 and +nan.0
+;; Consider moving those to the beginning
+(define weird-flonums/e-p
+  (cons (from-list/e '(+inf.0 -inf.0 +nan.0))
+        (λ (n)
+           (and (flonum? n)
+                (or (infinite? n)
+                    (nan? n))))))
+(define normal-flonums/e-p
+  (cons (take/e (map/e
+                 ordinal->flonum
+                 flonum->ordinal
+                 integer/e)
+                (+ 1 (* 2 9218868437227405311)))
+        (λ (n)
+           (and (flonum? n)
+                (nor (infinite? n)
+                     (nan? n))))))
+(define float/e
+  (disj-sum/e #:append? #t
+              weird-flonums/e-p
+              normal-flonums/e-p))
+
+(define real/e
+  (disj-sum/e #:alternate? #t
+              (cons integer/e exact-integer?)
+              (cons float/e flonum?)))
+
+(define non-real/e
+  (map/e make-rectangular
+         (λ (z)
+            (values (real-part z)
+                    (imag-part z)))
+         real/e
+         (except/e real/e 0 0.0)))
+
+(define num/e
+  (disj-sum/e #:alternate? #t
+              (cons real/e real?)
+              (cons non-real/e complex?)))
+
+(define bool/e
+  (from-list/e '(#t #f)))
+
+(define var/e
+  (map/e
+   (compose string->symbol list->string)
+   (compose string->list symbol->string)
+   (many1/e char/e)))
+
+(define base/e
+  (disj-sum/e #:alternate? #t
+              (cons (const/e '()) null?)
+              (cons num/e number?)
+              (cons string/e string?)
+              (cons bool/e boolean?)
+              (cons var/e symbol?)))
+
+(define any/e
+  (fix/e +inf.f
+         (λ (any/e)
+            (disj-sum/e #:alternate? #t
+                        (cons base/e (negate pair?))
+                        (cons (cons/e any/e any/e) pair?)))))
+(define (var-prefix/e s)
+  (define as-str (symbol->string s))
+  (map/e (compose string->symbol
+                  (curry string-append as-str)
+                  symbol->string)
+         (compose string->symbol
+                  list->string
+                  (curry (flip drop) (string-length as-str))
+                  string->list
+                  symbol->string)
+         var/e))
+
+(define (flip f)
+  (λ (x y)
+     (f y x)))
diff --git a/pkgs/redex-pkgs/redex-lib/redex/private/preprocess-pat.rkt b/pkgs/redex-pkgs/redex-lib/redex/private/preprocess-pat.rkt
index d815369c0d..5036ae5b31 100644
--- a/pkgs/redex-pkgs/redex-lib/redex/private/preprocess-pat.rkt
+++ b/pkgs/redex-pkgs/redex-lib/redex/private/preprocess-pat.rkt
@@ -28,6 +28,7 @@
        (ann-pat (add-name subenv n subpat)
                 `(name ,n ,new-subpat))]
       [`(mismatch-name ,n ,subpat)
+       (unimplemented "mismatch")
        (match-define (ann-pat subenv new-subpat) (walk subpat))
        (define tag (get-and-inc!))
        (ann-pat (add-mismatch subenv n subpat tag)
diff --git a/pkgs/redex-pkgs/redex-test/redex/tests/enum-test.rkt b/pkgs/redex-pkgs/redex-test/redex/tests/enum-test.rkt
index 28118be448..6e27e92c86 100644
--- a/pkgs/redex-pkgs/redex-test/redex/tests/enum-test.rkt
+++ b/pkgs/redex-pkgs/redex-test/redex/tests/enum-test.rkt
@@ -95,15 +95,16 @@
 (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))
+;; No longer supported
+;; (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)
+;; (try-it 100 M m)
+;; (try-it 100 M n)
+;; (try-it 100 M p)
 
 ;; test variable filtering
 (define-language Vars