summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2025-04-01 06:05:28 -0700
committerKaz Kylheku <kaz@kylheku.com>2025-04-01 06:05:28 -0700
commit04fbd67be80a866b6a0db0199d17d6d9ba581ff1 (patch)
tree38340bd3c7dc501a2530d5ad2093c070fdd9d842
parent123431d3b031ea9bd3f3de572d00e64c41df32b8 (diff)
downloadtxr-04fbd67be80a866b6a0db0199d17d6d9ba581ff1.tar.gz
txr-04fbd67be80a866b6a0db0199d17d6d9ba581ff1.tar.bz2
txr-04fbd67be80a866b6a0db0199d17d6d9ba581ff1.zip
match: new pattern matching macro, match-tuple-case.
* autolod.c (match_set_entries): Autoload match module on match-tuple-case. * match.tl (match-tuple-case): New macro. * tests/011/patmatch.tl: New tests. The macro is trivial; if lambda-match works, the macro works. * txr.1: Documented.
-rw-r--r--autoload.c4
-rw-r--r--stdlib/match.tl3
-rw-r--r--tests/011/patmatch.tl17
-rw-r--r--txr.176
4 files changed, 98 insertions, 2 deletions
diff --git a/autoload.c b/autoload.c
index 1c956c80..43064204 100644
--- a/autoload.c
+++ b/autoload.c
@@ -848,8 +848,8 @@ static val match_set_entries(val fun)
lit("when-match"), lit("match-case"), lit("match-cond"), lit("if-match"),
lit("match"), lit("match-ecase"),
lit("while-match"), lit("while-match-case"), lit("while-true-match-case"),
- lit("lambda-match"), lit("defun-match"), lit("defmatch"),
- lit("macroexpand-match"),
+ lit("lambda-match"), lit("defun-match"), lit("match-tuple-case"),
+ lit("defmatch"), lit("macroexpand-match"),
lit("each-match"), lit("append-matches"),
lit("keep-matches"), lit("each-match-product"),
lit("append-match-products"), lit("keep-match-products"),
diff --git a/stdlib/match.tl b/stdlib/match.tl
index a27f2542..97fe8828 100644
--- a/stdlib/match.tl
+++ b/stdlib/match.tl
@@ -881,6 +881,9 @@
(tree-bind (t args . body) (expand-lambda-match clauses)
^(defun ,name ,args . ,body)))
+(defmacro match-tuple-case (args . clauses)
+ ^[(lambda-match ,*clauses) ,*args])
+
(define-param-expander :match (params clauses menv form)
(ignore menv)
(let ((*match-form* form))
diff --git a/tests/011/patmatch.tl b/tests/011/patmatch.tl
index 3ccd180e..6995ac5f 100644
--- a/tests/011/patmatch.tl
+++ b/tests/011/patmatch.tl
@@ -305,6 +305,23 @@
(local 3 2 1)))
(2 3))
+(mtest
+ (match-tuple-case (1 2 3)
+ ((1 2 @x) x))
+ 3
+ (match-tuple-case (1 2 3)
+ ((1 2 @x @y) x)
+ ((1 @x 3) x))
+ 2)
+
+(compile-only
+ (eval-only
+ (test
+ (match-tuple-case (1 2 3)
+ ((1 2 @x @y) x)
+ ((1 @x 3 4) x))
+ :error)))
+
(test
(when-match @(sme (1 2) (3 4) (5 . 6) m e)
'(1 2 3 4 5 . 6)
diff --git a/txr.1 b/txr.1
index 17186810..55b9594a 100644
--- a/txr.1
+++ b/txr.1
@@ -49577,6 +49577,82 @@ macros.
((@x @y) :no-match)) 1 2 3] --> ;; error
.brev
+.coNP Macro @ match-tuple-case
+.synb
+.mets (match-tuple-case <> ({ arg }*) >> {( pattern << form *)}*)
+.syne
+.desc
+The
+.code match-tuple-case
+provides the multiple value matching logic of
+.code lambda-match
+in a binding construct whose syntax doesn't involve calling a function.
+
+Note: the relationship between
+.code lambda-match
+and
+.code match-tuple-case
+is conceptually like that between
+.code lambda
+and
+.codn let ,
+only closer.
+
+The following equivalence holds between
+.code match-tuple-case
+and a
+.code lambda-match
+invocation:
+
+.verb
+ (match-tuple-case (arg ...) (pat1 form ...) (pat2 form ...) ...)
+
+ <-->
+
+ [(lambda-match (pat1 form ...) (pat2 form ...) ...) arg ...]
+.brev
+
+The
+.meta pattern
+and
+.meta form
+clauses specified in
+.meta match-tuple-case
+are used as-is to specify a
+.code lambda-match
+expression. The function denoted by this
+.code lambda-match
+expression is immediately invoked with the arguments given on the
+left side of the
+.code match-tuple-case
+syntax.
+
+It is an error for the clauses to specify a lambda which cannot
+take the number of arguments given.
+
+
+.TP* Examples:
+
+.verb
+ (match-tuple-case (1 0)
+ ((0 1) :zero-one)
+ ((1 0) :one-zero)
+ ((@x @y) :no-match)) --> :one-zero
+
+ (match-tuple-case (1 1)
+ ((0 1) :zero-one)
+ ((1 0) :one-zero)
+ ((@x @y) :no-match)) --> :no-match
+
+ (match-tuple-case (1 2 3)
+ ((0 1) :zero-one)
+ ((1 0) :one-zero)
+ ((@x @y) :no-match)) --> ;; error
+.brev
+
+Note that these examples are an adaptation of several examples given for
+.codn lambda-case .
+
.coNP Macro @ defun-match
.synb
.mets (defun-match < name >> {( pattern << form *)}*)