2 {-# LANGUAGE MultiParamTypeClasses #-}
5 , BComputation(..), BAnalysis, BTransformation, BFunctionalTransformation
6 , BPass, BUnlimitedPass
7 , FComputation(..), FAnalysis, FTransformation, FPass, FUnlimitedPass
10 , anal_b, a_t_b, a_ft_b, a_ft_b_unlimited, ignore_transactions_b
12 , run_b_anal, run_f_anal
13 , refine_f_anal, refine_b_anal, fold_edge_facts_b, fold_edge_facts_with_nodes_b
14 , b_rewrite, f_rewrite
15 , solve_graph_b, solve_graph_f
21 import ZipCfg hiding (freshBlockId) -- use version from DFMonad
22 import qualified ZipCfg as G
34 \section{A very polymorphic infrastructure for dataflow problems}
36 This module presents a framework for solving iterative dataflow
38 There are two major submodules: one for forward problems and another
39 for backward problems.
40 Both modules incorporate the composition framework developed by
41 Lerner, Grove, and Chambers.
42 They also support a \emph{transaction limit}, which enables the
43 binary-search debugging technique developed by Whalley and Davidson
44 under the name \emph{vpoiso}.
45 Transactions may either be known to the individual dataflow solvers or
46 may be managed by the framework.
49 -- | In the composition framework, a pass either produces a dataflow
50 -- fact or proposes to rewrite the graph. To make life easy for the
51 -- clients, the rewrite is given in unlabelled form, but we use
52 -- labelled form internally throughout, because it greatly simplifies
53 -- the implementation not to have the first block be a special case
56 data Answer m l a = Dataflow a | Rewrite (Graph m l)
61 \subsection {Descriptions of dataflow passes}
63 \paragraph{Passes for backward dataflow problems}
65 The computation of a fact is the basis of a dataflow pass.
66 A~computation takes not one but two type parameters:
69 Type parameter [['i]] is an input, from which it should be possible to
70 derived a dataflow fact of interest.
71 For example, [['i]] might be equal to a fact, or it might be a tuple
72 of which one element is a fact.
74 Type parameter [['o]] is an output, or possibly a function from
77 Backward analyses compute [[in]] facts (facts on inedges).
78 <<exported types for backward analyses>>=
82 data BComputation middle last input output = BComp
84 , bc_exit_in :: output
85 , bc_last_in :: (BlockId -> input) -> last -> output
86 , bc_middle_in :: input -> middle -> output
87 , bc_first_in :: input -> BlockId -> output
90 -- | From these elements we build several kinds of passes:
91 -- * A pure analysis computes a fact, using that fact as input and output.
92 -- * A pure transformation computes no facts but only changes the graph.
93 -- * A fully general pass both computes a fact and rewrites the graph,
94 -- respecting the current transaction limit.
96 type BAnalysis m l a = BComputation m l a a
97 type BTransformation m l a = BComputation m l a (Maybe (UniqSM (Graph m l)))
98 type BFunctionalTransformation m l a = BComputation m l a (Maybe (Graph m l))
100 type BPass m l a = BComputation m l a (OptimizationFuel -> DFM a (Answer m l a))
101 type BUnlimitedPass m l a = BComputation m l a ( DFM a (Answer m l a))
104 \paragraph{Passes for forward dataflow problems}
106 A forward dataflow pass has a similar structure, but the details are
107 different. In particular, the output fact from a [[last]] node has a
108 higher-order representation: it takes a function that mutates a
109 [[uid]] to account for the new fact, then performs the necessary
110 mutation on every successor of the last node. We therefore have two
111 kinds of type parameter for outputs: output from a [[middle]] node
112 is~[[outmid]], and output from a [[last]] node is~[[outlast]].
115 data FComputation middle last input outmid outlast = FComp
117 , fc_first_out :: input -> BlockId -> outmid
118 , fc_middle_out :: input -> middle -> outmid
119 , fc_last_outs :: input -> last -> outlast
120 , fc_exit_outs :: input -> outlast
123 -- | The notions of analysis, pass, and transformation are analogous to the
126 newtype LastOutFacts a = LastOutFacts [(BlockId, a)]
127 -- ^ These are facts flowing out of a last node to the node's successors.
128 -- They are either to be set (if they pertain to the graph currently
129 -- under analysis) or propagated out of a sub-analysis
131 type FAnalysis m l a = FComputation m l a a (LastOutFacts a)
132 type FTransformation m l a = FComputation m l a (Maybe (UniqSM (Graph m l)))
133 (Maybe (UniqSM (Graph m l)))
134 type FPass m l a = FComputation m l a
135 (OptimizationFuel -> DFM a (Answer m l a))
136 (OptimizationFuel -> DFM a (Answer m l (LastOutFacts a)))
138 type FUnlimitedPass m l a = FComputation m l a
139 (DFM a (Answer m l a))
140 (DFM a (Answer m l (LastOutFacts a)))
143 \paragraph{Composing passes}
145 Both forward and backward engines share a handful of functions for
146 composing analyses, transformations, and passes.
148 We can make an analysis pass, or we can
149 combine a related analysis and transformation into a full pass.
152 anal_b :: BAnalysis m l a -> BPass m l a
153 a_t_b :: BAnalysis m l a -> BTransformation m l a -> BPass m l a
154 a_ft_b :: BAnalysis m l a -> BFunctionalTransformation m l a -> BPass m l a
156 :: BAnalysis m l a -> BFunctionalTransformation m l a -> BPass m l a
157 -- ^ Ignores transaction limits. Could produce a BUnlimitedPass statically,
158 -- but that would cost too much code in the implementation for a
159 -- static distinction that is not worth so much.
160 ignore_transactions_b :: BUnlimitedPass m l a -> BPass m l a
164 anal_f :: FAnalysis m l a -> FPass m l a
165 a_t_f :: FAnalysis m l a -> FTransformation m l a -> FPass m l a
169 \paragraph {Running the dataflow engine}
171 Every function for running analyses has two forms, because for a
172 forward analysis, we supply an entry fact, whereas for a backward
173 analysis, we don't need to supply an exit fact (because a graph for a
174 procedure doesn't have an exit node).
175 It's possible we could make these things more regular.
178 -- | The analysis functions set properties on unique IDs.
180 run_b_anal :: (DebugNodes m l, LastNode l, Outputable a) =>
181 BAnalysis m l a -> LGraph m l -> DFA a ()
182 run_f_anal :: (DebugNodes m l, LastNode l, Outputable a) =>
183 FAnalysis m l a -> a -> LGraph m l -> DFA a ()
184 -- ^ extra parameter is the entry fact
186 -- | Rematerialize results of analysis for use elsewhere. Simply applies a
187 -- fold function to every edge fact, in reverse postorder dfs. The facts
188 -- should already have been computed into the monady by run_b_anal or b_rewrite.
191 (a -> b -> b) -> BAnalysis m l a -> LGraph m l -> (BlockId -> a) -> b -> b
193 fold_edge_facts_with_nodes_b :: LastNode l
194 => (l -> a -> b -> b) -- ^ inedge to last node
195 -> (m -> a -> b -> b) -- ^ inedge to middle node
196 -> (BlockId -> a -> b -> b) -- ^ fact at label
197 -> BAnalysis m l a -- ^ backwards analysis
198 -> LGraph m l -- ^ graph
199 -> (BlockId -> a) -- ^ solution to bwd anal
203 -- | It can be useful to refine the results of an existing analysis,
204 -- or for example to use the outcome of a forward analsysis in a
205 -- backward analysis. These functions can also be used to compute a
206 -- fixed point iteratively starting from somewhere other than bottom
207 -- (as in the reachability analysis done for proc points).
209 class (Outputable m, Outputable l, LastNode l, Outputable (LGraph m l)) => DebugNodes m l
211 refine_f_anal :: (DebugNodes m l, LastNode l, Outputable a) =>
212 FAnalysis m l a -> LGraph m l -> DFA a () -> DFA a ()
214 refine_b_anal :: (DebugNodes m l, LastNode l, Outputable a) =>
215 BAnalysis m l a -> LGraph m l -> DFA a () -> DFA a ()
217 b_rewrite :: (DebugNodes m l, Outputable a) =>
218 BPass m l a -> LGraph m l -> DFM a (LGraph m l)
219 f_rewrite :: (DebugNodes m l, LastNode l, Outputable m, Outputable a) =>
220 FPass m l a -> a -> LGraph m l -> DFM a (LGraph m l)
221 -- ^ extra parameter is the entry fact
223 -- | If the solution to a problem is already sitting in a monad, we
224 -- should be able to take a short cut and just rewrite it in one pass.
225 -- But not yet implemented.
228 f_rewrite_solved :: (LastNode l, Outputable m, Outputable a) =>
229 FPass m l a -> DFM a () -> LGraph m l -> DFM a (LGraph m l)
230 b_rewrite_solved :: (LastNode l, Outputable m, Outputable a) =>
231 BPass m l a -> DFM a () -> LGraph m l -> DFM a (LGraph m l)
234 -- ===================== IMPLEMENTATION ======================--
236 -- | Here's a function to run an action on blocks until we reach a fixed point.
237 run :: (DataflowAnalysis anal, Monad (anal a), Outputable a, DebugNodes m l) =>
238 String -> String -> anal a () -> (b -> Block m l -> anal a b) ->
239 b -> [Block m l] -> anal a b
240 run dir name set_entry do_block b blocks =
241 do { set_entry; show_blocks $ iterate (1::Int) }
243 -- N.B. Each iteration starts with the same transaction limit;
244 -- only the rewrites in the final iteration actually count
245 trace_block b block = my_trace "about to do" (text name <+> text "on" <+> ppr (blockId block)) $
248 do { markFactsUnchanged
249 ; b <- foldM trace_block b blocks
250 ; changed <- factsStatus
252 ; let depth = 0 -- was nesting depth
255 NoChange -> unchanged depth $ return b
257 pprFacts depth n facts $
258 if n < 1000 then iterate (n+1)
261 msg n = concat [name, " didn't converge in ", show n, " " , dir,
263 my_nest depth sdoc = my_trace "" $ nest (3*depth) sdoc
264 ppIter depth n = my_nest depth (empty $$ text "*************** iteration" <+> pp_i n)
265 pp_i n = int n <+> text "of" <+> text name <+> text "on" <+> graphId
266 unchanged depth = my_nest depth (text "facts are unchanged")
268 pprFacts depth n env =
269 my_nest depth (text "facts for iteration" <+> pp_i n <+> text "are:" $$
270 (nest 2 $ vcat $ map pprFact $ ufmToList env))
271 pprFact (id, a) = hang (ppr id <> colon) 4 (ppr a)
272 graphId = case blocks of { Block id _ : _ -> ppr id ; [] -> text "<empty>" }
273 show_blocks = my_trace "Blocks:" (vcat (map pprBlock blocks))
274 pprBlock (Block id t) = nest 2 (pprFact (id, t))
277 \subsection{Backward problems}
279 In a backward problem, we compute \emph{in} facts from \emph{out}
280 facts. The analysis gives us [[exit_in]], [[last_in]], [[middle_in]],
281 and [[first_in]], each of which computes an \emph{in} fact for one
282 kind of node. We provide [[head_in]], which computes the \emph{in}
283 fact for a first node followed by zero or more middle nodes.
285 We don't compute and return the \emph{in} fact for block; instead, we
286 use [[setFact]] to attach that fact to the block's unique~ID.
287 We iterate until no more facts have changed.
289 run_b_anal comp graph =
290 refine_b_anal comp graph (return ())
291 -- for a backward analysis, everything is initially bottom
293 refine_b_anal comp graph initial =
294 run "backward" (bc_name comp) initial set_block_fact () blocks
296 blocks = reverse (postorder_dfs graph)
297 set_block_fact () b@(G.Block id _) =
298 let (h, l) = G.goto_end (G.unzip b) in
300 let block_in = head_in h (last_in comp env l) -- 'in' fact for the block
302 head_in (G.ZHead h m) out = head_in h (bc_middle_in comp out m)
303 head_in (G.ZFirst id) out = bc_first_in comp out id
305 last_in :: BComputation m l i o -> (BlockId -> i) -> G.ZLast l -> o
306 last_in comp env (G.LastOther l) = bc_last_in comp env l
307 last_in comp _ (G.LastExit) = bc_exit_in comp
309 ------ we can now pass those facts elsewhere
310 fold_edge_facts_b f comp graph env z =
311 foldl fold_block_facts z (postorder_dfs graph)
313 fold_block_facts z b =
314 let (h, l) = G.goto_end (G.unzip b)
315 in head_fold h (last_in comp env l) z
316 head_fold (G.ZHead h m) out z = head_fold h (bc_middle_in comp out m) (f out z)
317 head_fold (G.ZFirst id) out z = f (bc_first_in comp out id) (f out z)
319 fold_edge_facts_with_nodes_b fl fm ff comp graph env z =
320 foldl fold_block_facts z (postorder_dfs graph)
322 fold_block_facts z b =
323 let (h, l) = G.goto_end (G.unzip b)
324 in' = last_in comp env l
325 z' = case l of { G.LastExit -> z ; G.LastOther l -> fl l in' z }
326 in head_fold h in' z'
327 head_fold (G.ZHead h m) out z =
328 let a = bc_middle_in comp out m
331 head_fold (G.ZFirst id) out z =
332 let a = bc_first_in comp out id
337 -- | In the general case we solve a graph in the context of a larger subgraph.
338 -- To do this, we need a locally modified computation that allows an
339 -- ``exit fact'' to flow into the exit node.
341 comp_with_exit_b :: BComputation m l i (OptimizationFuel -> DFM f (Answer m l o)) -> o ->
342 BComputation m l i (OptimizationFuel -> DFM f (Answer m l o))
343 comp_with_exit_b comp exit_fact =
344 comp { bc_exit_in = \_fuel -> return $ Dataflow $ exit_fact }
346 -- | Given this function, we can now solve a graph simply by doing a
347 -- backward analysis on the modified computation. Note we have to be
348 -- very careful with 'Rewrite'. Either a rewrite is going to
349 -- participate, in which case we mark the graph rerewritten, or we're
350 -- going to analysis the proposed rewrite and then throw away
351 -- everything but the answer, in which case it's a 'subAnalysis'. A
352 -- Rewrite should always use exactly one of these monadic operations.
355 (DebugNodes m l, Outputable a) =>
356 BPass m l a -> OptimizationFuel -> G.LGraph m l -> a -> DFM a (OptimizationFuel, a)
357 solve_graph_b comp fuel graph exit_fact =
358 general_backward (comp_with_exit_b comp exit_fact) fuel graph
360 -- general_backward :: BPass m l a -> OptimizationFuel -> G.LGraph m l -> DFM a (OptimizationFuel, a)
361 general_backward comp fuel graph =
362 let -- set_block_fact :: OptimizationFuel -> G.Block m l -> DFM a OptimizationFuel
363 set_block_fact fuel b =
364 do { (fuel, block_in) <-
365 let (h, l) = G.goto_end (G.unzip b) in
366 factsEnv >>= \env -> last_in comp env l fuel >>= \x ->
368 Dataflow a -> head_in fuel h a
371 ; g <- lgraphOfGraph g
372 ; (fuel, a) <- subAnalysis' $
373 solve_graph_b comp (fuel-1) g bot
375 ; my_trace "result of" (text (bc_name comp) <+>
376 text "on" <+> ppr (G.blockId b) <+> text "is" <+> ppr block_in) $
377 setFact (G.blockId b) block_in
380 head_in fuel (G.ZHead h m) out =
381 bc_middle_in comp out m fuel >>= \x -> case x of
382 Dataflow a -> head_in fuel h a
384 do { g <- lgraphOfGraph g
385 ; (fuel, a) <- subAnalysis' $ solve_graph_b comp (fuel-1) g out
386 ; my_trace "Rewrote middle node" (f4sep [ppr m, text "to", ppr g]) $
388 head_in fuel (G.ZFirst id) out =
389 bc_first_in comp out id fuel >>= \x -> case x of
390 Dataflow a -> return (fuel, a)
391 Rewrite g -> do { g <- lgraphOfGraph g
392 ; subAnalysis' $ solve_graph_b comp (fuel-1) g out }
395 run "backward" (bc_name comp) (return ()) set_block_fact fuel blocks
396 ; a <- getFact (G.lg_entry graph)
398 ; my_trace "Solution to graph after pass 1 is" (pprFacts graph facts a) $
401 blocks = reverse (G.postorder_dfs graph)
402 pprFacts g env a = (ppr a <+> text "with") $$ vcat (pprLgraph g : map pprFact (ufmToList env))
403 pprFact (id, a) = hang (ppr id <> colon) 4 (ppr a)
406 lgraphOfGraph :: G.Graph m l -> DFM f (G.LGraph m l)
408 do id <- freshBlockId "temporary id for dataflow analysis"
409 return $ labelGraph id g
411 labelGraph :: BlockId -> G.Graph m l -> G.LGraph m l
412 labelGraph id (Graph tail blocks) = LGraph id (insertBlock (Block id tail) blocks)
415 We solve and rewrite in two passes: the first pass iterates to a fixed
416 point to reach a dataflow solution, and the second pass uses that
417 solution to rewrite the graph.
420 key job is done by [[propagate]], which propagates a fact of type~[[a]]
421 between a head and tail.
422 The tail is in final form; the head is still to be rewritten.
425 solve_and_rewrite_b ::
426 (DebugNodes m l, Outputable a) =>
427 BPass m l a -> OptimizationFuel -> LGraph m l -> a -> DFM a (OptimizationFuel, a, LGraph m l)
429 solve_and_rewrite_b comp fuel graph exit_fact =
430 do { (_, a) <- solve_graph_b comp fuel graph exit_fact -- pass 1
432 ; (fuel, g) <- -- pass 2
433 my_trace "Solution to graph after pass 1 is" (pprFacts graph facts) $
434 backward_rewrite (comp_with_exit_b comp exit_fact) fuel graph
436 ; my_trace "Rewritten graph after pass 2 is" (pprFacts g facts) $
437 return (fuel, a, g) }
439 pprFacts g env = vcat (pprLgraph g : map pprFact (ufmToList env))
440 pprFact (id, a) = hang (ppr id <> colon) 4 (ppr a)
441 eid = G.lg_entry graph
442 backward_rewrite comp fuel graph =
443 rewrite_blocks comp fuel emptyBlockEnv $ reverse (G.postorder_dfs graph)
445 -- BPass m l a -> OptimizationFuel ->
446 -- BlockEnv (Block m l) -> [Block m l] -> DFM a (OptimizationFuel,G.LGraph m l)
447 rewrite_blocks _comp fuel rewritten [] = return (fuel, G.LGraph eid rewritten)
448 rewrite_blocks comp fuel rewritten (b:bs) =
449 let rewrite_next_block fuel =
450 let (h, l) = G.goto_end (G.unzip b) in
451 factsEnv >>= \env -> last_in comp env l fuel >>= \x -> case x of
452 Dataflow a -> propagate fuel h a (G.ZLast l) rewritten
453 Rewrite g -> -- see Note [Rewriting labelled LGraphs]
455 ; g <- lgraphOfGraph g
456 ; (fuel, a, g') <- solve_and_rewrite_b comp (fuel-1) g bot
457 ; let G.Graph t new_blocks = G.remove_entry_label g'
459 ; let rewritten' = plusUFM new_blocks rewritten
460 ; -- continue at entry of g
461 propagate fuel h a t rewritten'
463 -- propagate :: OptimizationFuel
464 -- -> G.ZHead m -- Part of current block yet to be rewritten
465 -- -> a -- Fact on edge between head and tail
466 -- -> G.ZTail m l -- Part of current block already rewritten
467 -- -> BlockEnv (Block m l) -- These blocks have been rewritten
468 -- -> DFM a (OptimizationFuel, G.LGraph m l)
469 propagate fuel (G.ZHead h m) out tail rewritten =
470 bc_middle_in comp out m fuel >>= \x -> case x of
471 Dataflow a -> propagate fuel h a (G.ZTail m tail) rewritten
473 do { g <- lgraphOfGraph g
474 ; (fuel, a, g') <- solve_and_rewrite_b comp (fuel-1) g out
476 ; let (t, g'') = G.splice_tail g' tail
477 ; let rewritten' = plusUFM (G.lg_blocks g'') rewritten
478 ; my_trace "Rewrote middle node" (f4sep [ppr m, text "to", ppr g]) $
479 propagate fuel h a t rewritten' }
480 propagate fuel h@(G.ZFirst id) out tail rewritten =
481 bc_first_in comp out id fuel >>= \x -> case x of
483 let b = G.Block id tail in
484 do { checkFactMatch id a
485 ; rewrite_blocks comp fuel (extendBlockEnv rewritten id b) bs }
487 do { g <- lgraphOfGraph fg
488 ; (fuel, a, g') <- solve_and_rewrite_b comp (fuel-1) g out
490 ; let (t, g'') = G.splice_tail g' tail
491 ; let rewritten' = plusUFM (G.lg_blocks g'') rewritten
492 ; my_trace "Rewrote label " (f4sep [ppr id, text "to", ppr g]) $
493 propagate fuel h a t rewritten' }
494 in rewrite_next_block fuel
497 do { fuel <- liftTx txRemaining
499 ; (fuel', _, gc) <- solve_and_rewrite_b comp fuel g bot
500 ; liftTx $ txDecrement (bc_name comp) fuel fuel'
505 This debugging stuff is left over from imperative-land.
506 It might be useful one day if I learn how to cheat the IO monad!
508 debug_b :: (Outputable m, Outputable l, Outputable a) => BPass m l a -> BPass m l a
510 let debug s (f, comp) =
511 let pr = Printf.eprintf in
512 let fact dir node a = pr "%s %s for %s = %s\n" f.fact_name dir node (s a) in
513 let rewr node g = pr "%s rewrites %s to <not-shown>\n" comp.name node in
514 let wrap f nodestring node fuel =
515 let answer = f node fuel in
516 let () = match answer with
517 | Dataflow a -> fact "in " (nodestring node) a
518 | Rewrite g -> rewr (nodestring node) g in
520 let wrapout f nodestring out node fuel =
521 fact "out" (nodestring node) out;
522 wrap (f out) nodestring node fuel in
523 let last_in = wrap comp.last_in (RS.rtl << G.last_instr) in
524 let middle_in = wrapout comp.middle_in (RS.rtl << G.mid_instr) in
526 let first = function G.Entry -> "<entry>" | G.Label ((u, l), _, _) -> l in
527 wrapout comp.first_in first in
528 f, { comp with last_in = last_in; middle_in = middle_in; first_in = first_in; }
531 anal_b comp = comp { bc_last_in = wrap2 $ bc_last_in comp
532 , bc_exit_in = wrap0 $ bc_exit_in comp
533 , bc_middle_in = wrap2 $ bc_middle_in comp
534 , bc_first_in = wrap2 $ bc_first_in comp }
535 where wrap2 f out node _fuel = return $ Dataflow (f out node)
536 wrap0 fact _fuel = return $ Dataflow fact
538 ignore_transactions_b comp =
539 comp { bc_last_in = wrap2 $ bc_last_in comp
540 , bc_exit_in = wrap0 $ bc_exit_in comp
541 , bc_middle_in = wrap2 $ bc_middle_in comp
542 , bc_first_in = wrap2 $ bc_first_in comp }
543 where wrap2 f out node _fuel = f out node
544 wrap0 fact _fuel = fact
546 answer' :: (b -> DFM f (Graph m l)) -> OptimizationFuel -> Maybe b -> a -> DFM f (Answer m l a)
547 answer' lift fuel r a =
548 case r of Just gc | fuel > 0 -> do { g <- lift gc; return $ Rewrite g }
549 _ -> return $ Dataflow a
552 :: (b -> DFM f (Graph m l)) -> OptimizationFuel -> Maybe b -> a -> DFM f (Answer m l a)
553 unlimited_answer' lift _fuel r a =
554 case r of Just gc -> do { g <- lift gc; return $ Rewrite g }
555 _ -> return $ Dataflow a
557 combine_a_t_with :: (OptimizationFuel -> Maybe b -> a -> DFM a (Answer m l a)) ->
558 BAnalysis m l a -> BComputation m l a (Maybe b) ->
560 combine_a_t_with answer anal tx =
561 let last_in env l fuel =
562 answer fuel (bc_last_in tx env l) (bc_last_in anal env l)
563 exit_in fuel = answer fuel (bc_exit_in tx) (bc_exit_in anal)
564 middle_in out m fuel =
565 answer fuel (bc_middle_in tx out m) (bc_middle_in anal out m)
566 first_in out f fuel =
567 answer fuel (bc_first_in tx out f) (bc_first_in anal out f)
568 in BComp { bc_name = concat [bc_name anal, " and ", bc_name tx]
569 , bc_last_in = last_in, bc_middle_in = middle_in
570 , bc_first_in = first_in, bc_exit_in = exit_in }
572 a_t_b = combine_a_t_with (answer' liftUSM)
573 a_ft_b = combine_a_t_with (answer' return)
574 a_ft_b_unlimited = combine_a_t_with (unlimited_answer' return)
577 -- =============== FORWARD ================
579 -- | We don't compute and return the \emph{in} fact for block; instead, we
580 -- use [[P.set]] to attach that fact to the block's unique~ID.
581 -- We iterate until no more facts have changed.
586 my_trace :: String -> SDoc -> a -> a
587 my_trace = if dump_things then pprTrace else \_ _ a -> a
589 run_f_anal comp entry_fact graph = refine_f_anal comp graph set_entry
590 where set_entry = setFact (G.lg_entry graph) entry_fact
592 refine_f_anal comp graph initial =
593 run "forward" (fc_name comp) initial set_successor_facts () blocks
594 where blocks = G.postorder_dfs graph
595 set_successor_facts () (G.Block id t) =
596 let forward in' (G.ZTail m t) = forward (fc_middle_out comp in' m) t
597 forward in' (G.ZLast l) = setEdgeFacts (last_outs comp in' l)
598 _blockname = if id == G.lg_entry graph then "<entry>" else show id
599 in getFact id >>= \a -> forward (fc_first_out comp a id) t
600 setEdgeFacts (LastOutFacts fs) = mapM_ setEdgeFact fs
601 setEdgeFact (id, a) = setFact id a
603 last_outs :: FComputation m l i om ol -> i -> G.ZLast l -> ol
604 last_outs comp i (G.LastExit) = fc_exit_outs comp i
605 last_outs comp i (G.LastOther l) = fc_last_outs comp i l
607 -- | In the general case we solve a graph in the context of a larger subgraph.
608 -- To do this, we need a locally modified computation that allows an
609 -- ``exit fact'' to flow out of the exit node. We pass in a fresh BlockId
610 -- to which the exit fact can flow
612 comp_with_exit_f :: FPass m l a -> BlockId -> FPass m l a
613 comp_with_exit_f comp exit_fact_id = comp { fc_exit_outs = exit_outs }
614 where exit_outs in' _fuel = return $ Dataflow $ LastOutFacts [(exit_fact_id, in')]
616 -- | Given [[comp_with_exit_f]], we can now solve a graph simply by doing a
617 -- forward analysis on the modified computation.
619 (DebugNodes m l, Outputable a) =>
620 FPass m l a -> OptimizationFuel -> G.LGraph m l -> a ->
621 DFM a (OptimizationFuel, a, LastOutFacts a)
622 solve_graph_f comp fuel g in_fact =
623 do { exit_fact_id <- freshBlockId "proxy for exit node"
624 ; fuel <- general_forward (comp_with_exit_f comp exit_fact_id) fuel in_fact g
625 ; a <- getFact exit_fact_id
626 ; outs <- lastOutFacts
627 ; forgetFact exit_fact_id -- close space leak
628 ; return (fuel, a, LastOutFacts outs) }
630 -- general_forward :: FPass m l a -> OptimizationFuel -> a -> G.LGraph m l -> DFM a OptimizationFuel
631 general_forward comp fuel entry_fact graph =
632 let blocks = G.postorder_dfs g
633 is_local id = isJust $ lookupBlockEnv (G.lg_blocks g) id
634 -- set_or_save :: LastOutFacts a -> DFM a ()
635 set_or_save (LastOutFacts l) = mapM_ set_or_save_one l
636 set_or_save_one (id, a) =
637 if is_local id then setFact id a else addLastOutFact (id, a)
638 set_entry = setFact (G.lg_entry graph) entry_fact
640 set_successor_facts fuel b =
641 let set_tail_facts fuel in' (G.ZTail m t) =
642 my_trace "Solving middle node" (ppr m) $
643 fc_middle_out comp in' m fuel >>= \ x -> case x of
644 Dataflow a -> set_tail_facts fuel a t
646 do g <- lgraphOfGraph g
647 (fuel, out, last_outs) <- subAnalysis' $
648 solve_graph_f comp (fuel-1) g in'
649 set_or_save last_outs
650 set_tail_facts fuel out t
651 set_tail_facts fuel in' (G.ZLast l) =
652 last_outs comp in' l fuel >>= \x -> case x of
653 Dataflow outs -> do { set_or_save outs; return fuel }
655 do g <- lgraphOfGraph g
656 (fuel, _, last_outs) <- subAnalysis' $
657 solve_graph_f comp (fuel-1) g in'
658 set_or_save last_outs
661 in do idfact <- getFact id
662 infact <- fc_first_out comp idfact id fuel
663 case infact of Dataflow a -> set_tail_facts fuel a t
665 do g <- lgraphOfGraph g
666 (fuel, out, last_outs) <- subAnalysis' $
667 solve_graph_f comp (fuel-1) g idfact
668 set_or_save last_outs
669 set_tail_facts fuel out t
670 in run "forward" (fc_name comp) set_entry set_successor_facts fuel blocks
675 We solve and rewrite in two passes: the first pass iterates to a fixed
676 point to reach a dataflow solution, and the second pass uses that
677 solution to rewrite the graph.
679 The key job is done by [[propagate]], which propagates a fact of type~[[a]]
680 between a head and tail.
681 The tail is in final form; the head is still to be rewritten.
683 solve_and_rewrite_f ::
684 (DebugNodes m l, Outputable a) =>
685 FPass m l a -> OptimizationFuel -> LGraph m l -> a ->
686 DFM a (OptimizationFuel, a, LGraph m l)
687 solve_and_rewrite_f comp fuel graph in_fact =
688 do solve_graph_f comp fuel graph in_fact -- pass 1
689 exit_id <- freshBlockId "proxy for exit node"
690 (fuel, g) <- forward_rewrite (comp_with_exit_f comp exit_id) fuel graph in_fact
691 exit_fact <- getFact exit_id
692 return (fuel, exit_fact, g)
695 (DebugNodes m l, Outputable a) =>
696 FPass m l a -> OptimizationFuel -> G.LGraph m l -> a ->
697 DFM a (OptimizationFuel, G.LGraph m l)
698 forward_rewrite comp fuel graph entry_fact =
699 do setFact eid entry_fact
700 rewrite_blocks fuel emptyBlockEnv (G.postorder_dfs graph)
702 eid = G.lg_entry graph
703 is_local id = isJust $ lookupBlockEnv (G.lg_blocks graph) id
704 -- set_or_save :: LastOutFacts a -> DFM a ()
705 set_or_save (LastOutFacts l) = mapM_ set_or_save_one l
706 set_or_save_one (id, a) =
707 if is_local id then checkFactMatch id a
708 else panic "set fact outside graph during rewriting pass?!"
711 -- OptimizationFuel -> BlockEnv (Block m l) -> [Block m l] -> DFM a (OptimizationFuel, LGraph m l)
712 rewrite_blocks fuel rewritten [] = return (fuel, G.LGraph eid rewritten)
713 rewrite_blocks fuel rewritten (G.Block id t : bs) =
714 do id_fact <- getFact id
715 first_out <- fc_first_out comp id_fact id fuel
717 Dataflow a -> propagate fuel (G.ZFirst id) a t rewritten bs
718 Rewrite fg -> do { markGraphRewritten
719 ; rewrite_blocks (fuel-1) rewritten
720 (G.postorder_dfs (labelGraph id fg) ++ bs) }
721 -- propagate :: OptimizationFuel -> G.ZHead m -> a -> G.ZTail m l -> BlockEnv (G.Block m l) ->
722 -- [G.Block m l] -> DFM a (OptimizationFuel, G.LGraph m l)
723 propagate fuel h in' (G.ZTail m t) rewritten bs =
724 my_trace "Rewriting middle node" (ppr m) $
725 do fc_middle_out comp in' m fuel >>= \x -> case x of
726 Dataflow a -> propagate fuel (G.ZHead h m) a t rewritten bs
728 my_trace "Rewriting middle node...\n" empty $
729 do g <- lgraphOfGraph g
730 (fuel, a, g) <- solve_and_rewrite_f comp (fuel-1) g in'
732 my_trace "Rewrite of middle node completed\n" empty $
733 let (g', h') = G.splice_head h g in
734 propagate fuel h' a t (plusUFM (G.lg_blocks g') rewritten) bs
735 propagate fuel h in' (G.ZLast l) rewritten bs =
736 do last_outs comp in' l fuel >>= \x -> case x of
739 let b = G.zip (G.ZBlock h (G.ZLast l))
740 rewrite_blocks fuel (G.insertBlock b rewritten) bs
742 -- could test here that [[exits g = exits (G.Entry, G.ZLast l)]]
743 {- if Debug.on "rewrite-last" then
744 Printf.eprintf "ZLast node %s rewritten to:\n"
745 (RS.rtl (G.last_instr l)); -}
746 do g <- lgraphOfGraph g
747 (fuel, _, g) <- solve_and_rewrite_f comp (fuel-1) g in'
749 let g' = G.splice_head_only h g
750 rewrite_blocks fuel (plusUFM (G.lg_blocks g') rewritten) bs
752 f_rewrite comp entry_fact g =
753 do { fuel <- liftTx txRemaining
754 ; (fuel', _, gc) <- solve_and_rewrite_f comp fuel g entry_fact
755 ; liftTx $ txDecrement (fc_name comp) fuel fuel'
761 debug_f :: (Outputable m, Outputable l, Outputable a) => FPass m l a -> FPass m l a
763 let debug s (f, comp) =
764 let pr = Printf.eprintf in
765 let fact dir node a = pr "%s %s for %s = %s\n" f.fact_name dir node (s a) in
766 let setter dir node run_sets set =
767 run_sets (fun u a -> pr "%s %s for %s = %s\n" f.fact_name dir node (s a); set u a) in
768 let rewr node g = pr "%s rewrites %s to <not-shown>\n" comp.name node in
769 let wrap f nodestring wrap_answer in' node fuel =
770 fact "in " (nodestring node) in';
771 wrap_answer (nodestring node) (f in' node fuel)
772 and wrap_fact n answer =
773 let () = match answer with
774 | Dataflow a -> fact "out" n a
775 | Rewrite g -> rewr n g in
777 and wrap_setter n answer =
779 | Dataflow set -> Dataflow (setter "out" n set)
780 | Rewrite g -> (rewr n g; Rewrite g) in
781 let middle_out = wrap comp.middle_out (RS.rtl << G.mid_instr) wrap_fact in
782 let last_outs = wrap comp.last_outs (RS.rtl << G.last_instr) wrap_setter in
783 f, { comp with last_outs = last_outs; middle_out = middle_out; }
786 anal_f comp = comp { fc_first_out = wrap2 $ fc_first_out comp
787 , fc_middle_out = wrap2 $ fc_middle_out comp
788 , fc_last_outs = wrap2 $ fc_last_outs comp
789 , fc_exit_outs = wrap1 $ fc_exit_outs comp
791 where wrap2 f out node _fuel = return $ Dataflow (f out node)
792 wrap1 f fact _fuel = return $ Dataflow (f fact)
796 let answer = answer' liftUSM
797 first_out in' id fuel =
798 answer fuel (fc_first_out tx in' id) (fc_first_out anal in' id)
799 middle_out in' m fuel =
800 answer fuel (fc_middle_out tx in' m) (fc_middle_out anal in' m)
801 last_outs in' l fuel =
802 answer fuel (fc_last_outs tx in' l) (fc_last_outs anal in' l)
803 exit_outs in' fuel = undefined
804 answer fuel (fc_exit_outs tx in') (fc_exit_outs anal in')
805 in FComp { fc_name = concat [fc_name anal, " and ", fc_name tx]
806 , fc_last_outs = last_outs, fc_middle_out = middle_out
807 , fc_first_out = first_out, fc_exit_outs = exit_outs }
810 {- Note [Rewriting labelled LGraphs]
811 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
812 It's hugely annoying that we get in an LGraph and in order to solve it
813 we have to slap on a new label which we then immediately strip off.
814 But the alternative is to have all the iterative solvers work on
815 Graphs, and then suddenly instead of a single case (ZBlock) every
816 solver has to deal with two cases (ZBlock and ZTail). So until
817 somebody comes along who is smart enough to do this and still leave
818 the code understandable for mortals, it stays as it is.
820 (A good place to start changing things would be to figure out what is
821 the analogue of postorder_dfs for Graphs, and to figure out what
822 higher-order functions would do for dealing with the resulting
823 sequences of *things*.)
826 f4sep :: [SDoc] -> SDoc
828 f4sep (d:ds) = fsep (d : map (nest 4) ds)
830 subAnalysis' :: (Monad (m f), DataflowAnalysis m, Outputable f) =>
833 do { a <- subAnalysis $
834 do { a <- m; facts <- allFacts
835 ; my_trace "after sub-analysis facts are" (pprFacts facts) $
838 ; my_trace "in parent analysis facts are" (pprFacts facts) $
840 where pprFacts env = nest 2 $ vcat $ map pprFact $ ufmToList env
841 pprFact (id, a) = hang (ppr id <> colon) 4 (ppr a)