nybble
/
rosella
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add support for named (let ...) forms. (Does not yet include let* or letrec.)

This commit is contained in:
Jesse D. McDonald 2011-04-25 13:53:20 -05:00
parent 647fcd59d7
commit ded5b4851d
1 changed files with 24 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
libcompiler/simplifier.scm
View File

@ -100,6 +100,8 @@
(iter rst (cons (list var expr) bindings))] (iter rst (cons (list var expr) bindings))]
[`((define . ,_) . ,_) [`((define . ,_) . ,_)
(error "Unrecognized define-form:" (first body))] (error "Unrecognized define-form:" (first body))]
[`((begin . ,forms) . ,rst)
(iter (append forms rst) bindings)]
[`(,form . ,rst) [`(,form . ,rst)
(if (null? bindings) (if (null? bindings)
(cons form (iter rst '())) (cons form (iter rst '()))
@ -175,6 +177,22 @@
,@(filter-map second bindings) ,@(filter-map second bindings)
(,simple-op ,@(map first bindings))))) (,simple-op ,@(map first bindings)))))
; (let name ([var expr]...) bodyexpr...)
; => ((letrec ([name (lambda (var...)
; bodyexpr...)])
; name) expr...)
(define (simplify-named-let form)
(define (expand-binding binding)
(if (pair? binding) binding (list binding '#%undef)))
(define let-name (second form))
(define bindings (map expand-binding (third form)))
(define bodyexprs (body->forms (cdddr form)))
(simplify-form
`((letrec ([,let-name (lambda ,(map first bindings) ,@bodyexprs)]) ,let-name)
,@(map second bindings))))
; (let ([var expr]...) bodyexpr...) ; first eval exprs, then assign bindings in parallel ; (let ([var expr]...) bodyexpr...) ; first eval exprs, then assign bindings in parallel
; => (#%bind (tmp...) ; => (#%bind (tmp...)
; (#%set! tmp ,(simplify-form expr))... ; (#%set! tmp ,(simplify-form expr))...
@ -182,7 +200,7 @@
; (#%set! var tmp)... ; (#%set! var tmp)...
; bodyexpr...)) ; bodyexpr...))
(define (simplify-let form) (define (simplify-unnamed-let form)
(define (simplify-binding binding) (define (simplify-binding binding)
(if (pair? binding) (if (pair? binding)
(list (first binding) (simplify-form (second binding))) (list (first binding) (simplify-form (second binding)))
@ -215,6 +233,11 @@
(filter has-value? bindings)) (filter has-value? bindings))
,@(map simplify-form bodyexprs)))) ,@(map simplify-form bodyexprs))))
(define (simplify-let form)
(if (symbol? (second form))
(simplify-named-let form)
(simplify-unnamed-let form)))
; (let* ...) ; eval exprs & bind variables serially ; (let* ...) ; eval exprs & bind variables serially
; => (let ([var-0 expr-0]) ; => (let ([var-0 expr-0])
; (let ([var-1 expr-1]) ; (let ([var-1 expr-1])