New macro: match-cond.

* stdlib/match.tl (match-cond): New macro.

* autoload.c (match_set_entries): match-cond triggers
autoload of match module.

* tests/011/patmatch.tl: Tests.

* txr.1: Documented.

* stdlib/doc.tl: Updated.

5 files changed, 98 insertions, 1 deletions

diff --git a/autoload.c b/autoload.c
index f90366d1..d384879a 100644
--- a/autoload.c
+++ b/autoload.c
@@ -840,7 +840,7 @@ static val match_set_entries(val fun)
     nil
   };
   val name[] = {
-    lit("when-match"), lit("match-case"), lit("if-match"),
+    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"),
diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl
index ac078f80..e7cf5fa7 100644
--- a/stdlib/doc-syms.tl
+++ b/stdlib/doc-syms.tl
@@ -1257,6 +1257,7 @@
       ("mask" "N-0056CEF1")
       ("match" "N-01BE5C4A")
       ("match-case" "N-0282196B")
+      ("match-cond" "N-021DEB00")
       ("match-ecase" "N-0282196B")
       ("match-fboundp" "N-02AF4E8B")
       ("match-fun" "N-033F766A")
diff --git a/stdlib/match.tl b/stdlib/match.tl
index 92206e0b..fb11aa4f 100644
--- a/stdlib/match.tl
+++ b/stdlib/match.tl
@@ -696,6 +696,26 @@
          (or ,*clause-code)
          ,result-temp))))
 
+(defmacro match-cond (:form *match-form* :env e . clauses)
+  (unless [all clauses [andf proper-listp [chain len (op < 1)]]]
+    (compile-error *match-form* "bad clause syntax"))
+  (let* ((result-temp (gensym "result-"))
+         (var-list (get-var-list e))
+         (clause-matches [mapcar (op compile-match (car @1)
+                                     : (copy var-list))
+                                 clauses])
+         (clause-code (collect-each ((cl clauses)
+                                     (cm clause-matches))
+                        (mac-param-bind *match-form* (t obj . forms) cl
+                          ^(let (,*cm.(get-vars)
+                                 (,cm.obj-var ,obj))
+                             ,cm.(wrap-guards ^(set ,result-temp
+                                                    (progn ,cm.obj-var ,*forms))
+                                              t))))))
+    ^(let (,result-temp)
+       (or ,*clause-code)
+       ,result-temp)))
+
 (defmacro match-ecase (obj . clauses)
   (with-gensyms (else)
     ^(match-case ,obj
diff --git a/tests/011/patmatch.tl b/tests/011/patmatch.tl
index 08de0151..24d7b995 100644
--- a/tests/011/patmatch.tl
+++ b/tests/011/patmatch.tl
@@ -574,3 +574,17 @@
   (match ^#H() #H(() (a b)) t) t
   (match ^#H(()) #H(() (a b)) t) t
   (match ^#S(time) #S(time year 2023) t) t)
+
+(mtest
+  (match-cond (t)) :error
+  (match-cond (t t)) t
+  (match-cond (t t nil)) nil
+  (match-cond (t t t)) t
+  (let ((x 42))
+    (match-cond
+      (`@x-73` "73-73" :a)
+      (`@x-@y` "42-24" y))) "24"
+  (let ((x 42)
+        (y 24))
+    (match-cond
+      (`@x-24` `42-@y`))) "42-24")
diff --git a/txr.1 b/txr.1
index bbf1bdec..abe7be8f 100644
--- a/txr.1
+++ b/txr.1
@@ -45035,6 +45035,7 @@ operators, which are:
 .codn if-match ,
 .codn match ,
 .codn match-case ,
+.codn match-cond ,
 .codn match-ecase ,
 .code lambda-match
 and
@@ -45076,6 +45077,13 @@ macro is similar to
 except that if no matching case is identified, an exception is thrown.
 
 The
+.code match-cond
+macro evaluates multiple clauses, each of which specifies a pattern and an
+object expression. If the object produced by the expression matches the
+pattern, the forms in the clause are evaluated in scope of the variables
+bound by the clause's pattern.
+
+The
 .code lambda-match
 macro provides a way to express an anonymous function whose argument list
 is matched against multiple clauses similarly to
@@ -47106,6 +47114,60 @@ form throws an exception of type
      (@x :default)) --> :default
 .brev
 
+.coNP Macro @ match-cond
+.synb
+.mets (match-cond >> {( pattern < expr << form *)}*)
+.syne
+.desc
+The
+.code match-cond
+macro's arguments are zero or more clauses, each of which
+specifies a
+.metn pattern ,
+an expression
+.metn expr ,
+and zero or more
+.metn form s.
+
+The clauses are processed in order. Successive
+.metn expr s
+are evaluated, and matched against their corresponding pattern.
+If there is no match, processing continues with the next
+clause. If no match is found in any clause, the
+.code match-cond
+form terminates, returning
+.codn nil .
+
+If an
+.metn expr 's
+value matches the corresponding
+.metn pattern ,
+then every
+.code form
+is evaluated in scope of the variables established by the pattern.
+The
+.code match-form
+then terminates, yielding the value of the last
+.codn form ,
+or else the value of
+.meta expr
+if there are no
+.codn form s.
+
+Note: the pattern
+.code "(t t ...)"
+is recommended for specifying an unconditionally matching clause.
+
+.TP* Example:
+
+.verb
+  (let ((x 42))
+    (match-cond
+       (`@x-73` "73-73" :a)
+       (`@x-@y` "42-24" y)))
+  --> "24"
+.brev
+
 .coNP Macro @ lambda-match
 .synb
 .mets (lambda-match >> {( pattern << form *)}*)