Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-22 07:09:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

handling => in case

Browse source
This commit is contained in:
Alex Shinn 2011-11-27 21:07:25 +09:00
parent 6f85c98d12
commit 6ec7cbf766
1 changed files with 7 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
lib/init-7.scm
View file

@ -270,20 +270,24 @@
(define-syntax case
(er-macro-transformer
(lambda (expr rename compare)
(define (body exprs)
(if (compare (rename '=>) (car exprs))
`(,(cadr exprs) ,(rename 'tmp))
`(,(rename 'begin) ,@exprs)))
(define (clause ls)
(cond
((null? ls) #f)
((compare (rename 'else) (caar ls))
`(,(rename 'begin) ,@(cdar ls)))
(body (cdar ls)))
((and (pair? (car (car ls))) (null? (cdr (car (car ls)))))
`(,(rename 'if) (,(rename 'eqv?) ,(rename 'tmp)
(,(rename 'quote) ,(caaar ls)))
(,(rename 'begin) ,@(cdar ls))
,(body (cdar ls))
,(clause (cdr ls))))
(else
`(,(rename 'if) (,(rename 'memv) ,(rename 'tmp)
(,(rename 'quote) ,(caar ls)))
(,(rename 'begin) ,@(cdar ls))
,(body (cdar ls))
,(clause (cdr ls))))))
`(let ((,(rename 'tmp) ,(cadr expr)))
,(clause (cddr expr))))))