diff options
Diffstat (limited to 'share')
| -rw-r--r-- | share/txr/stdlib/type.tl | 38 |
1 files changed, 38 insertions, 0 deletions
diff --git a/share/txr/stdlib/type.tl b/share/txr/stdlib/type.tl new file mode 100644 index 00000000..830c5700 --- /dev/null +++ b/share/txr/stdlib/type.tl @@ -0,0 +1,38 @@ +;; Copyright 2015 +;; Kaz Kylheku <kaz@kylheku.com> +;; Vancouver, Canada +;; All rights reserved. +;; +;; Redistribution of this software in source and binary forms, with or without +;; modification, is permitted provided that the following two conditions are met. +;; +;; Use of this software in any manner constitutes agreement with the disclaimer +;; which follows the two conditions. +;; +;; 1. Redistributions of source code must retain the above copyright +;; notice, this list of conditions and the following disclaimer. +;; 2. Redistributions in binary form must reproduce the above copyright +;; notice, this list of conditions and the following disclaimer in +;; the documentation and/or other materials provided with the +;; distribution. +;; +;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED +;; WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF +;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN NO EVENT SHALL THE +;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DAMAGES, HOWEVER CAUSED, +;; AND UNDER ANY THEORY OF LIABILITY, ARISING IN ANY WAY OUT OF THE USE OF THIS +;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(defmacro typecase (expr . clauses) + (let* ((val (gensym)) + (cond-pairs (collect-each ((cl clauses)) + (tree-case cl + ((type . body) + (if (symbolp type) + ^((typep ,val ',type) ,*body) + :)) + (else (throwf 'eval-error + "~s: bad clause syntax: ~s" + 'typecase cl)))))) + ^(let ((,val ,expr)) + (cond ,*cond-pairs)))) |