mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-10 14:00:21 +02:00
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.
This commit is contained in:
parent
3b1d316383
commit
19024bdc27
3 changed files with 54 additions and 56 deletions
|
@ -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))
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue