diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2021-01-15 07:27:10 -0800 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2021-01-15 07:27:10 -0800 |
commit | cb7e8aba2b75a419357fb33e235ecb86763177a2 (patch) | |
tree | 3f432f4f55c55efe00dc7cba023a16e62452e727 | |
parent | 7667fc940e6ee797770ba966d4d6df74a1e6a4e6 (diff) | |
download | txr-cb7e8aba2b75a419357fb33e235ecb86763177a2.tar.gz txr-cb7e8aba2b75a419357fb33e235ecb86763177a2.tar.bz2 txr-cb7e8aba2b75a419357fb33e235ecb86763177a2.zip |
matcher: some renaming in all match.
This is in anticipation of using the same function to compile
other patterns that involve iteration.
* share/txr/stdlib/match.tl (compile-all-match): Function
renamed to compile-loop-match. The successful match and loop
termination variables are renamed to different symbols.
Also, test for the usr:all* symbol explicitly rather than
all for making the test consp.
(compile-match): Follow function rename.
-rw-r--r-- | share/txr/stdlib/match.tl | 22 |
1 files changed, 12 insertions, 10 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl index 74026980..57206c0a 100644 --- a/share/txr/stdlib/match.tl +++ b/share/txr/stdlib/match.tl @@ -161,18 +161,20 @@ (push obj-var match.var-exprs) match))) -(defun compile-all-match (exp obj-var) +(defun compile-loop-match (exp obj-var) (tree-bind (op match) exp - (let* ((list-test (if (eq op 'all) 'listp 'consp)) + (let* ((list-test (if (eq op 'usr:all*) 'consp 'listp)) (item-var (gensym "item-")) (cm (compile-match match item-var)) - (all-match-p-var (gensym "all-match-p-")) + (loop-success-p-var (gensym "loop-success-p-")) + (loop-continue-p-var (gensym "loop-terminate-p")) (matched-p-var (gensym "matched-p-")) (iter-var (gensym "iter-")) (collect-vars [mapcar gensym cm.vars]) (loop ^(for ((,iter-var ,obj-var) - (,all-match-p-var t)) - ((and ,all-match-p-var ,iter-var) ,all-match-p-var) + (,loop-continue-p-var t)) + ((and ,loop-continue-p-var ,iter-var) + ,loop-continue-p-var) ((set ,iter-var (cdr ,iter-var))) (let ((,cm.obj-var (car ,iter-var)) ,matched-p-var @@ -186,16 +188,16 @@ cm.vars collect-vars))))) (unless ,matched-p-var - (set ,all-match-p-var nil))))) + (set ,loop-continue-p-var nil))))) (guard (new match-guard - vars (cons all-match-p-var collect-vars) + vars (cons loop-success-p-var collect-vars) var-exprs (list loop) guard-expr ^(,list-test ,obj-var)))) (new compiled-match pattern exp obj-var obj-var guard-chain (list guard) - test-expr all-match-p-var + test-expr loop-success-p-var vars cm.vars var-exprs (mapcar (ret ^(nreverse ,@1)) collect-vars))))) @@ -210,8 +212,8 @@ (struct (compile-struct-match exp obj-var)) (require (compile-require-match exp obj-var)) (let (compile-let-match exp obj-var)) - (all (compile-all-match exp obj-var)) - (usr:all* (compile-all-match exp obj-var)) + (all (compile-loop-match exp obj-var)) + (usr:all* (compile-loop-match exp obj-var)) (t (compile-predicate-match exp obj-var))) (compile-error *match-form* "unrecognized pattern syntax ~s" pat)))) |