[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 03/13: Utils refactors
From: |
Andy Wingo |
Subject: |
[Guile-commits] 03/13: Utils refactors |
Date: |
Wed, 22 Jul 2015 15:32:26 +0000 |
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)
- [Guile-commits] branch master updated (90aabcc -> aa7f0e2), Andy Wingo, 2015/07/22
- [Guile-commits] 04/13: CPS1 slot-allocation simplification, Andy Wingo, 2015/07/22
- [Guile-commits] 05/13: More slot-allocation simplification, Andy Wingo, 2015/07/22
- [Guile-commits] 03/13: Utils refactors,
Andy Wingo <=
- [Guile-commits] 07/13: Fix bad return shuffles for multiply-used $kreceive conts, Andy Wingo, 2015/07/22
- [Guile-commits] 01/13: Reify primitives in CPS2, Andy Wingo, 2015/07/22
- [Guile-commits] 09/13: Fix CPS2 compute-successors, Andy Wingo, 2015/07/22
- [Guile-commits] 06/13: Fix error printing some wrong-num-args backtraces, Andy Wingo, 2015/07/22
- [Guile-commits] 02/13: Add intset-prev and intset-fold-right, Andy Wingo, 2015/07/22
- [Guile-commits] 11/13: Compile CPS2 directly to bytecode, Andy Wingo, 2015/07/22
- [Guile-commits] 08/13: intset-intersect bugfix, Andy Wingo, 2015/07/22
- [Guile-commits] 10/13: Slot allocation and bytecode compilation from CPS2., Andy Wingo, 2015/07/22
- [Guile-commits] 12/13: Remove CPS1 language, Andy Wingo, 2015/07/22
- [Guile-commits] 13/13: Rename CPS2 to CPS, Andy Wingo, 2015/07/22