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

Added named let using chibi's macro

Browse source
This commit is contained in:
Justin Ethier 2015-06-28 16:06:13 -04:00
parent 0b2ac62b4f
commit 53b882d909
2 changed files with 34 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
test2.scm
View file

@ -2,12 +2,7 @@
(scheme file)
(scheme write))
;; TODO: fails with an "unspecified" error unless there is an else clause. WTF?
;(write
(cond
(#f #f)
;(else #t)
)
;)
1
(let loop ((i 10))
(if (zero? i)
(write 'done)
(loop (- i 1))))

38
transforms.scm
View file

@ -34,7 +34,29 @@
(list (rename 'if) (rename 'tmp)
(rename 'tmp)
(cons (rename 'or) (cddr expr))))))))
(cons 'let (lambda (exp rename compare) (let=>lambda exp)))
; (cons 'let (lambda (exp rename compare) (let=>lambda exp)))
(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))
@ -857,13 +879,13 @@
; TODO: eventually, merge below functions with above *defined-macros* defs and
;; replace both with a lib of (define-syntax) constructs
; let=>lambda : let-exp -> app-exp
(define (let=>lambda exp)
(if (let? exp)
(let ((vars (map car (let->bindings exp)))
(args (map cadr (let->bindings exp))))
`((lambda (,@vars) ,@(let->exp exp)) ,@args))
exp))
;; let=>lambda : let-exp -> app-exp
;(define (let=>lambda exp)
; (if (let? exp)
; (let ((vars (map car (let->bindings exp)))
; (args (map cadr (let->bindings exp))))
; `((lambda (,@vars) ,@(let->exp exp)) ,@args))
; exp))
; letrec=>lets+sets : letrec-exp -> exp
(define (letrec=>lets+sets exp)