mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

solve-flow-equations tweak

Browse source 
* module/language/cps/utils.scm (solve-flow-equations): Revert to take
  separate in and out maps.  Take an optional initial worklist.

* module/language/cps/slot-allocation.scm: Adapt to solve-flow-equations
  change.
This commit is contained in:
Andy Wingo 2015-07-27 13:25:38 +02:00
parent ce2888701c
commit 4792577ab8
2 changed files with 24 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

16
module/language/cps/slot-allocation.scm
View file

@ -276,11 +276,15 @@ body continuation in the prompt."
the definitions that are live before and after LABEL, as intsets."
(let* ((succs (add-prompt-control-flow-edges cps (compute-successors cps)))
(preds (invert-graph succs))
(old->new (compute-reverse-control-flow-order preds)))
(old->new (compute-reverse-control-flow-order preds))
(init (persistent-intmap (intmap-fold
(lambda (old new init)
(intmap-add! init new empty-intset))
old->new empty-intmap))))
(call-with-values
(lambda ()
(solve-flow-equations (rename-graph preds old->new)
empty-intset
init init
(rename-keys defs old->new)
(rename-keys uses old->new)
intset-subtract intset-union intset-union))
@ -403,9 +407,15 @@ is an active call."
(call-with-values
(lambda ()
(let ((succs (rename-graph preds old->new))
(init (persistent-intmap
(intmap-fold
(lambda (old new in)
(intmap-add! in new #f))
old->new empty-intmap)))
(kills (rename-keys kills old->new))
(gens (rename-keys gens old->new)))
(solve-flow-equations succs #f kills gens subtract add meet)))
(solve-flow-equations succs init init kills gens
subtract add meet)))
(lambda (in out)
;; A variable is lazy if its uses reach its definition.
(intmap-fold (lambda (label out lazy)

22
module/language/cps/utils.scm
View file

@ -482,7 +482,8 @@ connected components in sorted order."
(#f (values set #f))
(i (values (intset-remove set i) i))))
(define (solve-flow-equations succs init kill gen subtract add meet)
(define* (solve-flow-equations succs in out kill gen subtract add meet
#:optional (worklist (intmap-keys succs)))
"Find a fixed point for flow equations for SUCCS, where INIT is the
initial state at each node in SUCCS. KILL and GEN are intmaps
indicating the state that is killed or defined at every node, and
@ -509,13 +510,12 @@ SUBTRACT, ADD, and MEET operates on that state."
(lambda (in changed)
(values changed in out)))))))
(let ((init (intmap-map (lambda (k v) init) succs)))
(let run ((worklist (intmap-keys succs)) (in init) (out init))
(call-with-values (lambda () (intset-pop worklist))
(lambda (worklist popped)
(if popped
(call-with-values (lambda () (visit popped in out))
(lambda (changed in out)
(run (intset-union worklist changed) in out)))
(values (persistent-intmap in)
(persistent-intmap out))))))))
(let run ((worklist worklist) (in in) (out out))
(call-with-values (lambda () (intset-pop worklist))
(lambda (worklist popped)
(if popped
(call-with-values (lambda () (visit popped in out))
(lambda (changed in out)
(run (intset-union worklist changed) in out)))
(values (persistent-intmap in)
(persistent-intmap out)))))))