matcher: new must-match and must-match-case macros.

* lisplib.c (match_set_entries): Intern the match-error symbol.
Register autoloads for must-match and must-match-case.

* stdlib/match.tl (match-error): Register exception symbol, as subtype
of match-error.
(must-match, must-match-case): New macros.

* tests/011/patmatch.tl: Test cases.

* txr.1: Documented.

4 files changed, 55 insertions, 5 deletions

diff --git a/lisplib.c b/lisplib.c
index 86f20ab1..d777c717 100644
--- a/lisplib.c
+++ b/lisplib.c
@@ -877,11 +877,12 @@ static val match_instantiate(val set_fun)
 static val match_set_entries(val dlt, val fun)
 {
   val name_noload[] = {
-    lit("all*"), lit("as"), lit("with"), lit("scan"), lit("sme"),
+    lit("all*"), lit("as"), lit("with"), lit("scan"), lit("sme"), lit("match-error"),
     nil
   };
   val name[] = {
-    lit("when-match"), lit("match-case"), lit("if-match"),
+    lit("when-match"), lit("match-case"), lit("if-match"), lit("must-match"),
+    lit("must-match-case"),
     lit("while-match"), lit("while-match-case"), lit("while-true-match-case"),
     lit("lambda-match"), lit("defun-match"), lit("defmatch"),
     lit("each-match"), lit("append-matches"),
diff --git a/stdlib/match.tl b/stdlib/match.tl
index 3502688b..d122d24c 100644
--- a/stdlib/match.tl
+++ b/stdlib/match.tl
@@ -28,6 +28,8 @@
 
 (defvar *match-macro* (hash))
 
+(defex match-error eval-error)
+
 (defstruct match-guard ()
   temps
   vars
@@ -643,6 +645,13 @@
            ,result
            ,else)))))
 
+(defmacro must-match (pat obj . body)
+  (with-gensyms (val)
+    ^(let ((,val ,obj))
+       (if-match ,pat ,val
+         (progn ,*body)
+         (throwf 'match-error "~s: ~s failed to match object ~s" 'must-match ',pat ,val)))))
+
 (defmacro while-match (:form *match-form* :env e pat obj . body)
   (let ((cm (compile-match pat : (get-var-list e))))
     ^(for ()
@@ -674,6 +683,12 @@
          (or ,*clause-code)
          ,result-temp))))
 
+(defmacro must-match-case (obj . clauses)
+  (with-gensyms (else)
+    ^(match-case ,obj
+       ,*clauses
+       ((var ,else) (throwf 'match-error "~s: failed to match object ~s" 'must-match-case ,else)))))
+
 (defmacro while-match-case (:form *match-form* :env e obj . clauses)
   (unless [all clauses [andf proper-listp [chain len plusp]]]
     (compile-error *match-form* "bad clause syntax"))
diff --git a/tests/011/patmatch.tl b/tests/011/patmatch.tl
index 9647c52b..c6b67614 100644
--- a/tests/011/patmatch.tl
+++ b/tests/011/patmatch.tl
@@ -513,6 +513,15 @@
         (@else (error "unhandled case")))))
   (:odd 1 :pair 2 3 :even 4 :pair 5 6))
 
+(mtest
+  (must-match (@a @b) '(1 2) (list a b)) (1 2)
+  (must-match (@a @b) '(1 2 3) (list a b)) :error)
+
+(mtest
+  (must-match-case 42) :error
+  (must-match-case 42 (@a a)) 42
+  (must-match-case '(1 2) ((@a) a)) :error)
+
 (compile-only
   (eval-only
     (compile-file (base-name *load-path*) "temp.tlo")
diff --git a/txr.1 b/txr.1
index da7fa75b..73fb7a83 100644
--- a/txr.1
+++ b/txr.1
@@ -43086,14 +43086,16 @@ apply accordingly.
 
 .SS* Pattern-Matching Macros
 
-.coNP Macros @ when-match and @ if-match
+.coNP Macros @, when-match @ must-match and @ if-match
 .synb
 .mets (when-match < pattern < expr << form *)
+.mets (must-match < pattern < expr << form *)
 .mets (if-match < pattern < expr < then-form <> [ else-form ])
 .syne
 .desc
 The
-.code when-match
+.codn when-match ,
+.code must-match
 and
 .code if-match
 macros conditionally evaluate code based on whether the value of
@@ -43119,6 +43121,15 @@ If the match fails, the forms are not evaluated, and
 is produced.
 
 The
+.code must-match
+macro behaves exactly like
+.code when-match
+when the match is successful. When the match fails,
+.code must-match
+throws an exception of type
+.codn match-error .
+
+The
 .code if-match
 macro evaluates
 .meta then-form
@@ -43131,9 +43142,10 @@ which defaults to
 .code nil
 if it is not specified.
 
-.coNP Macro @ match-case
+.coNP Macros @ match-case and @ must-match-case
 .synb
 .mets (match-case < expr >> {( pattern << form *)}*)
+.mets (must-match-case < expr >> {( pattern << form *)}*)
 .syne
 .desc
 The
@@ -43177,6 +43189,19 @@ or else
 .code nil
 if there are no forms.
 
+The
+.code must-match-case
+macro differs from
+.code match-case
+as follows. When none of the clauses match under
+.codn match-case ,
+then that form terminates with a value of
+.codn nil .
+In the same situation, the
+.code must-match-case
+form throws an exception of type
+.codn match-error .
+
 .TP* Examples:
 
 .verb