diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2021-01-19 07:52:19 -0800 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2021-01-19 07:52:19 -0800 |
commit | e37f1ea87a68cffdfb64d0bd9cd29404d1455757 (patch) | |
tree | a476d8e346047a591fc0095aa6be9c11213f2615 | |
parent | 1236298b23b17937829e58a63e7d9e13059e49f8 (diff) | |
download | txr-e37f1ea87a68cffdfb64d0bd9cd29404d1455757.tar.gz txr-e37f1ea87a68cffdfb64d0bd9cd29404d1455757.tar.bz2 txr-e37f1ea87a68cffdfb64d0bd9cd29404d1455757.zip |
matcher: fix broken @(some) test case.
* share/txr/stdlib/match.tl (compile-loop-match): Introduce a
new guard, and bind the pattern's variables there. The main
compiled match now has an empty list of vars and var-exprs,
so there is no length mismatch. The nreversing of the
accumulated lists (only done in the @(and) case) is part of
the test-expr now.
-rw-r--r-- | share/txr/stdlib/match.tl | 24 |
1 files changed, 14 insertions, 10 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl index b1db1f2d..7f17def5 100644 --- a/share/txr/stdlib/match.tl +++ b/share/txr/stdlib/match.tl @@ -226,19 +226,23 @@ collect-vars)))))) (,(if some-p 'when 'unless) ,matched-p-var (set ,loop-continue-p-var nil))))) - (guard (new match-guard - vars (cons loop-success-p-var (unless some-p - collect-vars)) - var-exprs (list loop) - guard-expr ^(,list-test ,obj-var)))) + (guard0 (new match-guard + vars (append cm.vars (unless some-p collect-vars)) + guard-expr t)) + (guard1 (new match-guard + vars (list loop-success-p-var) + var-exprs (list loop) + guard-expr ^(,list-test ,obj-var)))) (new compiled-match pattern exp obj-var obj-var - guard-chain (list guard) - test-expr loop-success-p-var - vars cm.vars - var-exprs (unless some-p - (mapcar (ret ^(nreverse ,@1)) collect-vars)))))) + guard-chain (list guard0 guard1) + test-expr (if some-p + loop-success-p-var + ^(when ,loop-success-p-var + ,*(mapcar (ret ^(set ,@1 (nreverse ,@2))) + cm.vars collect-vars) + t)))))) (defun compile-parallel-match (par-pat obj-var) (tree-bind (op . pats) par-pat |