diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2021-01-22 00:17:46 -0800 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2021-01-22 00:17:46 -0800 |
commit | a5f90cf8a467ac8817ab3db5c9f8190b7a547d67 (patch) | |
tree | 872f4521ff5fbf3575075a2348ee532c39ab2590 | |
parent | 16094ab126996e3963561b520ff22b405b56ca61 (diff) | |
download | txr-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.tl | 12 | ||||
-rw-r--r-- | tests/011/patmatch.tl | 4 | ||||
-rw-r--r-- | txr.1 | 29 |
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)) @@ -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) |