Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-23 20:15:05 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Relocated case to scheme/base

Browse source
This commit is contained in:
Justin Ethier 2015-08-20 21:31:36 -04:00
parent 6b6585b7e7
commit a228027ac4
2 changed files with 29 additions and 27 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

29
scheme/base.sld
View file

@ -87,6 +87,7 @@
let
let*
begin
case
cond
when
quasiquote
@ -193,6 +194,34 @@
(cons (rename 'begin) (cdr cl))
(cons (rename 'cond) (cddr expr))))))
(cadr expr))))))
(define-syntax case
(er-macro-transformer
(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))))))
(define-syntax when
(er-macro-transformer
(lambda (exp rename compare)

27
scheme/cyclone/transforms.sld
View file

@ -139,33 +139,6 @@
(define *defined-macros*
(list
(cons 'letrec (lambda (exp rename compare) (letrec=>lets+sets exp)))
(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)