From 04fbd67be80a866b6a0db0199d17d6d9ba581ff1 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 1 Apr 2025 06:05:28 -0700
Subject: 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.
---
 autoload.c            |  4 +--
 stdlib/match.tl       |  3 ++
 tests/011/patmatch.tl | 17 ++++++++++++
 txr.1                 | 76 +++++++++++++++++++++++++++++++++++++++++++++++++++
 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 *)}*)
-- 
cgit v1.2.3