summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorPaul A. Patience <paul@apatience.com>2022-01-17 06:40:51 -0500
committerKaz Kylheku <kaz@kylheku.com>2022-01-21 22:30:38 -0800
commit2f9f717738b6bf8e1acd728567a0f953fc8a3614 (patch)
treed06f7df85cacedc967082595e1696a485d15a6e7
parent27898e3aa3c6d7daa784712731aa03a7e6d60b22 (diff)
downloadtxr-2f9f717738b6bf8e1acd728567a0f953fc8a3614.tar.gz
txr-2f9f717738b6bf8e1acd728567a0f953fc8a3614.tar.bz2
txr-2f9f717738b6bf8e1acd728567a0f953fc8a3614.zip
type: new macro etypecase.
* lisplib.c (type_set_entries): Add etypecase to autoload list. * stdlib/type.tl (etypecase): New macro. * txr.1: Documented. * stdlib/doc-syms.tl: Updated.
-rw-r--r--lisplib.c4
-rw-r--r--stdlib/doc-syms.tl1
-rw-r--r--stdlib/type.tl11
-rw-r--r--txr.136
4 files changed, 51 insertions, 1 deletions
diff --git a/lisplib.c b/lisplib.c
index 80c8dc59..f841f4c7 100644
--- a/lisplib.c
+++ b/lisplib.c
@@ -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))))))))
diff --git a/txr.1 b/txr.1
index 267b66dc..edbdd5f0 100644
--- a/txr.1
+++ b/txr.1
@@ -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 )