Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-25 04:55:04 +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 file)
(scheme write)) (scheme write))
;; TODO: fails with an "unspecified" error unless there is an else clause. WTF? (let loop ((i 10))
;(write (if (zero? i)
(cond (write 'done)
(#f #f) (loop (- i 1))))
;(else #t)
)
;)
1

38
transforms.scm
View file

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