summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2021-01-26 00:46:57 -0800
committerKaz Kylheku <kaz@kylheku.com>2021-01-26 00:46:57 -0800
commitdeae97f0dfdf0ea33bba2912f05bb6b350553b94 (patch)
tree7d7a344efe14c3c5acb861870d07d71038f1face
parent030f25146ff5d2f6671ef1b615fc4217004632e5 (diff)
downloadtxr-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.tl26
-rw-r--r--tests/011/patmatch.tl8
-rw-r--r--txr.139
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))
diff --git a/txr.1 b/txr.1
index 48473af6..a660a675 100644
--- a/txr.1
+++ b/txr.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