[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guilecommits] 02/06: Move solveflowequations to utils
From: 
Andy Wingo 
Subject: 
[Guilecommits] 02/06: Move solveflowequations to utils 
Date: 
Fri, 24 Jul 2015 15:13:39 +0000 
wingo pushed a commit to branch master
in repository guile.
commit bebc70c8b1f584c9f1e360ffc38094af4a4cee49
Author: Andy Wingo <address@hidden>
Date: Fri Jul 24 11:40:00 2015 +0200
Move solveflowequations to utils
* module/language/cps/slotallocation.scm (computelazyvars):
(computelivevariables): Adapt to solveflowequations interface
change.
* module/language/cps/utils.scm (solveflowequations): Move here. Use
an init value instead of an init map.

module/language/cps/slotallocation.scm  60 +++
module/language/cps/utils.scm  46 +++++++++++++++++++++++
2 files changed, 51 insertions(+), 55 deletions()
diff git a/module/language/cps/slotallocation.scm
b/module/language/cps/slotallocation.scm
index 74e71c4..6039214 100644
 a/module/language/cps/slotallocation.scm
+++ b/module/language/cps/slotallocation.scm
@@ 128,48 +128,6 @@
(define (lookupnlocals k allocation)
(intmapref (allocationframesizes allocation) k))
(define (intsetpop set)
 (match (intsetnext set)
 (#f (values set #f))
 (i (values (intsetremove set i) i))))

(define (solveflowequations succs in out kill gen subtract add meet)
 "Find a fixed point for flow equations for SUCCS, where IN and OUT are
the initial conditions as intmaps with one key for every node in SUCCS.
KILL and GEN are intmaps indicating the state that is killed or defined
at every node, and SUBTRACT, ADD, and MEET operates on that state."
 (define (visit label in out)
 (let* ((in1 (intmapref in label))
 (kill1 (intmapref kill label))
 (gen1 (intmapref gen label))
 (out1 (intmapref out label))
 (out1* (add (subtract in1 kill1) gen1)))
 (if (eq? out1 out1*)
 (values emptyintset in out)
 (let ((out (intmapreplace! out label out1*)))
 (callwithvalues
 (lambda ()
 (intsetfold (lambda (succ in changed)
 (let* ((in1 (intmapref in succ))
 (in1* (meet in1 out1*)))
 (if (eq? in1 in1*)
 (values in changed)
 (values (intmapreplace! in succ in1*)
 (intsetadd changed succ)))))
 (intmapref succs label) in emptyintset))
 (lambda (in changed)
 (values changed in out)))))))

 (let run ((worklist (intmapkeys succs)) (in in) (out out))
 (callwithvalues (lambda () (intsetpop worklist))
 (lambda (worklist popped)
 (if popped
 (callwithvalues (lambda () (visit popped in out))
 (lambda (changed in out)
 (run (intsetunion worklist changed) in out)))
 (values (persistentintmap in)
 (persistentintmap out)))))))

(definesyntaxrule (persistentintmap2 exp)
(callwithvalues (lambda () exp)
(lambda (a b)
@@ 321,14 +279,11 @@ the definitions that are live before and after LABEL, as
intsets."
(old>new (computereversecontrolfloworder preds)))
(callwithvalues
(lambda ()
 (let ((init (renamekeys
 (intmapmap (lambda (k v) emptyintset) preds)
 old>new)))
 (solveflowequations (renamegraph preds old>new)
 init init
 (renamekeys defs old>new)
 (renamekeys uses old>new)
 intsetsubtract intsetunion intsetunion)))
+ (solveflowequations (renamegraph preds old>new)
+ emptyintset
+ (renamekeys defs old>new)
+ (renamekeys uses old>new)
+ intsetsubtract intsetunion intsetunion))
(lambda (in out)
;; As a reverse controlflow problem, the values flowing into a
;; node are actually the live values after the node executes.
@@ 448,12 +403,9 @@ is an active call."
(callwithvalues
(lambda ()
(let ((succs (renamegraph preds old>new))
 (in (renamekeys (intmapmap (lambda (k v) #f) preds)
old>new))
 (out (renamekeys (intmapmap (lambda (k v) #f) preds)
old>new))
 ;(out (renamekeys gens old>new))
(kills (renamekeys kills old>new))
(gens (renamekeys gens old>new)))
 (solveflowequations succs in out kills gens subtract add meet)))
+ (solveflowequations succs #f kills gens subtract add meet)))
(lambda (in out)
;; A variable is lazy if its uses reach its definition.
(intmapfold (lambda (label out lazy)
diff git a/module/language/cps/utils.scm b/module/language/cps/utils.scm
index fa4673c..9f95e01 100644
 a/module/language/cps/utils.scm
+++ b/module/language/cps/utils.scm
@@ 57,6 +57,7 @@
computesortedstronglyconnectedcomponents
computeidoms
computedomedges
+ solveflowequations
))
(define labelcounter (makeparameter #f))
@@ 233,7 +234,7 @@ disjoint, an error will be signalled."
(visitcont k labels))
(_ labels)))))))))))
(define (computereachablefunctions conts kfun)
+(define* (computereachablefunctions conts #:optional (kfun 0))
"Compute a mapping LABEL>LABEL..., where each key is a reachable
$kfun and each associated value is the body of the function, as an
intset."
@@ 475,3 +476,46 @@ connected components in sorted order."
(else (intmapadd! doms idom label snoc)))))
idoms
emptyintmap)))
+
+(define (intsetpop set)
+ (match (intsetnext set)
+ (#f (values set #f))
+ (i (values (intsetremove set i) i))))
+
+(define (solveflowequations succs init kill gen subtract add meet)
+ "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
+SUBTRACT, ADD, and MEET operates on that state."
+ (define (visit label in out)
+ (let* ((in1 (intmapref in label))
+ (kill1 (intmapref kill label))
+ (gen1 (intmapref gen label))
+ (out1 (intmapref out label))
+ (out1* (add (subtract in1 kill1) gen1)))
+ (if (eq? out1 out1*)
+ (values emptyintset in out)
+ (let ((out (intmapreplace! out label out1*)))
+ (callwithvalues
+ (lambda ()
+ (intsetfold (lambda (succ in changed)
+ (let* ((in1 (intmapref in succ))
+ (in1* (meet in1 out1*)))
+ (if (eq? in1 in1*)
+ (values in changed)
+ (values (intmapreplace! in succ in1*)
+ (intsetadd changed succ)))))
+ (intmapref succs label) in emptyintset))
+ (lambda (in changed)
+ (values changed in out)))))))
+
+ (let ((init (intmapmap (lambda (k v) init) succs)))
+ (let run ((worklist (intmapkeys succs)) (in init) (out init))
+ (callwithvalues (lambda () (intsetpop worklist))
+ (lambda (worklist popped)
+ (if popped
+ (callwithvalues (lambda () (visit popped in out))
+ (lambda (changed in out)
+ (run (intsetunion worklist changed) in out)))
+ (values (persistentintmap in)
+ (persistentintmap out))))))))
 [Guilecommits] branch master updated (4aabc20 > ee85e29), Andy Wingo, 2015/07/24
 [Guilecommits] 01/06: Factor out computeeffects/elidetypechecks from dce.scm, Andy Wingo, 2015/07/24
 [Guilecommits] 04/06: Small expressioneffects tweak, Andy Wingo, 2015/07/24
 [Guilecommits] 02/06: Move solveflowequations to utils,
Andy Wingo <=
 [Guilecommits] 05/06: Eliminate trampoline gotos when possible in compilebytecode, Andy Wingo, 2015/07/24
 [Guilecommits] 03/06: Loopinvariant code motion, Andy Wingo, 2015/07/24
 [Guilecommits] 06/06: Rotate comparisons down to loop backedges, Andy Wingo, 2015/07/24