diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2022-01-21 23:04:50 -0800 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2022-01-21 23:04:50 -0800 |
| commit | 474790ae526c164b2852997501b78fab03dcf339 (patch) | |
| tree | 850849c75c77d0a377bd4a52628606673669552d /tests | |
| parent | 2f9f717738b6bf8e1acd728567a0f953fc8a3614 (diff) | |
| download | txr-474790ae526c164b2852997501b78fab03dcf339.tar.gz txr-474790ae526c164b2852997501b78fab03dcf339.tar.bz2 txr-474790ae526c164b2852997501b78fab03dcf339.zip | |
typecase: merge with etypecase, handle t differnetly.
* stdlib/type.tl (sys:typecase-expander): New function, formed
from body of typecase. Bad clause syntax now handled with
compile-error rather than (throwf 'eval-error). The t symbol
is handled specially: it turns into a t conditon in the
resulting cond rather than a typep test. The compiler will
nicely eliminate dead code after that. Now etypecase is handled
here also: if we are expanding etypecase, we just emit the
extra clause.
(typecase, etypecase): Reduced to sys:typecase-expander calls.
* tests/012/typecase.tl: New file.
* tests/012/compile.tl: Add type.tl to list of compile-tested
files.
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/012/compile.tl | 2 | ||||
| -rw-r--r-- | tests/012/typecase.tl | 18 |
2 files changed, 19 insertions, 1 deletions
diff --git a/tests/012/compile.tl b/tests/012/compile.tl index d0c4913e..9b22d92a 100644 --- a/tests/012/compile.tl +++ b/tests/012/compile.tl @@ -5,7 +5,7 @@ (each ((f '#"aseq ashwin circ cont defset except \ fini ifa man-or-boy oop-mi oop-seq oop \ - parse syms quasi quine seq stslot const")) + parse syms quasi quine seq stslot const type")) (let ((exf `@{%this-dir%}/@f.expected`)) (when (path-exists-p exf) (file-append-string %expected-file% diff --git a/tests/012/typecase.tl b/tests/012/typecase.tl new file mode 100644 index 00000000..97b3da48 --- /dev/null +++ b/tests/012/typecase.tl @@ -0,0 +1,18 @@ +(load "../common") + +(mtest + (typecase) :error + (typecase nil) nil + (typecase nil a) :error + (typecase 0 (symbol 1)) nil + (typecase 0 (integer 1)) 1 + (typecase 0 (integer 1) (integer 2)) 1 + (typecase 0 (t 3) (integer 1)) 3) + +(mtest + (etypecase) :error + (etypecase nil) :error + (etypecase nil a) :error + (etypecase 0 (string 1)) :error + (etypecase 0 (string 1) (integer 2)) 2 + (etypecase 0 (string 1) (t 2)) 2) |