add hygienic `case` syntax

2013-12-09 15:37:21 +09:00 · 2013-12-09 15:37:21 +09:00 · 3c6fd93b5a
parent 80aed24fd7
commit 3c6fd93b5a
1 changed files with 13 additions and 0 deletions
--- a/piclib/built-in.scm
+++ b/piclib/built-in.scm
@ -610,3 +610,16 @@
      (define (compare x y)
        (identifier=? use-env x use-env y))
      (make-syntactic-closure mac-env '() (unwrap (f (wrap expr) inject compare))))))
+
+(define-syntax case
+  (er-macro-transformer
+   (lambda (expr inject compare)
+     (let ((key (cadr expr))
+           (clauses (cddr expr)))
+       `(let ((key ,key))
+          ,(let loop ((clauses clauses))
+               (if (null? clauses)
+                   '#f
+                   `(if (or ,@(map (lambda (x) `(eqv? key ,x)) (caar clauses)))
+                        ,@(cdar clauses)
+                        ,(loop (cdr clauses))))))))))