diff options
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/doc-syms.tl | 1 | ||||
| -rw-r--r-- | stdlib/match.tl | 20 |
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 |