From 4b8e5bebc5d47507192ae2adef4345a47caa33cc Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Thu, 28 Jan 2021 19:39:22 -0800
Subject: matcher: remove duplicate variables in one place.

* share/txr/stdlib/match.tl (compiled-match get-var-exprs):
method get-var-exprs removed. This is only used in one place,
which is going away. Actually, the value is not even used; it
is discarded.
(compiled-match get-vars): This method now passes the list of
variables thorugh uniq. The logic of get-guard-values is
pulled into a local function, since get-guard-values has only
one caller now.
(get-guard-values): Function removed.
(compile-or-match): Removing all-var-exprs variable
and all that calculation of the unique names, as well as the
extra match-guard which duplicates those names pointlessly.
---
 share/txr/stdlib/match.tl | 32 +++++++++++---------------------
 1 file changed, 11 insertions(+), 21 deletions(-)

diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl
index 5105bd2e..920ca14e 100644
--- a/share/txr/stdlib/match.tl
+++ b/share/txr/stdlib/match.tl
@@ -52,10 +52,16 @@
   guard-chain
 
   (:method get-vars (me)
-    (get-guard-values me.guard-chain .vars))
-
-  (:method get-var-exprs (me)
-    (get-guard-values me.guard-chain .var-exprs))
+    (labels ((getv (gc)
+               (append-each ((g gc))
+                 (typecase g
+                   (match-guard
+                     g.vars)
+                   (guard-disjunction
+                     (append-each ((gc g.guard-chains)) (getv gc)))
+                   (t (compile-error *match-form*
+                                     "internal error: bad guard ~s" g))))))
+      (uniq (getv me.guard-chain))))
 
   (:method wrap-guards (me . forms)
     (labels ((wrg (rgc exp)
@@ -115,16 +121,6 @@
   (:method exists (me sym) (member sym me.vars))
   (:method record (me sym) (push sym me.vars)))
 
-(defun get-guard-values (guard-chain fun)
-  (append-each ((g guard-chain))
-    (typecase g
-      (match-guard
-        [fun g])
-      (guard-disjunction
-        (append-each ((gc g.guard-chains))
-          (get-guard-values gc fun)))
-      (t (compile-error *match-form* "internal error: bad guard ~s" g)))))
-
 (defun compile-struct-match (struct-pat obj-var var-list)
   (mac-param-bind *match-form* (op required-type . pairs) struct-pat
     (let* ((loose-p (not (bindable required-type)))
@@ -377,19 +373,13 @@
     (let* ((var-lists (mapcar (ret (copy var-list)) pats))
            (par-matches (mapcar (op compile-match @1 obj-var @2)
                                 pats var-lists))
-           (all-var-exprs [unique [mapcar cons
-                                          (mappend .(get-vars) par-matches)
-                                          (mappend .(get-var-exprs) par-matches)]
-                                  car])
-           (guard (new match-guard
-                       vars [mapcar car all-var-exprs]))
            (dj-guard (new guard-disjunction
                           guard-chains (mapcar .guard-chain par-matches)
                           sub-patterns par-matches)))
       (new compiled-match
            pattern par-pat
            obj-var obj-var
-           guard-chain (list guard dj-guard)))))
+           guard-chain (list dj-guard)))))
 
 (defun compile-and-match (par-pat obj-var var-list)
   (mac-param-bind *match-form* (op . pats) par-pat
-- 
cgit v1.2.3