diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2021-01-17 23:30:18 -0800 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2021-01-17 23:30:18 -0800 |
commit | db77030133ed9972314a532c75ea27465a064312 (patch) | |
tree | ac40eb62f234b2949077111279f477b3c5c7d43c | |
parent | 5378d3237ba7f9ba91d011536df3731d69516a5b (diff) | |
download | txr-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.tl | 33 |
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 |