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

Fixup closure symbols

Browse source
This commit is contained in:
Justin Ethier 2019-09-20 12:56:52 -04:00
parent fa9fc03043
commit 18a8c4f28e
1 changed files with 85 additions and 35 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

106
validation.scm
View file

@ -5,6 +5,7 @@
(scheme write) (scheme write)
(scheme cyclone ast) (scheme cyclone ast)
(scheme cyclone primitives) (scheme cyclone primitives)
(scheme cyclone transforms)
(scheme cyclone util) (scheme cyclone util)
(scheme cyclone pretty-print)))) (scheme cyclone pretty-print))))
@ -16,36 +17,66 @@
(define sexp (define sexp
' ((%closure ' ((%closure
(lambda (lambda
(self$42 loop$8$19) (self$631 select-a$214)
((%closure ((%closure
(lambda (lambda
(self$43 loop$8$19) (self$632 select-a$214)
(Cyc-seq (Cyc-seq
(set-cell! (set-cell!
loop$8$19 select-a$214
(%closure (%closure
(lambda (...)
(self$44 k$28 x$9$20) (%closure-ref self$632 1)
(if (zero?__inline__ x$9$20) select-a$214
((%closure-ref write 0) (%closure-ref self$632 4)))
write ((%closure-ref (cell-get select-a$214) 0)
k$28 (cell-get select-a$214)
'done) (%closure-ref self$632 2)
((%closure-ref '()
(cell-get (%closure-ref self$44 1)) (%closure-ref self$632 3))))
0) (%closure-ref self$631 1)
(cell-get (%closure-ref self$44 1)) (%closure-ref self$631 2)
k$28 (%closure-ref self$631 3)
(Cyc-fast-sub x$9$20 1)))) (%closure-ref self$631 4))
loop$8$19)) (cell select-a$214)))
((%closure-ref (cell-get loop$8$19) 0) func$32$211
(cell-get loop$8$19) k$368
(%closure-ref self$43 1) lst$33$212
10))) test$31$210)
(%closure-ref self$42 1)) #f)
(cell loop$8$19))) ; '((%closure
(%closure-ref self$41 1)) ; (lambda
#f)) ; (self$42 loop$8$19)
; ((%closure
; (lambda
; (self$43 loop$8$19)
; (Cyc-seq
; (set-cell!
; loop$8$19
; (%closure
; (lambda
; (self$44 k$28 x$9$20)
; (if (zero?__inline__ x$9$20)
; ((%closure-ref write 0)
; write
; k$28
; 'done)
; ((%closure-ref
; (cell-get (%closure-ref self$44 1))
; 0)
; (cell-get (%closure-ref self$44 1))
; k$28
; (Cyc-fast-sub x$9$20 1))))
; loop$8$19))
; ((%closure-ref (cell-get loop$8$19) 0)
; (cell-get loop$8$19)
; (%closure-ref self$43 1)
; 10)))
; (%closure-ref self$42 1))
; (cell loop$8$19)))
; (%closure-ref self$41 1))
; #f)
)
(define ast (ast:sexp->ast sexp)) (define ast (ast:sexp->ast sexp))
@ -59,13 +90,32 @@
(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)
(write `(DEBUG ,nc ,oc))(newline)
(map
(lambda (e)
(write `(DEBUG ,e)) (newline)
(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 ast))) ; (clo-call cell) (let* ((outer-body (clo->lambda-body (car ast))) ; (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 ast)))
(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))
) )
(write outer-body)
(set-car! (cdr inner-body) #f) ;; Don't do the set (set-car! (cdr inner-body) #f) ;; Don't do the set
(set-cdr! outer-body `((cell ,set-clo))) ;; Relocate the closure (set-cdr! outer-body `((cell ,set-clo))) ;; Relocate the closure
;; TODO: replace self ref in params to set-clo ;; TODO: replace self ref in params to set-clo