summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2021-01-17 23:30:18 -0800
committerKaz Kylheku <kaz@kylheku.com>2021-01-17 23:30:18 -0800
commitdb77030133ed9972314a532c75ea27465a064312 (patch)
treeac40eb62f234b2949077111279f477b3c5c7d43c
parent5378d3237ba7f9ba91d011536df3731d69516a5b (diff)
downloadtxr-db77030133ed9972314a532c75ea27465a064312.tar.gz
txr-db77030133ed9972314a532c75ea27465a064312.tar.bz2
txr-db77030133ed9972314a532c75ea27465a064312.zip
matcher: fix semantics of variables in @(or)
* share/txr/stdlib/match.tl (cmopile-parallel-match): Rearrange the code and bind an all-vars local variable so that in submatch-fun we have access to the set of symbols. When compiling the @(or) operator, we use the list to null out all the variables that don't belong to the matching pattern.
-rw-r--r--share/txr/stdlib/match.tl33
1 files changed, 19 insertions, 14 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl
index 0a975134..5c6038f5 100644
--- a/share/txr/stdlib/match.tl
+++ b/share/txr/stdlib/match.tl
@@ -242,20 +242,25 @@
(defun compile-parallel-match (par-pat obj-var)
(tree-bind (op . pats) par-pat
- (flet ((submatch-fun (pm)
- ^(let ,pm.(get-temps)
- ,pm.(wrap-guards
- ^(progn ,*pm.(assignments)
- (if ,pm.test-expr t))))))
- (let* ((par-matches (mapcar (op compile-match @1 obj-var) pats))
- (guard (new match-guard
- guard-expr ^(,op ,*[mapcar submatch-fun par-matches]))))
- (new compiled-match
- pattern par-pat
- obj-var obj-var
- guard-chain (list guard)
- test-expr t
- vars (uniq (mappend .vars par-matches)))))))
+ (let* ((par-matches (mapcar (op compile-match @1 obj-var) pats))
+ (all-vars (uniq (mappend .vars par-matches))))
+ (flet ((submatch-fun (pm)
+ ^(let ,pm.(get-temps)
+ ,pm.(wrap-guards
+ ^(progn ,*pm.(assignments)
+ (when ,pm.test-expr
+ ,*(if (eq op 'or)
+ (mapcar (ret ^(set ,@1 nil))
+ (diff all-vars pm.vars)))
+ t))))))
+ (let ((guard (new match-guard
+ guard-expr ^(,op ,*[mapcar submatch-fun par-matches]))))
+ (new compiled-match
+ pattern par-pat
+ obj-var obj-var
+ guard-chain (list guard)
+ test-expr t
+ vars (uniq (mappend .vars par-matches))))))))
(defun compile-match (pat : (obj-var (gensym)))
(cond