summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2021-01-22 00:17:46 -0800
committerKaz Kylheku <kaz@kylheku.com>2021-01-22 00:17:46 -0800
commita5f90cf8a467ac8817ab3db5c9f8190b7a547d67 (patch)
tree872f4521ff5fbf3575075a2348ee532c39ab2590
parent16094ab126996e3963561b520ff22b405b56ca61 (diff)
downloadtxr-a5f90cf8a467ac8817ab3db5c9f8190b7a547d67.tar.gz
txr-a5f90cf8a467ac8817ab3db5c9f8190b7a547d67.tar.bz2
txr-a5f90cf8a467ac8817ab3db5c9f8190b7a547d67.zip
matcher: existing variables in @(all) now backref.
This commit fixes the inadequacy that all variables occurring in a pattern under @(all ...) or @(coll ...) are blindly collated into lists, ignoring the fact that they may be previously bound variables that must back-reference and not be colleced into lists (just like in the TXR Pattern language!) * share/txr/stdlib/match.tl (compile-loop-match): Calculate the subset of variables in the pattern that have been freshly bound. Only generate the collection gensyms for those variables and only collect and nreverse those variables. * tests/011/patmatch.tl: Some test cases that backreference into an @(all). * txr.1: Documented.
-rw-r--r--share/txr/stdlib/match.tl12
-rw-r--r--tests/011/patmatch.tl4
-rw-r--r--txr.129
3 files changed, 37 insertions, 8 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl
index b95fc627..8cb29622 100644
--- a/share/txr/stdlib/match.tl
+++ b/share/txr/stdlib/match.tl
@@ -221,13 +221,15 @@
(some-p (eq op 'some))
(coll-p (eq op 'coll))
(item-var (gensym "item-"))
+ (in-vars var-list.vars)
(cm (compile-match match item-var var-list))
(loop-success-p-var (gensym "loop-success-p-"))
(loop-continue-p-var (gensym "loop-terminate-p"))
(loop-iterated-var (if no-vac-p (gensym "loop-iterated-p")))
(matched-p-var (gensym "matched-p-"))
(iter-var (gensym "iter-"))
- (collect-vars [mapcar gensym cm.vars])
+ (collect-vars (diff cm.vars in-vars))
+ (collect-gens [mapcar gensym collect-vars])
(loop ^(for ((,iter-var (iter-begin ,obj-var))
(,loop-continue-p-var t)
,*(if no-vac-p ^((,loop-iterated-var nil))))
@@ -250,12 +252,12 @@
^((set ,loop-iterated-var t)))
,*(unless some-p
(mapcar (ret ^(push ,@1 ,@2))
- cm.vars
- collect-vars))))))
+ collect-vars
+ collect-gens))))))
,(unless coll-p ^(,(if some-p 'when 'unless) ,matched-p-var
(set ,loop-continue-p-var nil))))))
(guard (new match-guard
- vars (append cm.vars (unless some-p collect-vars))
+ vars (append cm.vars (unless some-p collect-gens))
guard-expr ^(seqp ,obj-var))))
(new compiled-match
pattern exp
@@ -267,7 +269,7 @@
loop-success-p-var
^(when ,loop-success-p-var
,*(mapcar (ret ^(set ,@1 (nreverse ,@2)))
- cm.vars collect-vars)
+ collect-vars collect-gens)
t))))))
(defun compile-parallel-match (par-pat obj-var var-list)
diff --git a/tests/011/patmatch.tl b/tests/011/patmatch.tl
index 11a6a933..2b1e26c8 100644
--- a/tests/011/patmatch.tl
+++ b/tests/011/patmatch.tl
@@ -54,6 +54,10 @@
(list a b))
((1 2 3) (a b c)))
+(test (when-match (@x @(all @x)) '(1 (1 1 1 1)) x) 1)
+
+(test (when-match (@x @(all @x)) '(1 (1 1 1 2)) x) nil)
+
(test (when-match @(some (x @a @b)) '((y 1 a) (x 2 b) (z 3 c))
(list a b))
(2 b))
diff --git a/txr.1 b/txr.1
index e2f88973..45800d08 100644
--- a/txr.1
+++ b/txr.1
@@ -40066,10 +40066,15 @@ is applied against every element of the sequence. The match is successful if
.meta pattern
matches every element.
-Furthermore, in the case of a successful match, these operators take
-each of the variables specified in the
+Furthermore, in the case of a successful match, each variable that
+is freshly bound by
.meta pattern
-and bind it to a list of the elements which that variable matched.
+is converted into a list of all of the objects which that variable
+encounters from all elements of the sequence. Those variables which already
+have a binding from another
+.meta pattern
+are not converted to lists. Their existing values are merely required to match
+each corresponding object they encounter.
The difference between
.code all
@@ -40095,6 +40100,15 @@ operator behaves like a failed match when the sequence is empty.
'((x 1 a) (x 2 b) (x 3 c))
(list a b))
--> ((1 2 3) (a b c))
+
+ ;; Match a two element list whose second element
+ ;; consists of nothing but zero or more repetitions
+ ;; of the first element. x is not turned into a list
+ ;; because it has a binding due to @x.
+ (when-match @(@x @(all x)) '(1 (1 1 1 1)) x) -> 1
+
+ ;; no match because of the 2
+ (when-match @(@x @(all x)) '(1 (1 1 1 2)) x) -> nil
.brev
.coNP Pattern operator @ some
@@ -40139,6 +40153,15 @@ is applied against every element of the sequence. The match is successful if
.meta pattern
matches at least one element.
+Each variable that is freshly bound by the
+.meta pattern
+is converted into a list of all of the objects which that variable
+encounters from the matching elements of the sequence. Those variables which
+already have a binding from another
+.meta pattern
+are not converted to lists. Their existing values are merely required to match
+each corresponding object they encounter.
+
Variables are extracted from all matching elements, and collected into
parallel lists, just like with the
.code @(all)