Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-06-13 06:15:10 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

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