conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

define 'case' syntax in (pircin core-syntax) library

This commit is contained in:
Yuichi Nishiwaki 2013-12-10 01:48:53 -08:00
parent fd8c551159
commit 7cdd997f34
1 changed files with 14 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
piclib/built-in.scm
View File

@ -157,6 +157,19 @@
(define-macro (unless test . exprs) (define-macro (unless test . exprs)
(list 'if test #f (cons 'begin exprs))) (list 'if test #f (cons 'begin exprs)))
(define-syntax case
(ir-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))))))))))
(define-syntax define-auxiliary-syntax (define-syntax define-auxiliary-syntax
(ir-macro-transformer (ir-macro-transformer
(lambda (expr i c) (lambda (expr i c)
@ -175,7 +188,7 @@
(export let let* letrec letrec* (export let let* letrec letrec*
quasiquote unquote unquote-splicing quasiquote unquote unquote-splicing
and or and or
cond else => cond case else =>
do do
when unless when unless
_ ...)) _ ...))
@ -670,16 +683,3 @@
(if it (if it
it it
(or ,@(cdr exprs))))))))) (or ,@(cdr exprs)))))))))
(define-syntax case
(ir-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))))))))))