From dbf97f210b6f1c1503c017dc350d2c8983df5f73 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Thu, 21 Jan 2021 18:19:18 -0800 Subject: matcher: @(some) and @(all) work with sequences. Relax the restrictions in these operators so they work with sequences rather than specifically lists. * share/txr/stdlib/match.tl (compile-loop-match): Make the necessary adjustments so that abstract iteration is used. * txr.1: Documented. --- share/txr/stdlib/match.tl | 26 ++++++++++++++++---------- 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 diff --git a/txr.1 b/txr.1 index 90de24f1..ce6f045f 100644 --- a/txr.1 +++ b/txr.1 @@ -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. -- cgit v1.2.3