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.

2 files changed, 21 insertions, 0 deletions

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