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.

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

diff --git a/module/language/cps/dfg.scm b/module/language/cps/dfg.scm
index 85138c5..5233719 100644 (file)
--- a/module/language/cps/dfg.scm
+++ b/module/language/cps/dfg.scm
@@ -325,8 +325,7 @@ body continuation in the prompt."
       succs))
 
   (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
          (lambda ()
            (compute-reverse-control-flow-order ktail dfg))