dfg: variable-free-in?, add variable-bound-in?

* module/language/cps/dfg.scm (variable-free-in?): Rename from
  variable-used-in?, to match CWCC language.
  (variable-bound-in?): New interface.

* module/language/cps/contification.scm (contify): Adapt caller.  Add
  more comments.

diff --git a/module/language/cps/contification.scm b/module/language/cps/contification.scm
index b1932dd..2406a6c 100644 (file)
--- a/module/language/cps/contification.scm
+++ b/module/language/cps/contification.scm
@@ -80,6 +80,12 @@
                     (list sym) (list self) (list tail)
                     (list arities) (list bodies)))
 
+    ;; Given a set of mutually recursive functions bound to local
+    ;; variables SYMS, with self symbols SELFS, tail continuations
+    ;; TAILS, arities ARITIES, and bodies BODIES, all bound in TERM-K,
+    ;; contify them if we can prove that they all return to the same
+    ;; continuation.  If successful, return that common continuation.
+    ;; Otherwise return #f.
     (define (contify-funs term-k syms selfs tails arities bodies)
       ;; Are the given args compatible with any of the arities?
       (define (applicable? proc args)
@@ -162,7 +168,7 @@
            ;; components, and lump everything else in the remaining
            ;; component.
            (define (recursive? k)
-             (or-map (cut variable-used-in? <> k dfg) syms))
+             (or-map (cut variable-free-in? <> k dfg) syms))
            (let lp ((nsf nsf) (rec '()))
              (match nsf
                (()

diff --git a/module/language/cps/dfg.scm b/module/language/cps/dfg.scm
index 0826451..8ef3613 100644 (file)
--- a/module/language/cps/dfg.scm
+++ b/module/language/cps/dfg.scm
@@ -54,7 +54,8 @@
             find-defining-expression
             find-constant-value
             lift-definition!
-            variable-used-in?
+            variable-bound-in?
+            variable-free-in?
             constant-needs-allocation?
             dead-after-def?
             dead-after-use?
@@ -341,11 +342,18 @@
              (lp body))
             (_ #t))))))))
 
-(define (variable-used-in? var parent-k dfg)
+(define (variable-bound-in? var k dfg)
+  (match dfg
+    (($ $dfg conts use-maps uplinks)
+     (match (lookup-use-map k use-maps)
+       (($ $use-map sym def uses)
+        (continuation-scope-contains? def k uplinks))))))
+
+(define (variable-free-in? var k dfg)
   (match dfg
     (($ $dfg conts use-maps uplinks)
      (or-map (lambda (use)
-               (continuation-scope-contains? parent-k use uplinks))
+               (continuation-scope-contains? k use uplinks))
              (match (lookup-use-map var use-maps)
                (($ $use-map sym def uses)
                 uses))))))