diff --git a/cyclone.scm b/cyclone.scm index a0e4011b..ed495cb0 100644 --- a/cyclone.scm +++ b/cyclone.scm @@ -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 diff --git a/scheme/cyclone/cps-optimizations.sld b/scheme/cyclone/cps-optimizations.sld index a05c2cc2..5a285943 100644 --- a/scheme/cyclone/cps-optimizations.sld +++ b/scheme/cyclone/cps-optimizations.sld @@ -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)))) diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld index add78d10..c851f472 100644 --- a/scheme/cyclone/transforms.sld +++ b/scheme/cyclone/transforms.sld @@ -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!)