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

Incorporate closure renaming fixes from validation

Browse source
This commit is contained in:
Justin Ethier 2019-09-20 13:05:41 -04:00
parent 18a8c4f28e
commit 619f60a36b
1 changed files with 19 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -1968,11 +1968,29 @@
) )
(define (clo->lambda-body sexp) (define (clo->lambda-body sexp)
(car (ast:lambda-body (cadr sexp)))) (car (ast:lambda-body (cadr sexp))))
(define (clo->self-ref sexp)
(car (ast:lambda-formals->list (cadr sexp))))
(define (fix-clo-refs sexp nc oc)
(map
(lambda (e)
(cond
((and (tagged-list? '%closure-ref e)
(eq? oc (cadr e)))
`(%closure-ref ,nc ,(caddr e)))
(else e)))
sexp))
(let* ((outer-body (clo->lambda-body (car result))) ; (clo-call cell) (let* ((outer-body (clo->lambda-body (car result))) ; (clo-call cell)
(inner-body (clo->lambda-body (car outer-body))) (inner-body (clo->lambda-body (car outer-body)))
(inner-clo-sym (clo->self-ref (car outer-body)))
(outer-clo-sym (clo->self-ref (car result)))
(set-cell-exp (cadr inner-body)) (set-cell-exp (cadr inner-body))
(set-clo (caddr set-cell-exp)) (set-clo (fix-clo-refs
(caddr set-cell-exp)
outer-clo-sym
inner-clo-sym))
) )
(mark-mutated-loop-var replace) (mark-mutated-loop-var replace)
(set-car! (cdr inner-body) #f) ; '%Cyc-noop ;; Don't do the set (set-car! (cdr inner-body) #f) ; '%Cyc-noop ;; Don't do the set