From a5f90cf8a467ac8817ab3db5c9f8190b7a547d67 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Fri, 22 Jan 2021 00:17:46 -0800 Subject: 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. --- share/txr/stdlib/match.tl | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) (limited to 'share') 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) -- cgit v1.2.3