summaryrefslogtreecommitdiff
path: root/module/language/cps/utils.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2015-07-27 13:25:38 +0200
committerAndy Wingo <wingo@pobox.com>2015-07-27 13:25:38 +0200
commit4792577ab8c5c6264a48cc8d6592ca7c1103c2c7 (patch)
tree03fa602d623c5ab500a02826d8300800a8db98d9 /module/language/cps/utils.scm
parentce2888701c02870aeaeba53675e2cc132c9d10dc (diff)
downloadguile-4792577ab8c5c6264a48cc8d6592ca7c1103c2c7.tar.gz
solve-flow-equations tweak
* 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.
Diffstat (limited to 'module/language/cps/utils.scm')
-rw-r--r--module/language/cps/utils.scm22
1 files changed, 11 insertions, 11 deletions
diff --git a/module/language/cps/utils.scm b/module/language/cps/utils.scm
index 9f95e0171..fcbda9e76 100644
--- a/module/language/cps/utils.scm
+++ b/module/language/cps/utils.scm
@@ -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)))))))