From 63c05d6cf5bbaadb3607e7f0107640eed33b733f Mon Sep 17 00:00:00 2001
From: Max New <maxsnew@gmail.com>
Date: Wed, 16 Oct 2013 15:28:18 -0500
Subject: [PATCH] Use new match-a-pattern macro where appropriate

---
 .../redex/private/preprocess-lang.rkt         | 27 ++++++++++++-------
 .../redex/private/preprocess-pat.rkt          | 18 ++++++++-----
 2 files changed, 30 insertions(+), 15 deletions(-)

diff --git a/pkgs/redex-pkgs/redex-lib/redex/private/preprocess-lang.rkt b/pkgs/redex-pkgs/redex-lib/redex/private/preprocess-lang.rkt
index 9e90e33958..ce51bdd615 100644
--- a/pkgs/redex-pkgs/redex-lib/redex/private/preprocess-lang.rkt
+++ b/pkgs/redex-pkgs/redex-lib/redex/private/preprocess-lang.rkt
@@ -57,10 +57,9 @@
         (λ (rhs)
            (let loop ([pat (rhs-pattern rhs)]
                       [s (set)])
-             (match
+             (match-a-pattern/single-base-case
                pat
-               [`(nt ,id)
-                (set-add s id)]
+               
                [`(name ,name ,pat)
                 (loop pat s)]
                [`(mismatch-name ,name ,pat)
@@ -69,6 +68,7 @@
                 (set-union (loop p1 s)
                            (loop p2 s))]
                [`(hide-hole ,p) (loop p s)]
+               [`(side-condition ,p ,_ ,_) (loop p s)]
                [`(list ,sub-pats ...)
                 (fold-map/set
                  (λ (sub-pat)
@@ -77,7 +77,11 @@
                        (loop pat s)]
                       [else (loop sub-pat s)]))
                  sub-pats)]
-               [else s])))
+               [_ (match pat
+                    [`(nt ,id)
+                     (set-add s id)]
+                    [_ s])
+                  ])))
         (nt-rhs nt))))
    (hash)
    lang))
@@ -217,16 +221,19 @@
 
 ;; directly-used-nts : pat -> (setof symbol)
 (define (directly-used-nts pat)
-  (match pat
-    [`(nt ,id) (set id)]
-    [(or `(name ,n ,p)
-         `(mismatch-name ,n ,p))
+  (match-a-pattern/single-base-case pat
+                                    
+    [`(name ,n ,p)
+     (directly-used-nts p)]
+    [`(mismatch-name ,n ,p)
      (directly-used-nts p)]
     [`(in-hole ,p1 ,p2)
      (set-union (directly-used-nts p1)
                 (directly-used-nts p2))]
     [`(hide-hole ,p)
      (directly-used-nts p)]
+    [`(side-condition ,p ,c ,v)
+     (directly-used-nts p)]
     [`(list ,sub-pats ...)
      (fold-map/set
       (λ (sub-pat)
@@ -236,7 +243,9 @@
            [`(repeat ,p ,n ,m) (set)]
            [else (directly-used-nts sub-pat)]))
       sub-pats)]
-    [else (set)]))
+    [_ (match pat
+         [`(nt ,id) (set id)]
+         [_ (set)])]))
 
 ;; used-vars : lang -> (listof symbol)
 (define (used-vars lang)
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 6230a6f7b0..8a06b1208a 100644
--- a/pkgs/redex-pkgs/redex-lib/redex/private/preprocess-pat.rkt
+++ b/pkgs/redex-pkgs/redex-lib/redex/private/preprocess-pat.rkt
@@ -43,7 +43,7 @@
     (and (not (set-member? badnames name))
          name))
   (define (strip pat)
-    (match pat
+    (match-a-pattern/single-base-case pat
       [`(name ,n ,subpat)
        (strip-named n subpat (λ (n s) `(name ,n ,s)))]
       [`(mismatch-name ,n ,subpat)
@@ -53,6 +53,8 @@
                  ,(strip p2))]
       [`(hide-hole ,p)
        `(hide-hole ,(strip p))]
+      [`(side-condition ,p ,c ,s)
+       `(side-condition ,(strip p) ,c ,s)]
       [`(list ,sub-pats ...)
        (cons 'list
              (map (match-lambda
@@ -63,13 +65,15 @@
                     `(repeat ,sub ,s-n ,s-m)]
                    [sub-pat (strip sub-pat)])
                   sub-pats))]
-      [else pat]))
+      [_ pat]))
   (strip pat))
 
 (define (find-names pat)
-  (match pat
-    [(or `(name ,n ,subpat)
-         `(mismatch ,n ,subpat))
+  (match-a-pattern/single-base-case pat
+    [`(name ,n ,subpat)
+     (2set-add (find-names subpat)
+               n)]
+    [`(mismatch-name ,n ,subpat)
      (2set-add (find-names subpat)
                n)]
     [`(in-hole ,p1 ,p2)
@@ -77,6 +81,8 @@
                  (find-names p2))]
     [`(hide-hole ,p)
      (find-names p)]
+    [`(side-condition ,p ,c ,s)
+     (find-names p)]
     [`(list ,sub-pats ...)
      (foldr 2set-union
             2set-empty
@@ -85,4 +91,4 @@
                    (2set-add (find-names p) n m)]
                   [sub-pat (find-names sub-pat)])
                  sub-pats))]
-    [else 2set-empty]))
+    [_ 2set-empty]))