diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2021-01-26 00:46:57 -0800 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2021-01-26 00:46:57 -0800 |
commit | deae97f0dfdf0ea33bba2912f05bb6b350553b94 (patch) | |
tree | 7d7a344efe14c3c5acb861870d07d71038f1face | |
parent | 030f25146ff5d2f6671ef1b615fc4217004632e5 (diff) | |
download | txr-deae97f0dfdf0ea33bba2912f05bb6b350553b94.tar.gz txr-deae97f0dfdf0ea33bba2912f05bb6b350553b94.tar.bz2 txr-deae97f0dfdf0ea33bba2912f05bb6b350553b94.zip |
matcher: allow pat/var argument: @[expr var pat]
* share/txr/stdlib/match.tl (compile-dwim-predicate-match):
Drop redundant bindable check of sym, since compile-var-match
checks this. Support third argument which gives a pattern or
variable which captures the value from the predicate function,
which might be interesting (not just true/false).
* tests/011/patmatch.tl: New tests.
* txr.1: Documented.
-rw-r--r-- | share/txr/stdlib/match.tl | 26 | ||||
-rw-r--r-- | tests/011/patmatch.tl | 8 | ||||
-rw-r--r-- | txr.1 | 39 |
3 files changed, 60 insertions, 13 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl index 00918f37..04118c64 100644 --- a/share/txr/stdlib/match.tl +++ b/share/txr/stdlib/match.tl @@ -195,12 +195,28 @@ var-match)) (defun compile-dwim-predicate-match (pred-expr obj-var var-list) - (mac-param-bind *match-form* (dwim fun : sym) pred-expr - (or (null sym) (bindable sym) - (compile-error *match-form* "~s is not a symbol" sym)) + (mac-param-bind *match-form* (dwim fun : sym pat) pred-expr (let ((var-match (compile-var-match sym obj-var var-list))) - (set var-match.test-expr ^(and ,var-match.test-expr [,fun ,obj-var])) - var-match))) + (if pat + (let* ((pat-match (if (symbolp pat) + (compile-var-match pat (gensym) var-list) + (compile-match pat (gensym) var-list))) + (guard (new match-guard + vars (list pat-match.obj-var) + var-exprs (list ^[,fun ,obj-var])))) + (new compiled-match + pattern pred-expr + obj-var obj-var + guard-chain (cons guard (append var-match.guard-chain + pat-match.guard-chain)) + vars (append var-match.vars pat-match.vars) + var-exprs (append var-match.var-exprs pat-match.var-exprs) + test-expr ^(and ,var-match.test-expr + ,pat-match.test-expr + ,pat-match.obj-var))) + (progn + (set var-match.test-expr ^(and ,var-match.test-expr [,fun ,obj-var])) + var-match))))) (defun compile-predicate-match (pred-expr obj-var var-list) (mac-param-bind *match-form* (fun : sym) pred-expr diff --git a/tests/011/patmatch.tl b/tests/011/patmatch.tl index c9326eda..784588ad 100644 --- a/tests/011/patmatch.tl +++ b/tests/011/patmatch.tl @@ -147,3 +147,11 @@ (test (when-match @a..@b '1..2 (list a b)) (1 2)) (test (when-match (rcons @a @b) '(rcons 1 2) (list a b)) (1 2)) + +(test (let ((h #H(() (a 1) (b 2)))) + (when-match @[h x y] 'a (list x y))) + (a 1)) + +(test (let ((h #H(() (a 1) (b 2)))) + (when-match @[h x @(oddp y)] 'a (list x y))) + (a 1)) @@ -40519,8 +40519,8 @@ function is capable of being called with exactly one argument. .NP* Pattern predicate operator .synb -.mets >> @( function <> [ symbol ]) -.mets >> @[ expression <> [ symbol ]] +.mets >> @( function <> [ variable ]) +.mets >> @[ expression >> [ variable >> [ pattern | << variable ]]] .syne .desc Whenever the operator of a pattern predicate is not recognized and is @@ -40532,13 +40532,13 @@ corresponding object as an argument. The match is successful if the function returns true. Optionally, if the -.meta symbol +.meta variable is specified, and is not .codn nil , it is bound to the corresponding object. The -.meta symbol +.meta variable argument, if present, must be a .code bindable symbol, or else @@ -40550,15 +40550,28 @@ must be capable of accepting exactly one argument. The .mono -.meti >> @[ expression <> [ symbol ]] +.mets >> @[ expression >> [ variable >> [ pattern | << variable ]]] .onom -version of the syntax is always a predicate. It denotes the evaluation of +variant of the predicate syntax is always a predicate. It denotes the evaluation of .mono .meti >> [ expression << arg ] .onom where .meta arg -is the corresponding object. +is the corresponding object, that evaluation being required to +yield true. The +.meta variable +plays the same role. + +This syntax supports an optional third argument, which may be a +.meta pattern +or another +.metn variable . +This pattern or variable, if present, is matched against the value of applying +.meta expression +to its argument. It allows that value to be captured and subject to +pattern matching. The restriction that this value must be true +continues to apply. Note: a .code lambda @@ -40567,7 +40580,7 @@ expression may be used as either or .metn expression . -.TP* Example: +.TP* Examples: .verb (when-match (@(evenp) @(oddp x)) '(2 3) x) -> 3 @@ -40576,6 +40589,16 @@ or (let ((h #H(() (a 1) (b 2)))) (when-match @[h x] 'a x)) -> a + + ;; as above, also capture hash value + (let ((h #H(() (a 1) (b 2)))) + (when-match @[h x y] 'a (list x y))) + -> (a 1) + + ;; as above, also capture hash value, if odd + (let ((h #H(() (a 1) (b 2)))) + (when-match @[h x @(odd y)] 'a (list x y))) + -> (a 1) .brev .coNP Macros @ when-match and @ if-match |