diff --git a/module/language/cps/contification.scm b/module/language/cps/contification.scm index b1932dd72..2406a6cce 100644 --- 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 08264518d..8ef361345 100644 --- 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))))))