diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2021-08-13 06:25:50 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2021-08-13 06:25:50 -0700 |
commit | 483e15d9af31110d2a34ad20fe010663de5afe19 (patch) | |
tree | 6721ce5ccadde9b844ec674bff3145941fa0da17 | |
parent | 3d7e614022c19d0c42ff32d60c8e51b226fb427d (diff) | |
download | txr-483e15d9af31110d2a34ad20fe010663de5afe19.tar.gz txr-483e15d9af31110d2a34ad20fe010663de5afe19.tar.bz2 txr-483e15d9af31110d2a34ad20fe010663de5afe19.zip |
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.
-rw-r--r-- | lisplib.c | 5 | ||||
-rw-r--r-- | stdlib/match.tl | 15 | ||||
-rw-r--r-- | tests/011/patmatch.tl | 9 | ||||
-rw-r--r-- | txr.1 | 31 |
4 files changed, 55 insertions, 5 deletions
@@ -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") @@ -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 |