Root higher-order CPS term is always $kfun $cont

[bpt/guile.git] / module / language / cps / contification.scm

diff --git a/module/language/cps/contification.scm b/module/language/cps/contification.scm
index 267a4d6..dc832c3 100644 (file)
--- a/module/language/cps/contification.scm
+++ b/module/language/cps/contification.scm
@@ -39,9 +39,7 @@
   #:export (contify))
 
 (define (compute-contification fun)
-  (let* ((dfg (match fun
-                (($ $fun free body)
-                 (compute-dfg body))))
+  (let* ((dfg (compute-dfg fun))
          (scope-table (make-hash-table))
          (call-substs '())
          (cont-substs '())
@@ -294,7 +292,7 @@
                 (visit-fun exp)))
            (_ #t)))))
 
-    (visit-fun fun)
+    (visit-cont fun)
     (values call-substs cont-substs fun-elisions cont-splices)))
 
 (define (apply-contification fun call-substs cont-substs fun-elisions cont-splices)
@@ -401,7 +399,7 @@
            (or (contify-call src proc args)
                (continue k src exp)))
           (_ (continue k src exp)))))))
-  (visit-fun fun))
+  (visit-cont fun))
 
 (define (contify fun)
   (call-with-values (lambda () (compute-contification fun))