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 'begin) (cdr cl))
(cons (rename 'cond) (cddr expr)))))) (cons (rename 'cond) (cddr expr))))))
(cadr 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 (cons 'cond-expand
;; Based on the cond-expand macro from Chibi scheme ;; Based on the cond-expand macro from Chibi scheme
(lambda (expr rename compare) (lambda (expr rename compare)