Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-05 04:06:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Issue #269 - Let wrap-mutables emit ast

Browse source
This commit is contained in:
Justin Ethier 2018-08-09 13:51:38 -04:00
parent f600efa052
commit e398c50fd1
2 changed files with 20 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
cyclone.scm
View file

@ -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

31
scheme/cyclone/transforms.sld
View file

@ -726,22 +726,31 @@
; 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 (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))) (car formals)
(wrap-mutable-formals (cdr formals) body-exp)))) (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 +758,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!)