Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-16 09:17:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Added case macro

Browse source
This commit is contained in:
Justin Ethier 2015-06-29 21:33:30 -04:00
parent e7671ccf16
commit 71bdd86d9a
1 changed files with 27 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
transforms.scm
View file

@ -105,6 +105,33 @@
(cons (rename 'begin) (cdr cl))
(cons (rename 'cond) (cddr expr))))))
(cadr expr)))))
(cons 'case
(lambda (expr rename compare)
(define (body exprs)
(cond
((null? exprs)
(rename 'tmp))
((compare (rename '=>) (car exprs))
`(,(cadr exprs) ,(rename 'tmp)))
(else
`(,(rename 'begin) ,@exprs))))
(define (clause ls)
(cond
((null? ls) #f)
((compare (rename 'else) (caar ls))
(body (cdar ls)))
((and (pair? (car (car ls))) (null? (cdr (car (car ls)))))
`(,(rename 'if) (,(rename 'eqv?) ,(rename 'tmp)
(,(rename 'quote) ,(car (caar ls))))
,(body (cdar ls))
,(clause (cdr ls))))
(else
`(,(rename 'if) (,(rename 'memv) ,(rename 'tmp)
(,(rename 'quote) ,(caar ls)))
,(body (cdar ls))
,(clause (cdr ls))))))
`(let ((,(rename 'tmp) ,(cadr expr)))
,(clause (cddr expr)))))
(cons 'cond-expand
;; Based on the cond-expand macro from Chibi scheme
(lambda (expr rename compare)