[Guile-commits] 03/13: Utils refactors

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 19024bdc2715949bf65a270118fafe2057a84193
Author: Andy Wingo <address@hidden>
Date:   Sun Jul 19 12:21:31 2015 +0200

    Utils refactors
    
    * module/language/cps2/utils.scm (compute-successors): kfun is
      optional.
      (compute-sorted-strongly-connected-components): New function, moved
      from split-rec.scm.  Doesn't assume that 0 is a free node identifier.
    
    * module/language/cps2/split-rec.scm
      (compute-sorted-strongly-connected-components): Remove, use utils.scm
      version instead.
    
    * module/language/cps2/closure-conversion.scm (intset-select): Remove
      unused function.
---
 module/language/cps2/closure-conversion.scm |   10 -----
 module/language/cps2/split-rec.scm          |   45 ----------------------
 module/language/cps2/utils.scm              |   55 ++++++++++++++++++++++++++-
 3 files changed, 54 insertions(+), 56 deletions(-)

diff --git a/module/language/cps2/closure-conversion.scm 
b/module/language/cps2/closure-conversion.scm
index 9e3a099..7de3448 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 20cb516..aeb1c63 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 d96b776..e62966e 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)