summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2021-01-15 07:39:10 -0800
committerKaz Kylheku <kaz@kylheku.com>2021-01-15 07:39:10 -0800
commit2d9d10ad41490e7bb58cc74af357a52373c0ed5e (patch)
treed71910f007d4fb2ced19a9c981ee97c09cefd964
parentcb7e8aba2b75a419357fb33e235ecb86763177a2 (diff)
downloadtxr-2d9d10ad41490e7bb58cc74af357a52373c0ed5e.tar.gz
txr-2d9d10ad41490e7bb58cc74af357a52373c0ed5e.tar.bz2
txr-2d9d10ad41490e7bb58cc74af357a52373c0ed5e.zip
matcher: support @(some pat) operator.
This is the existential quantifier to accompany @(all). * share/txr/stdlib/match.tl (compile-loop-match): Check for the some symbol in a few places and adjust the output. We don't need a local binding of the patter's variables, only the temps. The values go directly to the outer binding of the variables which are not shadowed now. We also don't need the nreverse logic to set the outer variables: var-exprs is nil at the outer level. The polarity of the loop termination test is reversed: we quit the loop on the first match, as is the polarity of the return value: if the loop is aborted early t is returned instead of nil. (compile-match): Wire in the some operator.
-rw-r--r--share/txr/stdlib/match.tl12
1 files changed, 8 insertions, 4 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl
index 57206c0a..3af557e6 100644
--- a/share/txr/stdlib/match.tl
+++ b/share/txr/stdlib/match.tl
@@ -174,11 +174,13 @@
(loop ^(for ((,iter-var ,obj-var)
(,loop-continue-p-var t))
((and ,loop-continue-p-var ,iter-var)
- ,loop-continue-p-var)
+ ,(if (eq op 'some)
+ ^(not ,loop-continue-p-var)
+ loop-continue-p-var))
((set ,iter-var (cdr ,iter-var)))
(let ((,cm.obj-var (car ,iter-var))
,matched-p-var
- ,*cm.(get-vars))
+ ,*(if (eq op 'some) cm.(get-temps) cm.(get-vars)))
,cm.(wrap-guards
^(progn ,*cm.(assignments)
(if ,cm.test-expr
@@ -187,7 +189,7 @@
,*(mapcar (ret ^(push ,@1 ,@2))
cm.vars
collect-vars)))))
- (unless ,matched-p-var
+ (,(if (eq op 'some) 'when 'unless) ,matched-p-var
(set ,loop-continue-p-var nil)))))
(guard (new match-guard
vars (cons loop-success-p-var collect-vars)
@@ -199,7 +201,8 @@
guard-chain (list guard)
test-expr loop-success-p-var
vars cm.vars
- var-exprs (mapcar (ret ^(nreverse ,@1)) collect-vars)))))
+ var-exprs (unless (eq op 'some)
+ (mapcar (ret ^(nreverse ,@1)) collect-vars))))))
(defun compile-match (pat : (obj-var (gensym)))
(cond
@@ -214,6 +217,7 @@
(let (compile-let-match exp obj-var))
(all (compile-loop-match exp obj-var))
(usr:all* (compile-loop-match exp obj-var))
+ (some (compile-loop-match exp obj-var))
(t (compile-predicate-match exp obj-var)))
(compile-error *match-form*
"unrecognized pattern syntax ~s" pat))))