1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 21:40:33 +02:00

Closure conversion, reify-primitives use $kfun $cont

* module/language/cps/closure-conversion.scm: Produce a $kfun $cont.
* module/language/cps/reify-primitives.scm: Produce and consume $kfun
  $cont.
* module/language/cps/compile-bytecode.scm: Adapt.
This commit is contained in:
Andy Wingo 2014-04-11 11:51:34 +02:00
parent 6bc36ca55e
commit b85f5f851f
3 changed files with 60 additions and 64 deletions

View file

@ -281,5 +281,4 @@ and allocate and initialize flat closures."
(receive (body free) (cc body #f '())
(unless (null? free)
(error "Expected no free vars in toplevel thunk" exp body free))
(build-cps-exp
($fun free ,(convert-to-indices body free))))))))
(convert-to-indices body free))))))

View file

@ -506,13 +506,12 @@
(exp (optimize exp opts))
(exp (convert-closures exp))
(exp (reify-primitives exp))
(exp (renumber exp))
(exp (match (renumber (build-cps-exp ($fun '() ,exp)))
(($ $fun free body) body)))
(asm (make-assembler)))
(visit-funs (lambda (fun)
(compile-fun fun asm))
(match exp
(($ $fun free body)
body)))
exp)
(values (link-assembly asm #:page-aligned? (kw-arg-ref opts #:to-file? #f))
env
env)))

View file

@ -107,10 +107,8 @@
;; FIXME: Operate on one function at a time, for efficiency.
(define (reify-primitives fun)
(match fun
(($ $fun free body)
(with-fresh-name-state body
(let ((conts (build-cont-table body)))
(with-fresh-name-state fun
(let ((conts (build-cont-table fun)))
(define (visit-fun term)
(rewrite-cps-exp term
(($ $fun free body)
@ -166,4 +164,4 @@
(else (primitive-ref name k* src)))))))))
(_ term)))))
(visit-fun fun))))))
(visit-cont fun))))