diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-01-29 21:59:23 -0800 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-01-29 21:59:23 -0800 |
| commit | 12c733c5f33b9a00714c9261441840b0be8fbd64 (patch) | |
| tree | 9e9cf4d206a70b74237da98b6485de45ef2c6da8 | |
| parent | 3e4bd9c5c461f9a963026211f15aeb6b24f7a456 (diff) | |
| download | txr-12c733c5f33b9a00714c9261441840b0be8fbd64.tar.gz txr-12c733c5f33b9a00714c9261441840b0be8fbd64.tar.bz2 txr-12c733c5f33b9a00714c9261441840b0be8fbd64.zip | |
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.
| -rw-r--r-- | share/txr/stdlib/match.tl | 28 |
1 files 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 |