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

Added safety checks

Browse source
This commit is contained in:
Justin Ethier 2019-09-19 13:16:04 -04:00
parent 7ed21d9c7a
commit ff65b5d2ed
1 changed files with 21 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -1959,21 +1959,27 @@
))))))
(cond
(replace
(define (clo->lambda-body sexp)
(car (ast:lambda-body (cadr sexp))))
(with-handler
(lambda (err)
(trace:error `(error transforming CC loop ,err))
result)
(cond
((and replace
(tagged-list? '%closure (car result)) ;; TODO: see above, not always a closure, what to do then?
)
(define (clo->lambda-body sexp)
(car (ast:lambda-body (cadr sexp))))
(let* ((outer-body (clo->lambda-body (car result))) ; (clo-call cell)
(inner-body (clo->lambda-body (car outer-body)))
(set-cell-exp (cadr inner-body))
(set-clo (caddr set-cell-exp))
)
(set-car! (cdr inner-body) #f) ; '%Cyc-noop ;; Don't do the set
(set-cdr! outer-body `((cell ,set-clo))) ;; Relocate the closure
result
))
(else result))
(let* ((outer-body (clo->lambda-body (car result))) ; (clo-call cell)
(inner-body (clo->lambda-body (car outer-body)))
(set-cell-exp (cadr inner-body))
(set-clo (caddr set-cell-exp))
)
(set-car! (cdr inner-body) #f) ; '%Cyc-noop ;; Don't do the set
(set-cdr! outer-body `((cell ,set-clo))) ;; Relocate the closure
result
))
(else result)))
))
((lambda? fn) (error `(Unexpected lambda in closure-convert ,exp)))
(else