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

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

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