From 4894e2b28c3bd72913bcc3c732297a2c1046cd74 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Mon, 1 Feb 2021 19:45:12 -0800
Subject: matcher: struct: make guards lists; eliminate backquote.

* share/txr/stdlib/match.tl (compile-struct-match): make
guard0 and guard1 lists match-guard items. Replace
backquote with straight append.
---
 share/txr/stdlib/match.tl | 28 +++++++++++++++-------------
 1 file changed, 15 insertions(+), 13 deletions(-)

diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl
index 2c47ca2a..ab2a3398 100644
--- a/share/txr/stdlib/match.tl
+++ b/share/txr/stdlib/match.tl
@@ -139,19 +139,20 @@
                           slot-matches))
            (slot-val-exprs [mapcar (ret ^(slot ,obj-var ',@1)) required-slots])
            (guard0 (if loose-p
-                     (new match-guard
-                          pure-temps (list type-gensym)
-                          pure-temp-exprs (list ^(struct-type ,obj-var))
-                          guard-expr ^(structp ,obj-var))))
-           (guard1 (new match-guard
-                        pure-temps slot-gensyms
-                        pure-temp-exprs slot-val-exprs
-                        guard-expr (if loose-p
-                                     ^(and ,*(mapcar
-                                               (ret ^(slotp ,type-gensym ',@1))
+                     (list (new match-guard
+                                pure-temps (list type-gensym)
+                                pure-temp-exprs (list ^(struct-type ,obj-var))
+                                guard-expr ^(structp ,obj-var)))))
+           (guard1 (list (new match-guard
+                              pure-temps slot-gensyms
+                              pure-temp-exprs slot-val-exprs
+                              guard-expr (if loose-p
+                                           ^(and ,*(mapcar
+                                                     (ret ^(slotp ,type-gensym
+                                                                  ',@1))
                                                required-slots))
                                      ^(subtypep (typeof ,obj-var)
-                                                ',required-type)))))
+                                                ',required-type))))))
       (unless loose-p
         (let ((type (find-struct-type required-type)))
           (if type
@@ -166,8 +167,9 @@
       (new compiled-match
            pattern struct-pat
            obj-var obj-var
-           guard-chain ^(,*(if guard0 (list guard0)) ,guard1
-                         ,*(mappend .guard-chain all-matches))))))
+           guard-chain (append guard0
+                               guard1
+                               (mappend .guard-chain all-matches))))))
 
 (defun compile-var-match (sym obj-var var-list)
   (or (null sym) (bindable sym)
-- 
cgit v1.2.3