1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 06:20:23 +02:00

Preparation for compile-bytecode to work on $kfun $conts

* module/language/cps/compile-bytecode.scm (compile-fun): Change to take
  a $kfun $cont instead of a $fun.
  (visit-funs): Change likewise, and call the proc on $kfun $cont's, not
  $fun's.
  (compile-bytecode): Adapt.

* module/language/cps/dfg.scm (analyze-reverse-control-flow): Adapt to
  expect a $kfun $cont.
This commit is contained in:
Andy Wingo 2014-04-11 11:34:50 +02:00
parent a16af11320
commit 6bc36ca55e
2 changed files with 7 additions and 8 deletions

View file

@ -89,9 +89,7 @@
exp)) exp))
(define (compile-fun f asm) (define (compile-fun f asm)
(let* ((dfg (match f (let* ((dfg (compute-dfg f #:global? #f))
(($ $fun free body)
(compute-dfg body #:global? #f))))
(allocation (allocate-slots f dfg))) (allocation (allocate-slots f dfg)))
(define (maybe-slot sym) (define (maybe-slot sym)
(lookup-maybe-slot sym allocation)) (lookup-maybe-slot sym allocation))
@ -473,7 +471,7 @@
(emit-call-label asm proc-slot nargs k)))))) (emit-call-label asm proc-slot nargs k))))))
(match f (match f
(($ $fun free ($ $cont k ($ $kfun src meta self tail clause))) (($ $cont k ($ $kfun src meta self tail clause))
(compile-entry))))) (compile-entry)))))
(define (visit-funs proc exp) (define (visit-funs proc exp)
@ -482,7 +480,6 @@
(visit-funs proc exp)) (visit-funs proc exp))
(($ $fun free body) (($ $fun free body)
(proc exp)
(visit-funs proc body)) (visit-funs proc body))
(($ $letk conts body) (($ $letk conts body)
@ -498,6 +495,7 @@
(visit-funs proc alternate))) (visit-funs proc alternate)))
(($ $cont sym ($ $kfun src meta self tail clause)) (($ $cont sym ($ $kfun src meta self tail clause))
(proc exp)
(when clause (when clause
(visit-funs proc clause))) (visit-funs proc clause)))
@ -512,7 +510,9 @@
(asm (make-assembler))) (asm (make-assembler)))
(visit-funs (lambda (fun) (visit-funs (lambda (fun)
(compile-fun fun asm)) (compile-fun fun asm))
exp) (match exp
(($ $fun free body)
body)))
(values (link-assembly asm #:page-aligned? (kw-arg-ref opts #:to-file? #f)) (values (link-assembly asm #:page-aligned? (kw-arg-ref opts #:to-file? #f))
env env
env))) env)))

View file

@ -325,8 +325,7 @@ body continuation in the prompt."
succs)) succs))
(match fun (match fun
(($ $fun free (($ $cont kfun ($ $kfun src meta self ($ $cont ktail tail)))
($ $cont kfun ($ $kfun src meta self ($ $cont ktail tail))))
(call-with-values (call-with-values
(lambda () (lambda ()
(compute-reverse-control-flow-order ktail dfg)) (compute-reverse-control-flow-order ktail dfg))