From 483e15d9af31110d2a34ad20fe010663de5afe19 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 13 Aug 2021 06:25:50 -0700
Subject: 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.
---
 stdlib/match.tl | 15 +++++++++++++++
 1 file changed, 15 insertions(+)

(limited to 'stdlib')

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"))
-- 
cgit v1.2.3