mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-25 04:55:04 +02:00
WIP - preserve AST through to closure-conversion
This commit is contained in:
parent
21616727d1
commit
b2f4502651
3 changed files with 39 additions and 28 deletions
|
@ -432,7 +432,7 @@
|
||||||
(wrap-mutables expr globals))
|
(wrap-mutables expr globals))
|
||||||
input-program))
|
input-program))
|
||||||
(trace:info "---------------- after wrap-mutables:")
|
(trace:info "---------------- after wrap-mutables:")
|
||||||
(trace:info input-program) ;pretty-print
|
(trace:info (ast:ast->pp-sexp input-program))
|
||||||
|
|
||||||
(set! input-program
|
(set! input-program
|
||||||
(map
|
(map
|
||||||
|
|
|
@ -1573,7 +1573,24 @@
|
||||||
(define (_closure-convert exp globals optimization-level)
|
(define (_closure-convert exp globals optimization-level)
|
||||||
(define (convert exp self-var free-var-lst)
|
(define (convert exp self-var free-var-lst)
|
||||||
(define (cc exp)
|
(define (cc exp)
|
||||||
|
;(trace:error `(cc ,exp))
|
||||||
(cond
|
(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)
|
((const? exp) exp)
|
||||||
((quote? exp) exp)
|
((quote? exp) exp)
|
||||||
((ref? exp)
|
((ref? exp)
|
||||||
|
@ -1591,22 +1608,7 @@
|
||||||
,@(map cc (cdr exp)))) ;; TODO: need to splice?
|
,@(map cc (cdr exp)))) ;; TODO: need to splice?
|
||||||
((set!? exp) `(set! ,(set!->var exp)
|
((set!? exp) `(set! ,(set!->var exp)
|
||||||
,(cc (set!->exp exp))))
|
,(cc (set!->exp exp))))
|
||||||
((lambda? exp)
|
((lambda? exp) (error `(Unexpected lambda in closure-convert ,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))))
|
|
||||||
((if? exp) `(if ,@(map cc (cdr exp))))
|
((if? exp) `(if ,@(map cc (cdr exp))))
|
||||||
((cell? exp) `(cell ,(cc (cell->value exp))))
|
((cell? exp) `(cell ,(cc (cell->value exp))))
|
||||||
((cell-get? exp) `(cell-get ,(cc (cell-get->cell exp))))
|
((cell-get? exp) `(cell-get ,(cc (cell-get->cell exp))))
|
||||||
|
|
|
@ -726,22 +726,33 @@
|
||||||
; wrap-mutables : exp -> exp
|
; wrap-mutables : exp -> exp
|
||||||
(define (wrap-mutables exp globals)
|
(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))
|
(if (not (pair? formals))
|
||||||
body-exp
|
body-exp
|
||||||
|
;(list body-exp)
|
||||||
(if (is-mutable? (car formals))
|
(if (is-mutable? (car formals))
|
||||||
`((lambda (,(car formals))
|
(list ;(ast:%make-lambda
|
||||||
,(wrap-mutable-formals (cdr formals) body-exp))
|
; id
|
||||||
(cell ,(car formals)))
|
(ast:make-lambda
|
||||||
(wrap-mutable-formals (cdr formals) body-exp))))
|
(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
|
(cond
|
||||||
; Core forms:
|
; Core forms:
|
||||||
((ast:lambda? exp)
|
((ast:lambda? exp)
|
||||||
`(lambda ,(ast:lambda-args exp)
|
(ast:%make-lambda
|
||||||
,(wrap-mutable-formals
|
(ast:lambda-id exp)
|
||||||
|
(ast:lambda-args exp)
|
||||||
|
(wrap-mutable-formals
|
||||||
|
(ast:lambda-id exp)
|
||||||
(ast:lambda-formals->list 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)
|
((const? exp) exp)
|
||||||
((ref? exp) (if (and (not (member exp globals))
|
((ref? exp) (if (and (not (member exp globals))
|
||||||
(is-mutable? exp))
|
(is-mutable? exp))
|
||||||
|
@ -749,9 +760,7 @@
|
||||||
exp))
|
exp))
|
||||||
((prim? exp) exp)
|
((prim? exp) exp)
|
||||||
((quote? exp) exp)
|
((quote? exp) exp)
|
||||||
((lambda? exp) `(lambda ,(lambda->formals exp)
|
((lambda? exp) (error `(Unexpected lambda in wrap-mutables ,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
|
|
||||||
((set!? exp) `(,(if (member (set!->var exp) globals)
|
((set!? exp) `(,(if (member (set!->var exp) globals)
|
||||||
'set-global!
|
'set-global!
|
||||||
'set-cell!)
|
'set-cell!)
|
||||||
|
|
Loading…
Add table
Reference in a new issue