1 {-# OPTIONS -Wall -fno-warn-name-shadowing #-}
2 {-# LANGUAGE ScopedTypeVariables, 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 :: forall m l a . (DebugNodes m l, LastNode l, Outputable a) =>
181 BAnalysis m l a -> LGraph m l -> DFA a ()
182 run_f_anal :: forall m l a . (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 :: forall m l a . (DebugNodes m l, LastNode l, Outputable a) =>
212 FAnalysis m l a -> LGraph m l -> DFA a () -> DFA a ()
214 refine_b_anal :: forall m l a . (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 forall m l a . (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.gr_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 forall m l a. (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.gr_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 -> G.ZHead m -> a -> G.ZTail m l ->
464 BlockEnv (Block m l) -> DFM a (OptimizationFuel, G.LGraph m l)
465 propagate fuel (G.ZHead h m) out tail rewritten =
466 bc_middle_in comp out m fuel >>= \x -> case x of
467 Dataflow a -> propagate fuel h a (G.ZTail m tail) rewritten
469 do { g <- lgraphOfGraph g
470 ; (fuel, a, g') <- solve_and_rewrite_b comp (fuel-1) g out
472 ; let (t, g'') = G.splice_tail g' tail
473 ; let rewritten' = plusUFM (G.gr_blocks g'') rewritten
474 ; my_trace "Rewrote middle node" (f4sep [ppr m, text "to", ppr g]) $
475 propagate fuel h a t rewritten' }
476 propagate fuel h@(G.ZFirst id) out tail rewritten =
477 bc_first_in comp out id fuel >>= \x -> case x of
479 let b = G.Block id tail in
480 do { checkFactMatch id a
481 ; rewrite_blocks comp fuel (extendBlockEnv rewritten id b) bs }
483 do { g <- lgraphOfGraph fg
484 ; (fuel, a, g') <- solve_and_rewrite_b comp (fuel-1) g out
486 ; let (t, g'') = G.splice_tail g' tail
487 ; let rewritten' = plusUFM (G.gr_blocks g'') rewritten
488 ; my_trace "Rewrote label " (f4sep [ppr id, text "to", ppr g]) $
489 propagate fuel h a t rewritten' }
490 in rewrite_next_block fuel
493 do { fuel <- liftTx txRemaining
495 ; (fuel', _, gc) <- solve_and_rewrite_b comp fuel g bot
496 ; liftTx $ txDecrement (bc_name comp) fuel fuel'
501 This debugging stuff is left over from imperative-land.
502 It might be useful one day if I learn how to cheat the IO monad!
504 debug_b :: (Outputable m, Outputable l, Outputable a) => BPass m l a -> BPass m l a
506 let debug s (f, comp) =
507 let pr = Printf.eprintf in
508 let fact dir node a = pr "%s %s for %s = %s\n" f.fact_name dir node (s a) in
509 let rewr node g = pr "%s rewrites %s to <not-shown>\n" comp.name node in
510 let wrap f nodestring node fuel =
511 let answer = f node fuel in
512 let () = match answer with
513 | Dataflow a -> fact "in " (nodestring node) a
514 | Rewrite g -> rewr (nodestring node) g in
516 let wrapout f nodestring out node fuel =
517 fact "out" (nodestring node) out;
518 wrap (f out) nodestring node fuel in
519 let last_in = wrap comp.last_in (RS.rtl << G.last_instr) in
520 let middle_in = wrapout comp.middle_in (RS.rtl << G.mid_instr) in
522 let first = function G.Entry -> "<entry>" | G.Label ((u, l), _, _) -> l in
523 wrapout comp.first_in first in
524 f, { comp with last_in = last_in; middle_in = middle_in; first_in = first_in; }
527 anal_b comp = comp { bc_last_in = wrap2 $ bc_last_in comp
528 , bc_exit_in = wrap0 $ bc_exit_in comp
529 , bc_middle_in = wrap2 $ bc_middle_in comp
530 , bc_first_in = wrap2 $ bc_first_in comp }
531 where wrap2 f out node _fuel = return $ Dataflow (f out node)
532 wrap0 fact _fuel = return $ Dataflow fact
534 ignore_transactions_b comp =
535 comp { bc_last_in = wrap2 $ bc_last_in comp
536 , bc_exit_in = wrap0 $ bc_exit_in comp
537 , bc_middle_in = wrap2 $ bc_middle_in comp
538 , bc_first_in = wrap2 $ bc_first_in comp }
539 where wrap2 f out node _fuel = f out node
540 wrap0 fact _fuel = fact
542 answer' :: (b -> DFM f (Graph m l)) -> OptimizationFuel -> Maybe b -> a -> DFM f (Answer m l a)
543 answer' lift fuel r a =
544 case r of Just gc | fuel > 0 -> do { g <- lift gc; return $ Rewrite g }
545 _ -> return $ Dataflow a
548 :: (b -> DFM f (Graph m l)) -> OptimizationFuel -> Maybe b -> a -> DFM f (Answer m l a)
549 unlimited_answer' lift _fuel r a =
550 case r of Just gc -> do { g <- lift gc; return $ Rewrite g }
551 _ -> return $ Dataflow a
553 combine_a_t_with :: (OptimizationFuel -> Maybe b -> a -> DFM a (Answer m l a)) ->
554 BAnalysis m l a -> BComputation m l a (Maybe b) ->
556 combine_a_t_with answer anal tx =
557 let last_in env l fuel =
558 answer fuel (bc_last_in tx env l) (bc_last_in anal env l)
559 exit_in fuel = answer fuel (bc_exit_in tx) (bc_exit_in anal)
560 middle_in out m fuel =
561 answer fuel (bc_middle_in tx out m) (bc_middle_in anal out m)
562 first_in out f fuel =
563 answer fuel (bc_first_in tx out f) (bc_first_in anal out f)
564 in BComp { bc_name = concat [bc_name anal, " and ", bc_name tx]
565 , bc_last_in = last_in, bc_middle_in = middle_in
566 , bc_first_in = first_in, bc_exit_in = exit_in }
568 a_t_b = combine_a_t_with (answer' liftUSM)
569 a_ft_b = combine_a_t_with (answer' return)
570 a_ft_b_unlimited = combine_a_t_with (unlimited_answer' return)
573 -- =============== FORWARD ================
575 -- | We don't compute and return the \emph{in} fact for block; instead, we
576 -- use [[P.set]] to attach that fact to the block's unique~ID.
577 -- We iterate until no more facts have changed.
582 my_trace :: String -> SDoc -> a -> a
583 my_trace = if dump_things then pprTrace else \_ _ a -> a
585 run_f_anal comp entry_fact graph = refine_f_anal comp graph set_entry
586 where set_entry = setFact (G.gr_entry graph) entry_fact
588 refine_f_anal comp graph initial =
589 run "forward" (fc_name comp) initial set_successor_facts () blocks
590 where blocks = G.postorder_dfs graph
591 set_successor_facts () (G.Block id t) =
592 let forward in' (G.ZTail m t) = forward (fc_middle_out comp in' m) t
593 forward in' (G.ZLast l) = setEdgeFacts (last_outs comp in' l)
594 _blockname = if id == G.gr_entry graph then "<entry>" else show id
595 in getFact id >>= \a -> forward (fc_first_out comp a id) t
596 setEdgeFacts (LastOutFacts fs) = mapM_ setEdgeFact fs
597 setEdgeFact (id, a) = setFact id a
599 last_outs :: FComputation m l i om ol -> i -> G.ZLast l -> ol
600 last_outs comp i (G.LastExit) = fc_exit_outs comp i
601 last_outs comp i (G.LastOther l) = fc_last_outs comp i l
603 -- | In the general case we solve a graph in the context of a larger subgraph.
604 -- To do this, we need a locally modified computation that allows an
605 -- ``exit fact'' to flow out of the exit node. We pass in a fresh BlockId
606 -- to which the exit fact can flow
608 comp_with_exit_f :: FPass m l a -> BlockId -> FPass m l a
609 comp_with_exit_f comp exit_fact_id = comp { fc_exit_outs = exit_outs }
610 where exit_outs in' _fuel = return $ Dataflow $ LastOutFacts [(exit_fact_id, in')]
612 -- | Given [[comp_with_exit_f]], we can now solve a graph simply by doing a
613 -- forward analysis on the modified computation.
615 forall m l a . (DebugNodes m l, Outputable a) =>
616 FPass m l a -> OptimizationFuel -> G.LGraph m l -> a ->
617 DFM a (OptimizationFuel, a, LastOutFacts a)
618 solve_graph_f comp fuel g in_fact =
619 do { exit_fact_id <- freshBlockId "proxy for exit node"
620 ; fuel <- general_forward (comp_with_exit_f comp exit_fact_id) fuel in_fact g
621 ; a <- getFact exit_fact_id
622 ; outs <- lastOutFacts
623 ; forgetFact exit_fact_id -- close space leak
624 ; return (fuel, a, LastOutFacts outs) }
626 general_forward :: FPass m l a -> OptimizationFuel -> a -> G.LGraph m l -> DFM a OptimizationFuel
627 general_forward comp fuel entry_fact graph =
628 let blocks = G.postorder_dfs g
629 is_local id = isJust $ lookupBlockEnv (G.gr_blocks g) id
630 set_or_save :: LastOutFacts a -> DFM a ()
631 set_or_save (LastOutFacts l) = mapM_ set_or_save_one l
632 set_or_save_one (id, a) =
633 if is_local id then setFact id a else addLastOutFact (id, a)
634 set_entry = setFact (G.gr_entry graph) entry_fact
636 set_successor_facts fuel b =
637 let set_tail_facts fuel in' (G.ZTail m t) =
638 my_trace "Solving middle node" (ppr m) $
639 fc_middle_out comp in' m fuel >>= \ x -> case x of
640 Dataflow a -> set_tail_facts fuel a t
642 do g <- lgraphOfGraph g
643 (fuel, out, last_outs) <- subAnalysis' $
644 solve_graph_f comp (fuel-1) g in'
645 set_or_save last_outs
646 set_tail_facts fuel out t
647 set_tail_facts fuel in' (G.ZLast l) =
648 last_outs comp in' l fuel >>= \x -> case x of
649 Dataflow outs -> do { set_or_save outs; return fuel }
651 do g <- lgraphOfGraph g
652 (fuel, _, last_outs) <- subAnalysis' $
653 solve_graph_f comp (fuel-1) g in'
654 set_or_save last_outs
657 in do idfact <- getFact id
658 infact <- fc_first_out comp idfact id fuel
659 case infact of Dataflow a -> set_tail_facts fuel a t
661 do g <- lgraphOfGraph g
662 (fuel, out, last_outs) <- subAnalysis' $
663 solve_graph_f comp (fuel-1) g idfact
664 set_or_save last_outs
665 set_tail_facts fuel out t
666 in run "forward" (fc_name comp) set_entry set_successor_facts fuel blocks
671 We solve and rewrite in two passes: the first pass iterates to a fixed
672 point to reach a dataflow solution, and the second pass uses that
673 solution to rewrite the graph.
675 The key job is done by [[propagate]], which propagates a fact of type~[[a]]
676 between a head and tail.
677 The tail is in final form; the head is still to be rewritten.
679 solve_and_rewrite_f ::
680 forall m l a . (DebugNodes m l, Outputable a) =>
681 FPass m l a -> OptimizationFuel -> LGraph m l -> a -> DFM a (OptimizationFuel, a, LGraph m l)
682 solve_and_rewrite_f comp fuel graph in_fact =
683 do solve_graph_f comp fuel graph in_fact -- pass 1
684 exit_id <- freshBlockId "proxy for exit node"
685 (fuel, g) <- forward_rewrite (comp_with_exit_f comp exit_id) fuel graph in_fact
686 exit_fact <- getFact exit_id
687 return (fuel, exit_fact, g)
690 forall m l a . (DebugNodes m l, Outputable a) =>
691 FPass m l a -> OptimizationFuel -> G.LGraph m l -> a -> DFM a (OptimizationFuel, G.LGraph m l)
692 forward_rewrite comp fuel graph entry_fact =
693 do setFact eid entry_fact
694 rewrite_blocks fuel emptyBlockEnv (G.postorder_dfs graph)
696 eid = G.gr_entry graph
697 is_local id = isJust $ lookupBlockEnv (G.gr_blocks graph) id
698 set_or_save :: LastOutFacts a -> DFM a ()
699 set_or_save (LastOutFacts l) = mapM_ set_or_save_one l
700 set_or_save_one (id, a) =
701 if is_local id then checkFactMatch id a
702 else panic "set fact outside graph during rewriting pass?!"
705 OptimizationFuel -> BlockEnv (Block m l) -> [Block m l] -> DFM a (OptimizationFuel, LGraph m l)
706 rewrite_blocks fuel rewritten [] = return (fuel, G.LGraph eid rewritten)
707 rewrite_blocks fuel rewritten (G.Block id t : bs) =
708 do id_fact <- getFact id
709 first_out <- fc_first_out comp id_fact id fuel
711 Dataflow a -> propagate fuel (G.ZFirst id) a t rewritten bs
712 Rewrite fg -> do { markGraphRewritten
713 ; rewrite_blocks (fuel-1) rewritten
714 (G.postorder_dfs (labelGraph id fg) ++ bs) }
715 propagate :: OptimizationFuel -> G.ZHead m -> a -> G.ZTail m l -> BlockEnv (G.Block m l) ->
716 [G.Block m l] -> DFM a (OptimizationFuel, G.LGraph m l)
717 propagate fuel h in' (G.ZTail m t) rewritten bs =
718 my_trace "Rewriting middle node" (ppr m) $
719 do fc_middle_out comp in' m fuel >>= \x -> case x of
720 Dataflow a -> propagate fuel (G.ZHead h m) a t rewritten bs
722 my_trace "Rewriting middle node...\n" empty $
723 do g <- lgraphOfGraph g
724 (fuel, a, g) <- solve_and_rewrite_f comp (fuel-1) g in'
726 my_trace "Rewrite of middle node completed\n" empty $
727 let (g', h') = G.splice_head h g in
728 propagate fuel h' a t (plusUFM (G.gr_blocks g') rewritten) bs
729 propagate fuel h in' (G.ZLast l) rewritten bs =
730 do last_outs comp in' l fuel >>= \x -> case x of
733 let b = G.zip (G.ZBlock h (G.ZLast l))
734 rewrite_blocks fuel (G.insertBlock b rewritten) bs
736 -- could test here that [[exits g = exits (G.Entry, G.ZLast l)]]
737 {- if Debug.on "rewrite-last" then
738 Printf.eprintf "ZLast node %s rewritten to:\n"
739 (RS.rtl (G.last_instr l)); -}
740 do g <- lgraphOfGraph g
741 (fuel, _, g) <- solve_and_rewrite_f comp (fuel-1) g in'
743 let g' = G.splice_head_only h g
744 rewrite_blocks fuel (plusUFM (G.gr_blocks g') rewritten) bs
746 f_rewrite comp entry_fact g =
747 do { fuel <- liftTx txRemaining
748 ; (fuel', _, gc) <- solve_and_rewrite_f comp fuel g entry_fact
749 ; liftTx $ txDecrement (fc_name comp) fuel fuel'
755 debug_f :: (Outputable m, Outputable l, Outputable a) => FPass m l a -> FPass m l a
757 let debug s (f, comp) =
758 let pr = Printf.eprintf in
759 let fact dir node a = pr "%s %s for %s = %s\n" f.fact_name dir node (s a) in
760 let setter dir node run_sets set =
761 run_sets (fun u a -> pr "%s %s for %s = %s\n" f.fact_name dir node (s a); set u a) in
762 let rewr node g = pr "%s rewrites %s to <not-shown>\n" comp.name node in
763 let wrap f nodestring wrap_answer in' node fuel =
764 fact "in " (nodestring node) in';
765 wrap_answer (nodestring node) (f in' node fuel)
766 and wrap_fact n answer =
767 let () = match answer with
768 | Dataflow a -> fact "out" n a
769 | Rewrite g -> rewr n g in
771 and wrap_setter n answer =
773 | Dataflow set -> Dataflow (setter "out" n set)
774 | Rewrite g -> (rewr n g; Rewrite g) in
775 let middle_out = wrap comp.middle_out (RS.rtl << G.mid_instr) wrap_fact in
776 let last_outs = wrap comp.last_outs (RS.rtl << G.last_instr) wrap_setter in
777 f, { comp with last_outs = last_outs; middle_out = middle_out; }
780 anal_f comp = comp { fc_first_out = wrap2 $ fc_first_out comp
781 , fc_middle_out = wrap2 $ fc_middle_out comp
782 , fc_last_outs = wrap2 $ fc_last_outs comp
783 , fc_exit_outs = wrap1 $ fc_exit_outs comp
785 where wrap2 f out node _fuel = return $ Dataflow (f out node)
786 wrap1 f fact _fuel = return $ Dataflow (f fact)
790 let answer = answer' liftUSM
791 first_out in' id fuel =
792 answer fuel (fc_first_out tx in' id) (fc_first_out anal in' id)
793 middle_out in' m fuel =
794 answer fuel (fc_middle_out tx in' m) (fc_middle_out anal in' m)
795 last_outs in' l fuel =
796 answer fuel (fc_last_outs tx in' l) (fc_last_outs anal in' l)
797 exit_outs in' fuel = undefined
798 answer fuel (fc_exit_outs tx in') (fc_exit_outs anal in')
799 in FComp { fc_name = concat [fc_name anal, " and ", fc_name tx]
800 , fc_last_outs = last_outs, fc_middle_out = middle_out
801 , fc_first_out = first_out, fc_exit_outs = exit_outs }
804 {- Note [Rewriting labelled LGraphs]
805 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
806 It's hugely annoying that we get in an LGraph and in order to solve it
807 we have to slap on a new label which we then immediately strip off.
808 But the alternative is to have all the iterative solvers work on
809 Graphs, and then suddenly instead of a single case (ZBlock) every
810 solver has to deal with two cases (ZBlock and ZTail). So until
811 somebody comes along who is smart enough to do this and still leave
812 the code understandable for mortals, it stays as it is.
814 (A good place to start changing things would be to figure out what is
815 the analogue of postorder_dfs for Graphs, and to figure out what
816 higher-order functions would do for dealing with the resulting
817 sequences of *things*.)
820 f4sep :: [SDoc] -> SDoc
822 f4sep (d:ds) = fsep (d : map (nest 4) ds)
824 subAnalysis' :: (Monad (m f), DataflowAnalysis m, Outputable f) =>
827 do { a <- subAnalysis $
828 do { a <- m; facts <- allFacts
829 ; my_trace "after sub-analysis facts are" (pprFacts facts) $
832 ; my_trace "in parent analysis facts are" (pprFacts facts) $
834 where pprFacts env = nest 2 $ vcat $ map pprFact $ ufmToList env
835 pprFact (id, a) = hang (ppr id <> colon) 4 (ppr a)