From 12c733c5f33b9a00714c9261441840b0be8fbd64 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 29 Jan 2021 21:59:23 -0800
Subject: matcher: prune @nil in cons and vector matches.

Elimination of unused temporaries is really the job of the
compiler, but we can do some simple things to get better code
from the matcher in the meanwhile. In list and vector matches,
@nil gets used just for placeholding. We can avoid generating
the code which binds the corresponding value to an unused
gensym.

share/txr/stdlib/match.tl (compile-var-match): When the
variable is nil, then do not generate a match-guard with
empty content. Just generate an empty guard-chain.
The higher level compiler can then check for this empty guard
chain and prune its own material away.
(compile-vec-match, compile-cons-structure): Eliminate every
gensym and its initializing expression, whose corresponding
compiled sub-match has an empty guard chain.
---
 share/txr/stdlib/match.tl | 28 +++++++++++++++++++---------
 1 file changed, 19 insertions(+), 9 deletions(-)

diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl
index 8c7a4fcf..8518d68f 100644
--- a/share/txr/stdlib/match.tl
+++ b/share/txr/stdlib/match.tl
@@ -179,9 +179,9 @@
        (new compiled-match
             pattern sym
             obj-var obj-var
-            guard-chain (list (new match-guard
-                                   vars (if sym (list sym))
-                                   var-exprs (if sym (list obj-var))))))
+            guard-chain (if sym (list (new match-guard
+                                           vars (list sym)
+                                           var-exprs (list obj-var))))))
     (t (new compiled-match
             pattern sym
             obj-var obj-var
@@ -190,12 +190,16 @@
 
 (defun compile-vec-match (vec-pat obj-var var-list)
   (let* ((elem-gensyms (mapcar (op gensym `elem-@1-`) (range* 0 (len vec-pat))))
+         (elem-exprs (mapcar (ret ^[,obj-var ,@1]) (range* 0 (len vec-pat))))
          (elem-matches (list-vec [mapcar (lop compile-match var-list)
-                                         vec-pat elem-gensyms]))
+                                         vec-pat elem-gensyms])) 
+         (pruned-triple (multi (op keep-if .guard-chain @1 third)
+                               elem-gensyms
+                               elem-exprs
+                               elem-matches))
          (guard (new match-guard
-                     pure-temps elem-gensyms
-                     pure-temp-exprs (mapcar (ret ^[,obj-var ,@1])
-                                            (range* 0 (len vec-pat)))
+                     pure-temps (first pruned-triple)
+                     pure-temp-exprs (second pruned-triple)
                      guard-expr ^(and (vectorp ,obj-var)
                                       (eql (len ,obj-var) ,(len vec-pat))))))
     (new compiled-match
@@ -283,8 +287,14 @@
                           (t (compile-cons-structure cdr cdr-gensym var-list)))
                         (compile-atom-match cdr cdr-gensym var-list)))
            (guard (new match-guard
-                       pure-temps ^(,car-gensym ,cdr-gensym)
-                       pure-temp-exprs ^((car ,obj-var) (cdr ,obj-var))
+                       pure-temps (append (if car-match.guard-chain
+                                            (list car-gensym))
+                                          (if cdr-match.guard-chain
+                                            (list cdr-gensym)))
+                       pure-temp-exprs (append (if car-match.guard-chain
+                                                 ^((car ,obj-var)))
+                                               (if cdr-match.guard-chain
+                                                 ^((cdr ,obj-var))))
                        guard-expr ^(consp ,obj-var))))
       (new compiled-match
            pattern cons-pat
-- 
cgit v1.2.3