diff options
| -rw-r--r-- | share/txr/stdlib/match.tl | 26 | ||||
| -rw-r--r-- | txr.1 | 13 |
2 files changed, 23 insertions, 16 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl index 75f58db8..b8287c55 100644 --- a/share/txr/stdlib/match.tl +++ b/share/txr/stdlib/match.tl @@ -217,25 +217,31 @@ (defun compile-loop-match (exp obj-var var-list) (mac-param-bind *match-form* (op match) exp - (let* ((list-test (if (eq op 'usr:all*) 'consp 'listp)) + (let* ((all*-p (eq op 'usr:all*)) (some-p (eq op 'some)) (item-var (gensym "item-")) (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 all*-p (gensym "loop-iterated-p"))) (matched-p-var (gensym "matched-p-")) (iter-var (gensym "iter-")) (collect-vars [mapcar gensym cm.vars]) - (loop ^(for ((,iter-var ,obj-var) - (,loop-continue-p-var t)) - ((and ,loop-continue-p-var ,iter-var) - ,(if some-p - ^(not ,loop-continue-p-var) - loop-continue-p-var)) - ((set ,iter-var (cdr ,iter-var))) - (let ((,cm.obj-var (car ,iter-var)) + (loop ^(for ((,iter-var (iter-begin ,obj-var)) + (,loop-continue-p-var t) + ,*(if all*-p ^((,loop-iterated-var nil)))) + ((and ,loop-continue-p-var (iter-more ,iter-var)) + ,(cond + (some-p ^(not ,loop-continue-p-var)) + (all*-p ^(and ,loop-iterated-var + ,loop-continue-p-var)) + (t loop-continue-p-var))) + ((set ,iter-var (iter-step ,iter-var))) + (let ((,cm.obj-var (iter-item ,iter-var)) ,matched-p-var ,*(if some-p cm.(get-temps) cm.(get-vars))) + ,*(if all*-p + ^((set ,loop-iterated-var t))) ,cm.(wrap-guards ^(progn ,*cm.(assignments) (if ,cm.test-expr @@ -249,7 +255,7 @@ (set ,loop-continue-p-var nil))))) (guard (new match-guard vars (append cm.vars (unless some-p collect-vars)) - guard-expr ^(,list-test ,obj-var)))) + guard-expr ^(seqp ,obj-var)))) (new compiled-match pattern exp obj-var obj-var @@ -40058,10 +40058,11 @@ The .code all and .code all* -pattern operators require the corresponding object to be a list. +pattern operators require the corresponding object to be a sequence. + The specified .meta pattern -is applied against every element of the list. The match is successful if +is applied against every element of the sequence. The match is successful if .meta pattern matches every element. @@ -40076,13 +40077,13 @@ and .code all* is as follows. The .code all -operator respects the vacuous truth of the match when the list is empty. +operator respects the vacuous truth of the match when the sequence is empty. In that case, the match is successful, and the variables are all bound to the empty list .codn nil . In contrast, the alternative .code all* -operator behaves like a failed match when the list is empty. +operator behaves like a failed match when the sequence is empty. .TP* Examples: @@ -40103,10 +40104,10 @@ operator behaves like a failed match when the list is empty. .desc The .code some -pattern operator requires the corresponding object to be a list. +pattern operator requires the corresponding object to be a sequence. The specified .meta pattern -is applied against every element of the list. The match is successful if +is applied against every element of the sequence. The match is successful if .meta pattern finds a matching element. |