WIP - preserve AST through to closure-conversion

This commit is contained in:
Justin Ethier 2018-08-31 19:50:58 -04:00
parent 21616727d1
commit b2f4502651
3 changed files with 39 additions and 28 deletions

View file

@ -432,7 +432,7 @@
(wrap-mutables expr globals))
input-program))
(trace:info "---------------- after wrap-mutables:")
(trace:info input-program) ;pretty-print
(trace:info (ast:ast->pp-sexp input-program))
(set! input-program
(map

View file

@ -1573,7 +1573,24 @@
(define (_closure-convert exp globals optimization-level)
(define (convert exp self-var free-var-lst)
(define (cc exp)
;(trace:error `(cc ,exp))
(cond
((ast:lambda? exp)
(let* ((new-self-var (gensym 'self))
(body (ast:lambda-body exp))
(new-free-vars
(difference
(difference (free-vars body) (ast:lambda-formals->list exp))
globals)))
`(%closure
(lambda
,(list->lambda-formals
(cons new-self-var (ast:lambda-formals->list exp))
(ast:lambda-formals-type exp))
,(convert (car body) new-self-var new-free-vars)) ;; TODO: should this be a map??? was a list in 90-min-scc.
,@(map (lambda (v) ;; TODO: splice here?
(cc v))
new-free-vars))))
((const? exp) exp)
((quote? exp) exp)
((ref? exp)
@ -1591,22 +1608,7 @@
,@(map cc (cdr exp)))) ;; TODO: need to splice?
((set!? exp) `(set! ,(set!->var exp)
,(cc (set!->exp exp))))
((lambda? exp)
(let* ((new-self-var (gensym 'self))
(body (lambda->exp exp))
(new-free-vars
(difference
(difference (free-vars body) (lambda-formals->list exp))
globals)))
`(%closure
(lambda
,(list->lambda-formals
(cons new-self-var (lambda-formals->list exp))
(lambda-formals-type exp))
,(convert (car body) new-self-var new-free-vars)) ;; TODO: should this be a map??? was a list in 90-min-scc.
,@(map (lambda (v) ;; TODO: splice here?
(cc v))
new-free-vars))))
((lambda? exp) (error `(Unexpected lambda in closure-convert ,exp)))
((if? exp) `(if ,@(map cc (cdr exp))))
((cell? exp) `(cell ,(cc (cell->value exp))))
((cell-get? exp) `(cell-get ,(cc (cell-get->cell exp))))

View file

@ -726,22 +726,33 @@
; wrap-mutables : exp -> exp
(define (wrap-mutables exp globals)
(define (wrap-mutable-formals formals body-exp)
(define (wrap-mutable-formals id formals body-exp has-cont)
(if (not (pair? formals))
body-exp
;(list body-exp)
(if (is-mutable? (car formals))
`((lambda (,(car formals))
,(wrap-mutable-formals (cdr formals) body-exp))
(cell ,(car formals)))
(wrap-mutable-formals (cdr formals) body-exp))))
(list ;(ast:%make-lambda
; id
(ast:make-lambda
(list (car formals))
(wrap-mutable-formals id (cdr formals) body-exp has-cont)
has-cont)
`(cell ,(car formals)))
(wrap-mutable-formals id (cdr formals) body-exp has-cont))))
(cond
; Core forms:
((ast:lambda? exp)
`(lambda ,(ast:lambda-args exp)
,(wrap-mutable-formals
(ast:%make-lambda
(ast:lambda-id exp)
(ast:lambda-args exp)
(wrap-mutable-formals
(ast:lambda-id exp)
(ast:lambda-formals->list exp)
(wrap-mutables (car (ast:lambda-body exp)) globals)))) ;; Assume single expr in lambda body, since after CPS phase
(wrap-mutables (car (ast:lambda-body exp)) globals)
(ast:lambda-has-cont exp))
(ast:lambda-has-cont exp)
)) ;; Assume single expr in lambda body, since after CPS phase
((const? exp) exp)
((ref? exp) (if (and (not (member exp globals))
(is-mutable? exp))
@ -749,9 +760,7 @@
exp))
((prim? exp) exp)
((quote? exp) exp)
((lambda? exp) `(lambda ,(lambda->formals exp)
,(wrap-mutable-formals (lambda-formals->list exp)
(wrap-mutables (car (lambda->exp exp)) globals)))) ;; Assume single expr in lambda body, since after CPS phase
((lambda? exp) (error `(Unexpected lambda in wrap-mutables ,exp)))
((set!? exp) `(,(if (member (set!->var exp) globals)
'set-global!
'set-cell!)