summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2021-01-21 07:39:41 -0800
committerKaz Kylheku <kaz@kylheku.com>2021-01-21 07:39:41 -0800
commit1ef988938b33903891819febe7e2b804598b369b (patch)
tree773b30d4bda430acc49f2e32a053d98ca511c3fd
parent625a22dbae0b10eb03cbbbef0fb3a1457f916d7a (diff)
downloadtxr-1ef988938b33903891819febe7e2b804598b369b.tar.gz
txr-1ef988938b33903891819febe7e2b804598b369b.tar.bz2
txr-1ef988938b33903891819febe7e2b804598b369b.zip
matcher: matcher: fix broken @(let @a @(some @a)).
* share/txr/stdlib/match.tl (compile-parallel-match): Just like what was done in compile-loop-match in the prior commit, we fix the situation here. guard1's guard-expr, in which the matching logic actually happens, becomes the main test-expr. Thus guard1 disappears and guard0 is renamed to the one and only guard. * tests/011/patmatch.tl: Added test case which is fixed by this.
-rw-r--r--share/txr/stdlib/match.tl12
-rw-r--r--tests/011/patmatch.tl2
2 files changed, 7 insertions, 7 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl
index e59cb156..75f58db8 100644
--- a/share/txr/stdlib/match.tl
+++ b/share/txr/stdlib/match.tl
@@ -278,16 +278,14 @@
(mapcar (ret ^(set ,@1 nil))
(diff all-vars pm.vars)))
t))))))
- (let ((guard0 (new match-guard
- guard-expr t
- vars all-vars))
- (guard1 (new match-guard
- guard-expr ^(,op ,*[mapcar submatch-fun par-matches]))))
+ (let ((guard (new match-guard
+ guard-expr t
+ vars all-vars)))
(new compiled-match
pattern par-pat
obj-var obj-var
- guard-chain (list guard0 guard1)
- test-expr t))))))
+ guard-chain (list guard)
+ test-expr ^(,op ,*[mapcar submatch-fun par-matches])))))))
(defun compile-not-match (pattern obj-var var-list)
(mac-param-bind *match-form* (op pattern) pattern
diff --git a/tests/011/patmatch.tl b/tests/011/patmatch.tl
index 84d59381..42e9bd9a 100644
--- a/tests/011/patmatch.tl
+++ b/tests/011/patmatch.tl
@@ -90,3 +90,5 @@
(test (when-match @(let a @(some @a)) '#1=(1 2 #1# 3) :yes) :yes)
(test (when-match (@a @(let a @(some @a))) '(#1=(1 2 #1# 3) #1#) :yes) :yes)
+
+(test (when-match (@a @(let a @(or x @a))) '(#1=(1 2 #1# 3) #1#) :yes) :yes)