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

Relocated let/let*

Browse source
This commit is contained in:
Justin Ethier 2015-08-19 22:10:02 -04:00
parent 4c34c318c3
commit c694e244c6
2 changed files with 41 additions and 37 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

41
scheme/base.sld
View file

@ -84,6 +84,8 @@
every
and
or
let
let*
begin
cond
when
@ -111,6 +113,45 @@
(list (rename 'if) (rename 'tmp)
(rename 'tmp)
(cons (rename 'or) (cddr expr)))))))))
(define-syntax let
(er-macro-transformer
(lambda (expr rename compare)
(if (null? (cdr expr)) (error "empty let" expr))
(if (null? (cddr expr)) (error "no let body" expr))
((lambda (bindings)
(if (list? bindings) #f (error "bad let bindings"))
(if (every (lambda (x)
(if (pair? x) (if (pair? (cdr x)) (null? (cddr x)) #f) #f))
bindings)
((lambda (vars vals)
(if (symbol? (cadr expr))
`((,(rename 'lambda) ,vars
(,(rename 'letrec) ((,(cadr expr)
(,(rename 'lambda) ,vars
,@(cdr (cddr expr)))))
(,(cadr expr) ,@vars)))
,@vals)
`((,(rename 'lambda) ,vars ,@(cddr expr)) ,@vals)))
(map car bindings)
(map cadr bindings))
(error "bad let syntax" expr)))
(if (symbol? (cadr expr)) (car (cddr expr)) (cadr expr))))))
(define-syntax let*
(er-macro-transformer
(lambda (expr rename compare)
(if (null? (cdr expr)) (error "empty let*" expr))
(if (null? (cddr expr)) (error "no let* body" expr))
(if (null? (cadr expr))
`(,(rename 'let) () ,@(cddr expr))
(if (if (list? (cadr expr))
(every
(lambda (x)
(if (pair? x) (if (pair? (cdr x)) (null? (cddr x)) #f) #f))
(cadr expr))
#f)
`(,(rename 'let) (,(caar (cdr expr)))
(,(rename 'let*) ,(cdar (cdr expr)) ,@(cddr expr)))
(error "bad let* syntax"))))))
(define-syntax begin
(er-macro-transformer
(lambda (exp rename compare)

37
scheme/cyclone/transforms.sld
View file

@ -138,43 +138,6 @@
(define (get-macros) *defined-macros*)
(define *defined-macros*
(list
(cons 'let
(lambda (expr rename compare)
(if (null? (cdr expr)) (error "empty let" expr))
(if (null? (cddr expr)) (error "no let body" expr))
((lambda (bindings)
(if (list? bindings) #f (error "bad let bindings"))
(if (every (lambda (x)
(if (pair? x) (if (pair? (cdr x)) (null? (cddr x)) #f) #f))
bindings)
((lambda (vars vals)
(if (symbol? (cadr expr))
`((,(rename 'lambda) ,vars
(,(rename 'letrec) ((,(cadr expr)
(,(rename 'lambda) ,vars
,@(cdr (cddr expr)))))
(,(cadr expr) ,@vars)))
,@vals)
`((,(rename 'lambda) ,vars ,@(cddr expr)) ,@vals)))
(map car bindings)
(map cadr bindings))
(error "bad let syntax" expr)))
(if (symbol? (cadr expr)) (car (cddr expr)) (cadr expr)))))
(cons 'let*
(lambda (expr rename compare)
(if (null? (cdr expr)) (error "empty let*" expr))
(if (null? (cddr expr)) (error "no let* body" expr))
(if (null? (cadr expr))
`(,(rename 'let) () ,@(cddr expr))
(if (if (list? (cadr expr))
(every
(lambda (x)
(if (pair? x) (if (pair? (cdr x)) (null? (cddr x)) #f) #f))
(cadr expr))
#f)
`(,(rename 'let) (,(caar (cdr expr)))
(,(rename 'let*) ,(cdar (cdr expr)) ,@(cddr expr)))
(error "bad let* syntax")))))
(cons 'letrec (lambda (exp rename compare) (letrec=>lets+sets exp)))
(cons 'case
(lambda (expr rename compare)