diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-01-15 07:39:10 -0800 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-01-15 07:39:10 -0800 |
| commit | 5121a71dd6f8280583127e6e6733ec094b642f6a (patch) | |
| tree | d71910f007d4fb2ced19a9c981ee97c09cefd964 | |
| parent | ee9a0ee5848a3b98a7a52cbe56dbaaeb35734cc7 (diff) | |
| download | txr-5121a71dd6f8280583127e6e6733ec094b642f6a.tar.gz txr-5121a71dd6f8280583127e6e6733ec094b642f6a.tar.bz2 txr-5121a71dd6f8280583127e6e6733ec094b642f6a.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.tl | 12 |
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)))) |