diff options
| -rw-r--r-- | lisplib.c | 4 | ||||
| -rw-r--r-- | stdlib/doc-syms.tl | 1 | ||||
| -rw-r--r-- | stdlib/type.tl | 11 | ||||
| -rw-r--r-- | txr.1 | 36 |
4 files changed, 51 insertions, 1 deletions
@@ -292,7 +292,9 @@ static val except_instantiate(val set_fun) static val type_set_entries(val dlt, val fun) { - val name[] = { lit("typecase"), nil }; + val name[] = { + lit("typecase"), lit("etypecase"), nil + }; set_dlt_entries(dlt, name, fun); return nil; } diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl index 19804e8d..676323a4 100644 --- a/stdlib/doc-syms.tl +++ b/stdlib/doc-syms.tl @@ -658,6 +658,7 @@ ("etime" "N-036B1BDB") ("etimedout" "N-036B1BDB") ("etxtbsy" "N-036B1BDB") + ("etypecase" "N-033FBE77") ("eval" "N-0286C8B8") ("eval-only" "N-030BF4F5") ("evenp" "D-001C") diff --git a/stdlib/type.tl b/stdlib/type.tl index f75c88e2..8a83a171 100644 --- a/stdlib/type.tl +++ b/stdlib/type.tl @@ -37,3 +37,14 @@ 'typecase cl)))))) ^(let ((,val ,form)) (cond ,*cond-pairs)))) + +(defmacro etypecase (form . clauses) + (if [find t clauses eq car] + ^(typecase ,form ,*clauses) + (let ((val (gensym))) + ^(let ((,val ,form)) + (typecase ,val + ,*clauses + (t (throwf 'case-error + "~s: unhandled type: ~s" + 'etypecase (typeof ,val)))))))) @@ -19850,6 +19850,42 @@ always matches. If such a clause is placed as the last clause of a it provides a fallback case, whose forms are evaluated if none of the previous clauses match. +.coNP Macro @ etypecase +.synb +.mets (etypecase < test-form >> {( type-sym << clause-form *)}*) +.syne +.desc +The +.code etypecase +macro is the error-catching variant of +.codn typecase , +similar to the relationship between the +.code ecaseq +and +.code caseq +families of macros. + +If one of the clauses has a +.meta type-sym +which is the symbol +.codn t , +then +.code etypecase +is precisely equivalent to +.codn typecase . +Otherwise, +a clause with a +.meta type-sym +of +.code t +and which throws an exception of type +.codn case-error , +derived from +.codn error , +is appended to the existing clauses, +after which the semantics follows that of +.codn typecase . + .coNP Function @ built-in-type-p .synb .mets (built-in-type-p << object ) |