summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2021-01-19 07:52:19 -0800
committerKaz Kylheku <kaz@kylheku.com>2021-01-19 07:52:19 -0800
commite37f1ea87a68cffdfb64d0bd9cd29404d1455757 (patch)
treea476d8e346047a591fc0095aa6be9c11213f2615
parent1236298b23b17937829e58a63e7d9e13059e49f8 (diff)
downloadtxr-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.tl24
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