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

Rewrite mutated vars to prevent mutations for loops

Browse source
This commit is contained in:
Justin Ethier 2019-09-16 22:25:12 -04:00
parent 82dd4cb5c3
commit e45837a19f
1 changed files with 28 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

41
scheme/cyclone/cps-optimizations.sld
View file

@ -2501,9 +2501,10 @@
(define mutated-loop-vars '()) (define mutated-loop-vars '())
(define (mark-mutated-loop-var sym) (define (mark-mutated-loop-var sym)
;(write `(DEBUG mark mutated loop var ,sym)) (newline)
(set! mutated-loop-vars (cons sym mutated-loop-vars))) (set! mutated-loop-vars (cons sym mutated-loop-vars)))
(define (mutated-loop-var? sym) (define (mutated-loop-var? sym)
(member sym mutated-loop-var)) (member sym mutated-loop-vars))
; analyze-mutable-variables : exp -> void ; analyze-mutable-variables : exp -> void
(define (analyze-mutable-variables exp) (define (analyze-mutable-variables exp)
@ -2531,12 +2532,16 @@
(map analyze-mutable-variables exp) (map analyze-mutable-variables exp)
;; Check if the application is a sentinel indicating the ;; Check if the application is a sentinel indicating the
;; var may be used for a recursive loop. ;; var may be used for a recursive loop.
;(when (and (= 2 (length exp)) (when (and (= 2 (length exp))
; (ast:lambda? (car exp)) (ast:lambda? (car exp))
; (not (cadr exp))) (not (cadr exp)))
; ;; Candidate, see if the var is set to a lambda ;; Candidate, see if the var is set to a lambda
; (with-var (with-var (car (ast:lambda-formals->list (car exp))) (lambda (var)
;) (if (and (adbv:mutated-by-set? var)
(ast:lambda? (adbv:assigned-value var)))
(mark-mutated-loop-var (car (ast:lambda-formals->list (car exp)))))
))
)
(void)) (void))
(else (else
(error "unknown expression type: " exp)))) (error "unknown expression type: " exp))))
@ -2557,7 +2562,12 @@
(list (car formals)) (list (car formals))
(wrap-mutable-formals id (cdr formals) body-exp has-cont) (wrap-mutable-formals id (cdr formals) body-exp has-cont)
has-cont) has-cont)
`(cell ,(car formals)))) `(cell ;,(car formals)
,(if (mutated-loop-var? (car formals))
(with-var (car formals) (lambda (var)
(adbv:assigned-value var)))
(car formals))
)))
(wrap-mutable-formals id (cdr formals) body-exp has-cont)))) (wrap-mutable-formals id (cdr formals) body-exp has-cont))))
(cond (cond
@ -2581,11 +2591,16 @@
((prim? exp) exp) ((prim? exp) exp)
((quote? exp) exp) ((quote? exp) exp)
((lambda? exp) (error `(Unexpected lambda in wrap-mutables ,exp))) ((lambda? exp) (error `(Unexpected lambda in wrap-mutables ,exp)))
((set!? exp) `(,(if (member (set!->var exp) globals) ((set!? exp)
'set-global! (cond
'set-cell!) ((mutated-loop-var? (set!->var exp))
,(set!->var exp) #f) ;; essentially no-op in generated code
,(wrap-mutables (set!->exp exp) globals))) (else
`(,(if (member (set!->var exp) globals)
'set-global!
'set-cell!)
,(set!->var exp)
,(wrap-mutables (set!->exp exp) globals)))))
((if? exp) `(if ,(wrap-mutables (if->condition exp) globals) ((if? exp) `(if ,(wrap-mutables (if->condition exp) globals)
,(wrap-mutables (if->then exp) globals) ,(wrap-mutables (if->then exp) globals)
,(wrap-mutables (if->else exp) globals))) ,(wrap-mutables (if->else exp) globals)))