diff --git a/module/language/cps2/closure-conversion.scm b/module/language/cps2/closure-conversion.scm index 9e3a099ce..7de34482f 100644 --- a/module/language/cps2/closure-conversion.scm +++ b/module/language/cps2/closure-conversion.scm @@ -443,16 +443,6 @@ variable, until we reach a fixed point on the free-vars map." ((= start i) idx) (else (lp (1+ idx) (1+ start))))))) -(define (intmap-select map set) - (persistent-intmap - (intmap-fold - (lambda (k v out) - (if (intset-ref set k) - (intmap-add! out k v) - out)) - map - empty-intmap))) - (define (intset-count set) (intset-fold (lambda (_ count) (1+ count)) set 0)) diff --git a/module/language/cps2/split-rec.scm b/module/language/cps2/split-rec.scm index 20cb516a2..aeb1c6397 100644 --- a/module/language/cps2/split-rec.scm +++ b/module/language/cps2/split-rec.scm @@ -105,51 +105,6 @@ references." (persistent-intset defs))))))) (visit-fun kfun)) -(define (compute-sorted-strongly-connected-components edges) - (define nodes - (intmap-keys edges)) - ;; Add a "start" node that links to all nodes in the graph, and then - ;; remove it from the result. - (define components - (intmap-remove - (compute-strongly-connected-components (intmap-add edges 0 nodes) 0) - 0)) - (define node-components - (intmap-fold (lambda (id nodes out) - (intset-fold (lambda (node out) (intmap-add out node id)) - nodes out)) - components - empty-intmap)) - (define (node-component node) - (intmap-ref node-components node)) - (define (component-successors id nodes) - (intset-remove - (intset-fold (lambda (node out) - (intset-fold - (lambda (successor out) - (intset-add out (node-component successor))) - (intmap-ref edges node) - out)) - nodes - empty-intset) - id)) - (define component-edges - (intmap-map component-successors components)) - (define preds - (invert-graph component-edges)) - (define roots - (intmap-fold (lambda (id succs out) - (if (eq? empty-intset succs) - (intset-add out id) - out)) - component-edges - empty-intset)) - ;; As above, add a "start" node that links to the roots, and remove it - ;; from the result. - (match (compute-reverse-post-order (intmap-add preds 0 roots) 0) - ((0 . ids) - (map (lambda (id) (intmap-ref components id)) ids)))) - (define (compute-split fns free-vars) (define (get-free kfun) ;; It's possible for a fun to have been skipped by diff --git a/module/language/cps2/utils.scm b/module/language/cps2/utils.scm index d96b776c9..e62966e40 100644 --- a/module/language/cps2/utils.scm +++ b/module/language/cps2/utils.scm @@ -54,6 +54,7 @@ compute-predecessors compute-reverse-post-order compute-strongly-connected-components + compute-sorted-strongly-connected-components compute-idoms compute-dom-edges )) @@ -270,7 +271,7 @@ intset." visited)) lp))))) -(define (compute-successors conts kfun) +(define* (compute-successors conts #:optional (kfun (intmap-next conts))) (define (visit label succs) (let visit ((label kfun) (succs empty-intmap)) (define (propagate0) @@ -374,6 +375,58 @@ partitioning the labels into strongly connected components (SCCs)." (fold visit-scc empty-intmap (compute-reverse-post-order succs start)) empty-intmap))) +(define (compute-sorted-strongly-connected-components edges) + "Given a LABEL->SUCCESSOR... graph, return a list of strongly +connected components in sorted order." + (define nodes + (intmap-keys edges)) + ;; Add a "start" node that links to all nodes in the graph, and then + ;; remove it from the result. + (define start + (if (eq? nodes empty-intset) + 0 + (1+ (intset-prev nodes)))) + (define components + (intmap-remove + (compute-strongly-connected-components (intmap-add edges start nodes) + start) + start)) + (define node-components + (intmap-fold (lambda (id nodes out) + (intset-fold (lambda (node out) (intmap-add out node id)) + nodes out)) + components + empty-intmap)) + (define (node-component node) + (intmap-ref node-components node)) + (define (component-successors id nodes) + (intset-remove + (intset-fold (lambda (node out) + (intset-fold + (lambda (successor out) + (intset-add out (node-component successor))) + (intmap-ref edges node) + out)) + nodes + empty-intset) + id)) + (define component-edges + (intmap-map component-successors components)) + (define preds + (invert-graph component-edges)) + (define roots + (intmap-fold (lambda (id succs out) + (if (eq? empty-intset succs) + (intset-add out id) + out)) + component-edges + empty-intset)) + ;; As above, add a "start" node that links to the roots, and remove it + ;; from the result. + (match (compute-reverse-post-order (intmap-add preds start roots) start) + (((? (lambda (id) (eqv? id start))) . ids) + (map (lambda (id) (intmap-ref components id)) ids)))) + ;; Precondition: For each function in CONTS, the continuation names are ;; topologically sorted. (define (compute-idoms conts kfun)