From 1ef988938b33903891819febe7e2b804598b369b Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Thu, 21 Jan 2021 07:39:41 -0800 Subject: 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. --- share/txr/stdlib/match.tl | 12 +++++------- tests/011/patmatch.tl | 2 ++ 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) -- cgit v1.2.3