1 {-# LANGUAGE MultiParamTypeClasses #-}
4 , BComputation(..), BAnalysis, BTransformation, BFunctionalTransformation
5 , BPass, BUnlimitedPass
6 , FComputation(..), FAnalysis, FTransformation, FFunctionalTransformation
7 , FPass, FUnlimitedPass
10 , anal_b, a_t_b, a_ft_b, a_ft_b_unlimited, ignore_transactions_b
12 , null_f_ft, null_b_ft
13 , run_b_anal, run_f_anal
14 , refine_f_anal, refine_b_anal, fold_edge_facts_b, fold_edge_facts_with_nodes_b
15 , b_rewrite, f_rewrite, b_shallow_rewrite, f_shallow_rewrite
16 , solve_graph_b, solve_graph_f
23 import qualified ZipCfg as G
33 #include "HsVersions.h"
37 \section{A very polymorphic infrastructure for dataflow problems}
39 This module presents a framework for solving iterative dataflow
41 There are two major submodules: one for forward problems and another
42 for backward problems.
43 Both modules incorporate the composition framework developed by
44 Lerner, Grove, and Chambers.
45 They also support a \emph{transaction limit}, which enables the
46 binary-search debugging technique developed by Whalley and Davidson
47 under the name \emph{vpoiso}.
48 Transactions may either be known to the individual dataflow solvers or
49 may be managed by the framework.
52 -- | In the composition framework, a pass either produces a dataflow
53 -- fact or proposes to rewrite the graph. To make life easy for the
54 -- clients, the rewrite is given in unlabelled form, but we use
55 -- labelled form internally throughout, because it greatly simplifies
56 -- the implementation not to have the first block be a special case
59 data Answer m l a = Dataflow a | Rewrite (Graph m l)
64 ============== Descriptions of dataflow passes} ================
66 ------ Passes for backward dataflow problemsa
68 The computation of a fact is the basis of a dataflow pass.
69 A computation takes *four* type parameters:
71 * 'middle' and 'last' are the types of the middle
72 and last nodes of the graph over which the dataflow
73 solution is being computed
75 * 'input' is an input, from which it should be possible to
76 derive a dataflow fact of interest. For example, 'input' might
77 be equal to a fact, or it might be a tuple of which one element
80 * 'output' is an output, or possibly a function from 'fuel' to an
83 A computation is interesting for any pair of 'middle' and 'last' type
84 parameters that can form a reasonable graph. But it is not useful to
85 instantiate 'input' and 'output' arbitrarily. Rather, only certain
86 combinations of instances are likely to be useful, such as those shown
89 Backward analyses compute *in* facts (facts on inedges).
92 -- A dataflow pass requires a name and a transfer function for each of
93 -- four kinds of nodes:
94 -- first (the BlockId),
99 -- A 'BComputation' describes a complete backward dataflow pass, as a
100 -- record of transfer functions. Because the analysis works
101 -- back-to-front, we write the exit node at the beginning.
104 -- an 'input' for each out-edge of the node
105 -- (hence (BlockId -> input) for bc_last_in)
106 -- an 'output' for the in-edge of the node
108 data BComputation middle last input output = BComp
110 , bc_exit_in :: output
111 , bc_last_in :: (BlockId -> input) -> last -> output
112 , bc_middle_in :: input -> middle -> output
113 , bc_first_in :: input -> BlockId -> output
116 -- | From these elements we build several kinds of passes:
117 -- * A pure analysis computes a fact, using that fact as input and output.
118 -- * A pure transformation computes no facts but only changes the graph.
119 -- * A fully general pass both computes a fact and rewrites the graph,
120 -- respecting the current transaction limit.
122 type BAnalysis m l a = BComputation m l a a
123 type BTransformation m l a = BComputation m l a (Maybe (UniqSM (Graph m l)))
124 type BFunctionalTransformation m l a = BComputation m l a (Maybe (Graph m l))
125 -- ToDo: consider replacing UniqSM (Graph l m) with (AGraph m l)
127 type BPass m l a = BComputation m l a (OptimizationFuel -> DFM a (Answer m l a))
128 type BUnlimitedPass m l a = BComputation m l a ( DFM a (Answer m l a))
130 -- (DFM a t) maintains the (BlockId -> a) map
131 -- ToDo: overlap with bc_last_in??
134 \paragraph{Passes for forward dataflow problems}
136 A forward dataflow pass has a similar structure, but the details are
137 different. In particular, the output fact from a [[last]] node has a
138 higher-order representation: it takes a function that mutates a
139 [[uid]] to account for the new fact, then performs the necessary
140 mutation on every successor of the last node. We therefore have two
141 kinds of type parameter for outputs: output from a [[middle]] node
142 is~[[outmid]], and output from a [[last]] node is~[[outlast]].
145 data FComputation middle last input outmid outlast = FComp
147 , fc_first_out :: input -> BlockId -> outmid
148 , fc_middle_out :: input -> middle -> outmid
149 , fc_last_outs :: input -> last -> outlast
150 , fc_exit_out :: input -> outmid
153 -- | The notions of analysis, pass, and transformation are analogous to the
156 newtype LastOutFacts a = LastOutFacts [(BlockId, a)]
157 -- ^ These are facts flowing out of a last node to the node's successors.
158 -- They are either to be set (if they pertain to the graph currently
159 -- under analysis) or propagated out of a sub-analysis
161 type FAnalysis m l a = FComputation m l a a (LastOutFacts a)
162 type FTransformation m l a = FComputation m l a (Maybe (UniqSM (Graph m l)))
163 (Maybe (UniqSM (Graph m l)))
164 type FFunctionalTransformation m l a =
165 FComputation m l a (Maybe (Graph m l))
167 -- ToDo: consider replacing UniqSM (Graph l m) with (AGraph m l)
169 type FPass m l a = FComputation m l a
170 (OptimizationFuel -> DFM a (Answer m l a))
171 (OptimizationFuel -> DFM a (Answer m l (LastOutFacts a)))
173 type FUnlimitedPass m l a = FComputation m l a
174 (DFM a (Answer m l a))
175 (DFM a (Answer m l (LastOutFacts a)))
178 \paragraph{Composing passes}
180 Both forward and backward engines share a handful of functions for
181 composing analyses, transformations, and passes.
183 We can make an analysis pass, or we can
184 combine a related analysis and transformation into a full pass.
187 null_b_ft :: BFunctionalTransformation m l a
188 null_f_ft :: FFunctionalTransformation m l a
190 anal_b :: BAnalysis m l a -> BPass m l a
191 a_t_b :: BAnalysis m l a -> BTransformation m l a -> BPass m l a
192 a_ft_b :: BAnalysis m l a -> BFunctionalTransformation m l a -> BPass m l a
194 :: BAnalysis m l a -> BFunctionalTransformation m l a -> BPass m l a
195 -- ^ Ignores transaction limits. Could produce a BUnlimitedPass statically,
196 -- but that would cost too much code in the implementation for a
197 -- static distinction that is not worth so much.
198 ignore_transactions_b :: BUnlimitedPass m l a -> BPass m l a
202 anal_f :: FAnalysis m l a -> FPass m l a
203 a_t_f :: FAnalysis m l a -> FTransformation m l a -> FPass m l a
207 \paragraph {Running the dataflow engine}
209 Every function for running analyses has two forms, because for a
210 forward analysis, we supply an entry fact, whereas for a backward
211 analysis, we don't need to supply an exit fact (because a graph for a
212 procedure doesn't have an exit node).
213 It's possible we could make these things more regular.
216 -- | The analysis functions set properties on unique IDs.
218 run_b_anal :: (DebugNodes m l, LastNode l, Outputable a) =>
219 BAnalysis m l a -> LGraph m l -> DFA a ()
220 run_f_anal :: (DebugNodes m l, LastNode l, Outputable a) =>
221 FAnalysis m l a -> a -> LGraph m l -> DFA a ()
222 -- ^ extra parameter is the entry fact
224 -- | Rematerialize results of analysis for use elsewhere. Simply applies a
225 -- fold function to every edge fact, in reverse postorder dfs. The facts
226 -- should already have been computed into the monady by run_b_anal or b_rewrite.
229 (a -> b -> b) -> BAnalysis m l a -> LGraph m l -> (BlockId -> a) -> b -> b
231 fold_edge_facts_with_nodes_b :: LastNode l
232 => (l -> a -> b -> b) -- ^ inedge to last node
233 -> (m -> a -> b -> b) -- ^ inedge to middle node
234 -> (BlockId -> a -> b -> b) -- ^ fact at label
235 -> BAnalysis m l a -- ^ backwards analysis
236 -> LGraph m l -- ^ graph
237 -> (BlockId -> a) -- ^ solution to bwd anal
241 -- | It can be useful to refine the results of an existing analysis,
242 -- or for example to use the outcome of a forward analsysis in a
243 -- backward analysis. These functions can also be used to compute a
244 -- fixed point iteratively starting from somewhere other than bottom
245 -- (as in the reachability analysis done for proc points).
247 class (Outputable m, Outputable l, LastNode l) => DebugNodes m l
249 refine_f_anal :: (DebugNodes m l, LastNode l, Outputable a) =>
250 FAnalysis m l a -> LGraph m l -> DFA a () -> DFA a ()
252 refine_b_anal :: (DebugNodes m l, LastNode l, Outputable a) =>
253 BAnalysis m l a -> LGraph m l -> DFA a () -> DFA a ()
255 b_rewrite :: (DebugNodes m l, Outputable a) =>
256 BPass m l a -> LGraph m l -> DFM a (LGraph m l)
257 f_rewrite :: (DebugNodes m l, LastNode l, Outputable m, Outputable a) =>
258 FPass m l a -> a -> LGraph m l -> DFM a (LGraph m l)
259 -- ^ extra parameter is the entry fact
262 :: (DebugNodes m l, Outputable a)
263 => BAnalysis m l a -> BFunctionalTransformation m l a ->
264 Graph m l -> DFM a (Graph m l)
266 b_shallow_rewrite = error "unimp"
269 :: (DebugNodes m l, Outputable a)
270 => FAnalysis m l a -> FFunctionalTransformation m l a ->
271 a -> Graph m l -> DFM a (Graph m l)
274 -- | If the solution to a problem is already sitting in a monad, we
275 -- should be able to take a short cut and just rewrite it in one pass.
276 -- But not yet implemented.
279 f_rewrite_solved :: (LastNode l, Outputable m, Outputable a) =>
280 FPass m l a -> DFM a () -> LGraph m l -> DFM a (LGraph m l)
281 b_rewrite_solved :: (LastNode l, Outputable m, Outputable a) =>
282 BPass m l a -> DFM a () -> LGraph m l -> DFM a (LGraph m l)
285 -- ===================== IMPLEMENTATION ======================--
287 -- | Here's a function to run an action on blocks until we reach a fixed point.
288 run :: (DataflowAnalysis anal, Monad (anal a), Outputable a, DebugNodes m l) =>
289 String -> String -> anal a () -> (b -> Block m l -> anal a b) ->
290 b -> [Block m l] -> anal a b
291 run dir name set_entry do_block b blocks =
292 do { set_entry; show_blocks $ iterate (1::Int) }
294 -- N.B. Each iteration starts with the same transaction limit;
295 -- only the rewrites in the final iteration actually count
296 trace_block b block = my_trace "about to do" (text name <+> text "on" <+> ppr (blockId block)) $
299 do { markFactsUnchanged
300 ; b <- foldM trace_block b blocks
301 ; changed <- factsStatus
303 ; let depth = 0 -- was nesting depth
306 NoChange -> unchanged depth $ return b
308 pprFacts depth n facts $
309 if n < 1000 then iterate (n+1)
312 msg n = concat [name, " didn't converge in ", show n, " " , dir,
314 my_nest depth sdoc = my_trace "" $ nest (3*depth) sdoc
315 ppIter depth n = my_nest depth (empty $$ text "*************** iteration" <+> pp_i n)
316 pp_i n = int n <+> text "of" <+> text name <+> text "on" <+> graphId
317 unchanged depth = my_nest depth (text "facts are unchanged")
319 pprFacts depth n env =
320 my_nest depth (text "facts for iteration" <+> pp_i n <+> text "are:" $$
321 (nest 2 $ vcat $ map pprFact $ ufmToList env))
322 pprFact (id, a) = hang (ppr id <> colon) 4 (ppr a)
323 graphId = case blocks of { Block id _ : _ -> ppr id ; [] -> text "<empty>" }
324 show_blocks = my_trace "Blocks:" (vcat (map pprBlock blocks))
325 pprBlock (Block id t) = nest 2 (pprFact (id, t))
328 \subsection{Backward problems}
330 In a backward problem, we compute \emph{in} facts from \emph{out}
331 facts. The analysis gives us [[exit_in]], [[last_in]], [[middle_in]],
332 and [[first_in]], each of which computes an \emph{in} fact for one
333 kind of node. We provide [[head_in]], which computes the \emph{in}
334 fact for a first node followed by zero or more middle nodes.
336 We don't compute and return the \emph{in} fact for block; instead, we
337 use [[setFact]] to attach that fact to the block's unique~ID.
338 We iterate until no more facts have changed.
340 run_b_anal comp graph =
341 refine_b_anal comp graph (return ())
342 -- for a backward analysis, everything is initially bottom
344 refine_b_anal comp graph initial =
345 run "backward" (bc_name comp) initial set_block_fact () blocks
347 blocks = reverse (postorder_dfs graph)
348 set_block_fact () b@(G.Block id _) =
349 let (h, l) = G.goto_end (G.unzip b) in
351 setFact id $ head_in h (last_in comp env l) -- 'in' fact for the block
352 head_in (G.ZHead h m) out = head_in h (bc_middle_in comp out m)
353 head_in (G.ZFirst id) out = bc_first_in comp out id
355 last_in :: BComputation m l i o -> (BlockId -> i) -> G.ZLast l -> o
356 last_in comp env (G.LastOther l) = bc_last_in comp env l
357 last_in comp _ (G.LastExit) = bc_exit_in comp
359 ------ we can now pass those facts elsewhere
360 fold_edge_facts_b f comp graph env z =
361 foldl fold_block_facts z (postorder_dfs graph)
363 fold_block_facts z b =
364 let (h, l) = G.goto_end (G.unzip b)
365 in head_fold h (last_in comp env l) z
366 head_fold (G.ZHead h m) out z = head_fold h (bc_middle_in comp out m) (f out z)
367 head_fold (G.ZFirst id) out z = f (bc_first_in comp out id) (f out z)
369 fold_edge_facts_with_nodes_b fl fm ff comp graph env z =
370 foldl fold_block_facts z (postorder_dfs graph)
372 fold_block_facts z b =
373 let (h, l) = G.goto_end (G.unzip b)
374 in' = last_in comp env l
375 z' = case l of { G.LastExit -> z ; G.LastOther l -> fl l in' z }
376 in head_fold h in' z'
377 head_fold (G.ZHead h m) out z =
378 let a = bc_middle_in comp out m
381 head_fold (G.ZFirst id) out z =
382 let a = bc_first_in comp out id
387 -- | In the general case we solve a graph in the context of a larger subgraph.
388 -- To do this, we need a locally modified computation that allows an
389 -- ``exit fact'' to flow into the exit node.
391 comp_with_exit_b :: BComputation m l i (OptimizationFuel -> DFM f (Answer m l o)) -> o ->
392 BComputation m l i (OptimizationFuel -> DFM f (Answer m l o))
393 comp_with_exit_b comp exit_fact =
394 comp { bc_exit_in = \_fuel -> return $ Dataflow $ exit_fact }
396 -- | Given this function, we can now solve a graph simply by doing a
397 -- backward analysis on the modified computation. Note we have to be
398 -- very careful with 'Rewrite'. Either a rewrite is going to
399 -- participate, in which case we mark the graph rerewritten, or we're
400 -- going to analysis the proposed rewrite and then throw away
401 -- everything but the answer, in which case it's a 'subAnalysis'. A
402 -- Rewrite should always use exactly one of these monadic operations.
405 (DebugNodes m l, Outputable a) =>
406 BPass m l a -> OptimizationFuel -> G.LGraph m l -> a -> DFM a (OptimizationFuel, a)
407 solve_graph_b comp fuel graph exit_fact =
408 general_backward (comp_with_exit_b comp exit_fact) fuel graph
410 -- general_backward :: BPass m l a -> OptimizationFuel -> G.LGraph m l -> DFM a (OptimizationFuel, a)
411 general_backward comp fuel graph =
412 let -- set_block_fact :: OptimizationFuel -> G.Block m l -> DFM a OptimizationFuel
413 set_block_fact fuel b =
414 do { (fuel, block_in) <-
415 let (h, l) = G.goto_end (G.unzip b) in
416 factsEnv >>= \env -> last_in comp env l fuel >>= \x ->
418 Dataflow a -> head_in fuel h a
421 ; (fuel, a) <- subAnalysis' $
422 solve_graph_b_g comp (oneLessFuel fuel) g bot
424 ; my_trace "result of" (text (bc_name comp) <+>
425 text "on" <+> ppr (G.blockId b) <+> text "is" <+> ppr block_in) $
426 setFact (G.blockId b) block_in
429 head_in fuel (G.ZHead h m) out =
430 bc_middle_in comp out m fuel >>= \x -> case x of
431 Dataflow a -> head_in fuel h a
433 do { (fuel, a) <- subAnalysis' $ solve_graph_b_g comp (oneLessFuel fuel) g out
434 ; my_trace "Rewrote middle node"
435 (f4sep [ppr m, text "to", pprGraph g]) $
437 head_in fuel (G.ZFirst id) out =
438 bc_first_in comp out id fuel >>= \x -> case x of
439 Dataflow a -> return (fuel, a)
440 Rewrite g -> do { subAnalysis' $ solve_graph_b_g comp (oneLessFuel fuel) g out }
443 run "backward" (bc_name comp) (return ()) set_block_fact fuel blocks
444 ; a <- getFact (G.lg_entry graph)
446 ; my_trace "Solution to graph after pass 1 is" (pprFacts graph facts a) $
449 blocks = reverse (G.postorder_dfs graph)
450 pprFacts g env a = (ppr a <+> text "with") $$ vcat (pprLgraph g : map pprFact (ufmToList env))
451 pprFact (id, a) = hang (ppr id <> colon) 4 (ppr a)
454 (DebugNodes m l, Outputable a) =>
455 BPass m l a -> OptimizationFuel -> G.Graph m l -> a -> DFM a (OptimizationFuel, a)
456 solve_graph_b_g comp fuel graph exit_fact =
457 do { g <- lgraphOfGraph graph ; solve_graph_b comp fuel g exit_fact }
460 lgraphOfGraph :: G.Graph m l -> DFM f (G.LGraph m l)
462 do id <- freshBlockId "temporary id for dataflow analysis"
463 return $ labelGraph id g
465 labelGraph :: BlockId -> G.Graph m l -> G.LGraph m l
466 labelGraph id (Graph tail blocks) = LGraph id (insertBlock (Block id tail) blocks)
468 -- | We can remove the entry label of an LGraph and remove
469 -- it, leaving a Graph. Notice that this operation is NOT SAFE if a
470 -- block within the LGraph branches to the entry point. It should
471 -- be used only to complement 'lgraphOfGraph' above.
473 remove_entry_label :: LGraph m l -> Graph m l
474 remove_entry_label g =
475 let FGraph e (ZBlock (ZFirst id) tail) others = entry g
476 in ASSERT (id == e) Graph tail others
479 We solve and rewrite in two passes: the first pass iterates to a fixed
480 point to reach a dataflow solution, and the second pass uses that
481 solution to rewrite the graph.
484 key job is done by [[propagate]], which propagates a fact of type~[[a]]
485 between a head and tail.
486 The tail is in final form; the head is still to be rewritten.
489 solve_and_rewrite_b ::
490 (DebugNodes m l, Outputable a) =>
491 BPass m l a -> OptimizationFuel -> LGraph m l -> a -> DFM a (OptimizationFuel, a, LGraph m l)
492 solve_and_rewrite_b_graph ::
493 (DebugNodes m l, Outputable a) =>
494 BPass m l a -> OptimizationFuel -> Graph m l -> a -> DFM a (OptimizationFuel, a, Graph m l)
497 solve_and_rewrite_b comp fuel graph exit_fact =
498 do { (_, a) <- solve_graph_b comp fuel graph exit_fact -- pass 1
500 ; (fuel, g) <- -- pass 2
501 my_trace "Solution to graph after pass 1 is" (pprFacts graph facts) $
502 backward_rewrite (comp_with_exit_b comp exit_fact) fuel graph
504 ; my_trace "Rewritten graph after pass 2 is" (pprFacts g facts) $
505 return (fuel, a, g) }
507 pprFacts g env = vcat (pprLgraph g : map pprFact (ufmToList env))
508 pprFact (id, a) = hang (ppr id <> colon) 4 (ppr a)
509 eid = G.lg_entry graph
510 backward_rewrite comp fuel graph =
511 rewrite_blocks comp fuel emptyBlockEnv $ reverse (G.postorder_dfs graph)
513 -- BPass m l a -> OptimizationFuel ->
514 -- BlockEnv (Block m l) -> [Block m l] -> DFM a (OptimizationFuel,G.LGraph m l)
515 rewrite_blocks _comp fuel rewritten [] = return (fuel, G.LGraph eid rewritten)
516 rewrite_blocks comp fuel rewritten (b:bs) =
517 let rewrite_next_block fuel =
518 let (h, l) = G.goto_end (G.unzip b) in
519 factsEnv >>= \env -> last_in comp env l fuel >>= \x -> case x of
520 Dataflow a -> propagate fuel h a (G.ZLast l) rewritten
522 do { markGraphRewritten
524 ; (fuel, a, g') <- solve_and_rewrite_b_graph comp (oneLessFuel fuel) g bot
525 ; let G.Graph t new_blocks = g'
526 ; let rewritten' = new_blocks `plusUFM` rewritten
527 ; propagate fuel h a t rewritten' -- continue at entry of g'
529 -- propagate :: OptimizationFuel -- Number of rewrites permitted
530 -- -> G.ZHead m -- Part of current block yet to be rewritten
531 -- -> a -- Fact on edge between head and tail
532 -- -> G.ZTail m l -- Part of current block already rewritten
533 -- -> BlockEnv (Block m l) -- Blocks already rewritten
534 -- -> DFM a (OptimizationFuel, G.LGraph m l)
535 propagate fuel (G.ZHead h m) out tail rewritten =
536 bc_middle_in comp out m fuel >>= \x -> case x of
537 Dataflow a -> propagate fuel h a (G.ZTail m tail) rewritten
539 do { markGraphRewritten
540 ; (fuel, a, g') <- solve_and_rewrite_b_graph comp (oneLessFuel fuel) g out
541 ; let G.Graph t newblocks = G.splice_tail g' tail
542 ; my_trace "Rewrote middle node"
543 (f4sep [ppr m, text "to", pprGraph g']) $
544 propagate fuel h a t (newblocks `plusUFM` rewritten) }
545 propagate fuel h@(G.ZFirst id) out tail rewritten =
546 bc_first_in comp out id fuel >>= \x -> case x of
548 let b = G.Block id tail in
549 do { checkFactMatch id a
550 ; rewrite_blocks comp fuel (extendBlockEnv rewritten id b) bs }
552 do { markGraphRewritten
553 ; (fuel, a, g') <- solve_and_rewrite_b_graph comp (oneLessFuel fuel) g out
554 ; let G.Graph t newblocks = G.splice_tail g' tail
555 ; my_trace "Rewrote label " (f4sep [ppr id,text "to",pprGraph g])$
556 propagate fuel h a t (newblocks `plusUFM` rewritten) }
557 in rewrite_next_block fuel
559 {- Note [Rewriting labelled LGraphs]
560 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
561 It's hugely annoying that we get in an LGraph and in order to solve it
562 we have to slap on a new label which we then immediately strip off.
563 But the alternative is to have all the iterative solvers work on
564 Graphs, and then suddenly instead of a single case (ZBlock) every
565 solver has to deal with two cases (ZBlock and ZTail). So until
566 somebody comes along who is smart enough to do this and still leave
567 the code understandable for mortals, it stays as it is.
569 (One part of the solution will be postorder_dfs_from_except.)
572 solve_and_rewrite_b_graph comp fuel graph exit_fact =
573 do g <- lgraphOfGraph graph
574 (fuel, a, g') <- solve_and_rewrite_b comp fuel g exit_fact
575 return (fuel, a, remove_entry_label g')
578 do { fuel <- fuelRemaining
580 ; (fuel', _, gc) <- solve_and_rewrite_b comp fuel g bot
581 ; fuelDecrement (bc_name comp) fuel fuel'
586 This debugging stuff is left over from imperative-land.
587 It might be useful one day if I learn how to cheat the IO monad!
589 debug_b :: (Outputable m, Outputable l, Outputable a) => BPass m l a -> BPass m l a
591 let debug s (f, comp) =
592 let pr = Printf.eprintf in
593 let fact dir node a = pr "%s %s for %s = %s\n" f.fact_name dir node (s a) in
594 let rewr node g = pr "%s rewrites %s to <not-shown>\n" comp.name node in
595 let wrap f nodestring node fuel =
596 let answer = f node fuel in
597 let () = match answer with
598 | Dataflow a -> fact "in " (nodestring node) a
599 | Rewrite g -> rewr (nodestring node) g in
601 let wrapout f nodestring out node fuel =
602 fact "out" (nodestring node) out;
603 wrap (f out) nodestring node fuel in
604 let last_in = wrap comp.last_in (RS.rtl << G.last_instr) in
605 let middle_in = wrapout comp.middle_in (RS.rtl << G.mid_instr) in
607 let first = function G.Entry -> "<entry>" | G.Label ((u, l), _, _) -> l in
608 wrapout comp.first_in first in
609 f, { comp with last_in = last_in; middle_in = middle_in; first_in = first_in; }
612 anal_b comp = comp { bc_last_in = wrap2 $ bc_last_in comp
613 , bc_exit_in = wrap0 $ bc_exit_in comp
614 , bc_middle_in = wrap2 $ bc_middle_in comp
615 , bc_first_in = wrap2 $ bc_first_in comp }
616 where wrap2 f out node _fuel = return $ Dataflow (f out node)
617 wrap0 fact _fuel = return $ Dataflow fact
619 ignore_transactions_b comp =
620 comp { bc_last_in = wrap2 $ bc_last_in comp
621 , bc_exit_in = wrap0 $ bc_exit_in comp
622 , bc_middle_in = wrap2 $ bc_middle_in comp
623 , bc_first_in = wrap2 $ bc_first_in comp }
624 where wrap2 f out node _fuel = f out node
625 wrap0 fact _fuel = fact
627 answer' :: (b -> DFM f (Graph m l)) -> OptimizationFuel -> Maybe b -> a -> DFM f (Answer m l a)
628 answer' lift fuel r a =
629 case r of Just gc | canRewriteWithFuel fuel
630 -> do { g <- lift gc; return $ Rewrite g }
631 _ -> return $ Dataflow a
634 :: (b -> DFM f (Graph m l)) -> OptimizationFuel -> Maybe b -> a -> DFM f (Answer m l a)
635 unlimited_answer' lift _fuel r a =
636 case r of Just gc -> do { g <- lift gc; return $ Rewrite g }
637 _ -> return $ Dataflow a
639 combine_a_t_with :: (OptimizationFuel -> Maybe b -> a -> DFM a (Answer m l a)) ->
640 BAnalysis m l a -> BComputation m l a (Maybe b) ->
642 combine_a_t_with answer anal tx =
643 let last_in env l fuel =
644 answer fuel (bc_last_in tx env l) (bc_last_in anal env l)
645 exit_in fuel = answer fuel (bc_exit_in tx) (bc_exit_in anal)
646 middle_in out m fuel =
647 answer fuel (bc_middle_in tx out m) (bc_middle_in anal out m)
648 first_in out f fuel =
649 answer fuel (bc_first_in tx out f) (bc_first_in anal out f)
650 in BComp { bc_name = concat [bc_name anal, " and ", bc_name tx]
651 , bc_last_in = last_in, bc_middle_in = middle_in
652 , bc_first_in = first_in, bc_exit_in = exit_in }
654 a_t_b = combine_a_t_with (answer' liftUSM)
655 a_ft_b = combine_a_t_with (answer' return)
656 a_ft_b_unlimited = combine_a_t_with (unlimited_answer' return)
659 -- =============== FORWARD ================
661 -- | We don't compute and return the \emph{in} fact for block; instead, we
662 -- use [[P.set]] to attach that fact to the block's unique~ID.
663 -- We iterate until no more facts have changed.
668 my_trace :: String -> SDoc -> a -> a
669 my_trace = if dump_things then pprTrace else \_ _ a -> a
671 run_f_anal comp entry_fact graph = refine_f_anal comp graph set_entry
672 where set_entry = setFact (G.lg_entry graph) entry_fact
674 refine_f_anal comp graph initial =
675 run "forward" (fc_name comp) initial set_successor_facts () blocks
676 where blocks = G.postorder_dfs graph
677 set_successor_facts () (G.Block id t) =
678 let forward in' (G.ZTail m t) = forward (fc_middle_out comp in' m) t
679 forward in' (G.ZLast l) = last_outs setEdgeFacts comp in' l
680 _blockname = if id == G.lg_entry graph then "<entry>" else show id
681 in getFact id >>= \a -> forward (fc_first_out comp a id) t
682 setEdgeFacts (LastOutFacts fs) = mapM_ setEdgeFact fs
683 setEdgeFact (id, a) = setFact id a
685 last_outs :: (DataflowAnalysis df, Outputable a) => (LastOutFacts a -> df a ()) -> FComputation m l i a (LastOutFacts a) -> i -> G.ZLast l -> df a ()
686 last_outs _do_last_outs comp i (G.LastExit) = setExitFact (fc_exit_out comp i)
687 last_outs do_last_outs comp i (G.LastOther l) = do_last_outs $ fc_last_outs comp i l
689 last_rewrite :: FComputation m l i a a -> i -> G.ZLast l -> a
690 last_rewrite comp i (G.LastExit) = fc_exit_out comp i
691 last_rewrite comp i (G.LastOther l) = fc_last_outs comp i l
694 -- | Given [[comp_with_exit_f]], we can now solve a graph simply by doing a
695 -- forward analysis on the modified computation.
697 (DebugNodes m l, Outputable a) =>
698 FPass m l a -> OptimizationFuel -> G.LGraph m l -> a ->
699 DFM a (OptimizationFuel, a, LastOutFacts a)
700 solve_graph_f comp fuel g in_fact =
701 do { fuel <- general_forward fuel in_fact g
703 ; outs <- lastOutFacts
704 ; return (fuel, a, outs) }
706 -- general_forward :: FPass m l a -> OptimizationFuel -> a -> G.LGraph m l -> DFM a OptimizationFuel
707 general_forward fuel entry_fact graph =
708 let blocks = G.postorder_dfs g
709 is_local id = isJust $ lookupBlockEnv (G.lg_blocks g) id
710 -- set_or_save :: LastOutFacts a -> DFM a ()
711 set_or_save (LastOutFacts l) = mapM_ set_or_save_one l
712 set_or_save_one (id, a) =
713 if is_local id then setFact id a else addLastOutFact (id, a)
714 set_entry = setFact (G.lg_entry graph) entry_fact
716 set_successor_facts fuel b =
717 let set_tail_facts fuel in' (G.ZTail m t) =
718 my_trace "Solving middle node" (ppr m) $
719 fc_middle_out comp in' m fuel >>= \ x -> case x of
720 Dataflow a -> set_tail_facts fuel a t
722 do (fuel, out, last_outs) <-
723 subAnalysis' $ solve_graph_f_g comp (oneLessFuel fuel) g in'
724 set_or_save last_outs
725 set_tail_facts fuel out t
726 set_tail_facts fuel in' (G.ZLast LastExit) =
727 fc_exit_out comp in' fuel >>= \x -> case x of
728 Dataflow a -> do { setExitFact a; return fuel }
729 Rewrite _g -> error "rewriting exit node not implemented"
730 set_tail_facts fuel in' (G.ZLast (G.LastOther l)) =
731 fc_last_outs comp in' l fuel >>= \x -> case x of
732 Dataflow outs -> do { set_or_save outs; return fuel }
734 do (fuel, _, last_outs) <-
735 subAnalysis' $ solve_graph_f_g comp (oneLessFuel fuel) g in'
736 set_or_save last_outs
739 in do idfact <- getFact id
740 infact <- fc_first_out comp idfact id fuel
741 case infact of Dataflow a -> set_tail_facts fuel a t
743 do (fuel, out, last_outs) <- subAnalysis' $
744 solve_graph_f_g comp (oneLessFuel fuel) g idfact
745 set_or_save last_outs
746 set_tail_facts fuel out t
747 in run "forward" (fc_name comp) set_entry set_successor_facts fuel blocks
750 (DebugNodes m l, Outputable a) =>
751 FPass m l a -> OptimizationFuel -> G.Graph m l -> a ->
752 DFM a (OptimizationFuel, a, LastOutFacts a)
753 solve_graph_f_g comp fuel graph in_fact =
754 do { g <- lgraphOfGraph graph ; solve_graph_f comp fuel g in_fact }
758 We solve and rewrite in two passes: the first pass iterates to a fixed
759 point to reach a dataflow solution, and the second pass uses that
760 solution to rewrite the graph.
762 The key job is done by [[propagate]], which propagates a fact of type~[[a]]
763 between a head and tail.
764 The tail is in final form; the head is still to be rewritten.
766 solve_and_rewrite_f ::
767 (DebugNodes m l, Outputable a) =>
768 FPass m l a -> OptimizationFuel -> LGraph m l -> a ->
769 DFM a (OptimizationFuel, a, LGraph m l)
770 solve_and_rewrite_f comp fuel graph in_fact =
771 do solve_graph_f comp fuel graph in_fact -- pass 1
772 (fuel, g) <- forward_rewrite comp fuel graph in_fact
773 exit_fact <- getExitFact --- XXX should drop this; it's in the monad
774 return (fuel, exit_fact, g)
776 f_shallow_rewrite anal ftx in_fact g =
777 do { fuel <- fuelRemaining
778 ; solve_shallow_graph_f (return ()) anal ftx in_fact g fuel
779 ; id <- freshBlockId "temporary entry id"
781 forward_rewrite_gen don't_rewrite anal ftx (ZFirst id) in_fact g fuel
782 ; fuelDecrement (fc_name ftx) fuel fuel'
783 ; return (remove_entry_label (LGraph id blocks))
785 where don't_rewrite finish g fuel = finish >>= \b -> return (b, g, fuel)
789 :: (DebugNodes m l, Outputable a)
790 => DFM a b -- final action and result after solving this tail
791 -> FAnalysis m l a -> FFunctionalTransformation m l a
792 -> (BlockId -> Bool) -- local blocks
793 -> a -> ZTail m l -> OptimizationFuel -> DFM a (b, OptimizationFuel)
794 shallow_tail_solve_f finish anal ftx is_local in' (G.ZTail m t) fuel =
795 my_trace "Solving middle node" (ppr m) $
796 case maybeRewriteWithFuel fuel $ fc_middle_out ftx in' m of
797 Just g -> do out <- subAnalysis' $ liftAnal $
798 anal_f_general getExitFact anal in' g
799 shallow_tail_solve_f finish anal ftx is_local out t (oneLessFuel fuel)
800 Nothing -> shallow_tail_solve_f finish anal ftx is_local
801 (fc_middle_out anal in' m) t fuel
802 shallow_tail_solve_f finish anal ftx is_local in' (G.ZLast (G.LastOther l)) fuel =
803 case maybeRewriteWithFuel fuel $ fc_last_outs ftx in' l of
804 Just g -> do { last_outs <-
805 subAnalysis' $ liftAnal $ anal_f_general lastOutFacts anal in' g
806 ; set_or_save last_outs
808 ; return (b, oneLessFuel fuel) }
809 Nothing -> do { set_or_save (fc_last_outs anal in' l)
812 where set_or_save = mk_set_or_save is_local
813 shallow_tail_solve_f finish anal ftx _is_local in' (G.ZLast LastExit) fuel =
814 case maybeRewriteWithFuel fuel $ fc_exit_out ftx in' of
816 subAnalysis' $ liftAnal $ anal_f_general getExitFact anal in' g
819 ; return (b, oneLessFuel fuel) }
820 Nothing -> do { setExitFact $ fc_exit_out anal in'
824 anal_f_general :: (DebugNodes m l, Outputable a)
825 => DFA a b -> FAnalysis m l a -> a -> Graph m l -> DFA a b
826 anal_f_general finish anal in_fact (Graph entry blockenv) =
827 general_forward in_fact
829 is_local id = isJust $ lookupBlockEnv blockenv id
830 set_or_save = mk_set_or_save is_local
831 anal_tail = gen_tail_anal_f set_or_save anal
832 blocks = G.postorder_dfs_from blockenv entry
833 general_forward in_fact =
834 do { let setup = anal_tail in_fact entry -- sufficient to do once
835 ; let set_successor_facts () (Block id tail) =
836 do { idfact <- getFact id
837 ; anal_tail (fc_first_out anal idfact id) tail }
838 ; run "forward" (fc_name anal) setup set_successor_facts () blocks
842 gen_tail_anal_f :: (Outputable a) =>
843 (LastOutFacts a -> DFA a ()) -> FAnalysis m l a -> a -> ZTail m l -> DFA a ()
844 gen_tail_anal_f do_last_outs anal a tail = propagate a tail
845 where propagate a (ZTail m t) = propagate (fc_middle_out anal a m) t
846 propagate a (ZLast LastExit) = setExitFact (fc_exit_out anal a)
847 propagate a (ZLast (LastOther l)) = do_last_outs $ fc_last_outs anal a l
850 solve_shallow_graph_f ::
851 (DebugNodes m l, Outputable a) =>
853 FAnalysis m l a -> FFunctionalTransformation m l a -> a -> G.Graph m l
854 -> OptimizationFuel -> DFM a (b, OptimizationFuel)
855 solve_shallow_graph_f finish anal ftx in_fact (Graph entry blockenv) fuel =
856 do { fuel <- general_forward in_fact fuel
860 is_local id = isJust $ lookupBlockEnv blockenv id
861 set_or_save = mk_set_or_save is_local
862 solve_tail = shallow_tail_solve_f lastOutFacts anal ftx is_local
863 blocks = G.postorder_dfs_from blockenv entry
864 name = concat [fc_name anal, " and ", fc_name ftx]
865 general_forward in_fact fuel =
866 do { (last_outs, fuel) <- solve_tail in_fact entry fuel
867 ; set_or_save last_outs
868 ; let set_successor_facts fuel (Block id tail) =
869 do { idfact <- getFact id
870 ; (last_outs, fuel) <-
871 case maybeRewriteWithFuel fuel $ fc_first_out ftx idfact id of
872 Nothing -> solve_tail idfact tail fuel
875 subAnalysis' $ liftAnal $
876 anal_f_general getExitFact anal idfact g
877 solve_tail outfact tail (oneLessFuel fuel)
878 ; set_or_save last_outs
880 ; run "forward" name (return ()) set_successor_facts fuel blocks }
882 mk_set_or_save :: (DataflowAnalysis df, Monad (df a), Outputable a) =>
883 (BlockId -> Bool) -> LastOutFacts a -> df a ()
884 mk_set_or_save is_local (LastOutFacts l) = mapM_ set_or_save_one l
885 where set_or_save_one (id, a) =
886 if is_local id then setFact id a else addLastOutFact (id, a)
888 lastOutFacts :: (DataflowAnalysis m, Monad (m f)) => m f (LastOutFacts f)
889 lastOutFacts = bareLastOutFacts >>= return . LastOutFacts
892 fwd_rew_tail_gen :: (DebugNodes m l, Outputable a) =>
893 (forall b . DFM a b -> Graph m l -> OptimizationFuel -> DFM a (b, Graph m l, OptimizationFuel)) ->
894 FAnalysis m l a -> FFunctionalTransformation m l a -> ZHead m -> a -> ZTail m l
895 -> BlockEnv (Block m l)
896 -> OptimizationFuel -> DFM a (BlockEnv (Block m l), OptimizationFuel)
897 fwd_rew_tail_gen recursive_rewrite anal ftx head in_fact tail rewritten fuel =
898 propagate head in_fact tail rewritten fuel
900 propagate h in' (G.ZTail m t) rewritten fuel =
901 my_trace "Rewriting middle node" (ppr m) $
902 case maybeRewriteWithFuel fuel $ fc_middle_out ftx in' m of
903 Nothing -> propagate (G.ZHead h m) (fc_middle_out anal in' m) t rewritten fuel
904 Just g -> do markGraphRewritten
905 (a, g, fuel) <- recursive_rewrite getExitFact g fuel
906 let (blocks, h') = G.splice_head' h g
907 propagate h' a t (blocks `plusUFM` rewritten) fuel
908 propagate h in' (G.ZLast l) rewritten fuel =
909 case maybeRewriteWithFuel fuel $ last_rewrite ftx in' l of
910 Nothing -> -- can throw away facts because this is the rewriting phase
911 return (insertBlock (zipht h (G.ZLast l)) rewritten, fuel)
912 Just g -> do markGraphRewritten
913 ((), g, fuel) <- recursive_rewrite (return ()) g fuel
914 let g' = G.splice_head_only' h g
915 return (G.lg_blocks g' `plusUFM` rewritten, fuel)
917 forward_rewrite_gen ::
918 (DebugNodes m l, Outputable a) =>
919 (forall b . DFM a b -> Graph m l -> OptimizationFuel -> DFM a (b, Graph m l, OptimizationFuel)) ->
920 FAnalysis m l a -> FFunctionalTransformation m l a -> ZHead m -> a -> Graph m l
921 -> OptimizationFuel -> DFM a (BlockEnv (Block m l), OptimizationFuel)
922 forward_rewrite_gen recursive_rewrite anal ftx head a (Graph entry blockenv) fuel =
923 do (rewritten, fuel) <- rewrite_tail head a entry emptyBlockEnv fuel
924 rewrite_blocks (G.postorder_dfs_from blockenv entry) rewritten fuel
926 -- need to build in some checking for consistency of facts
927 rewrite_tail = fwd_rew_tail_gen recursive_rewrite anal ftx
928 rewrite_blocks [] rewritten fuel = return (rewritten, fuel)
929 rewrite_blocks (G.Block id t : bs) rewritten fuel =
930 do id_fact <- getFact id
931 case maybeRewriteWithFuel fuel $ fc_first_out ftx id_fact id of
932 Nothing -> do { (rewritten, fuel) <-
933 rewrite_tail (ZFirst id) id_fact t rewritten fuel
934 ; rewrite_blocks bs rewritten fuel }
935 Just g -> do { (outfact, g, fuel) <- recursive_rewrite getExitFact g fuel
936 ; let (blocks, h) = splice_head' (ZFirst id) g
937 ; (rewritten, fuel) <-
938 rewrite_tail h outfact t (blocks `plusUFM` rewritten) fuel
939 ; rewrite_blocks bs rewritten fuel }
946 solve_and_rewrite_f_graph ::
947 (DebugNodes m l, Outputable a) =>
948 FPass m l a -> OptimizationFuel -> Graph m l -> a ->
949 DFM a (OptimizationFuel, a, Graph m l)
950 solve_and_rewrite_f_graph comp fuel graph in_fact =
951 do g <- lgraphOfGraph graph
952 (fuel, a, g') <- solve_and_rewrite_f comp fuel g in_fact
953 return (fuel, a, remove_entry_label g')
956 (DebugNodes m l, Outputable a) =>
957 FPass m l a -> OptimizationFuel -> G.LGraph m l -> a ->
958 DFM a (OptimizationFuel, G.LGraph m l)
959 forward_rewrite comp fuel graph entry_fact =
960 do setFact eid entry_fact
961 rewrite_blocks fuel emptyBlockEnv (G.postorder_dfs graph)
963 eid = G.lg_entry graph
964 is_local id = isJust $ lookupBlockEnv (G.lg_blocks graph) id
965 -- set_or_save :: LastOutFacts a -> DFM a ()
966 set_or_save (LastOutFacts l) = mapM_ set_or_save_one l
967 set_or_save_one (id, a) =
968 if is_local id then checkFactMatch id a
969 else panic "set fact outside graph during rewriting pass?!"
972 -- OptimizationFuel -> BlockEnv (Block m l) -> [Block m l] -> DFM a (OptimizationFuel, LGraph m l)
973 rewrite_blocks fuel rewritten [] = return (fuel, G.LGraph eid rewritten)
974 rewrite_blocks fuel rewritten (G.Block id t : bs) =
975 do id_fact <- getFact id
976 first_out <- fc_first_out comp id_fact id fuel
978 Dataflow a -> propagate fuel (G.ZFirst id) a t rewritten bs
979 Rewrite g -> do { markGraphRewritten
980 ; rewrite_blocks (oneLessFuel fuel) rewritten
981 (G.postorder_dfs (labelGraph id g) ++ bs) }
982 -- propagate :: OptimizationFuel -> G.ZHead m -> a -> G.ZTail m l -> BlockEnv (G.Block m l) ->
983 -- [G.Block m l] -> DFM a (OptimizationFuel, G.LGraph m l)
984 propagate fuel h in' (G.ZTail m t) rewritten bs =
985 my_trace "Rewriting middle node" (ppr m) $
986 do fc_middle_out comp in' m fuel >>= \x -> case x of
987 Dataflow a -> propagate fuel (G.ZHead h m) a t rewritten bs
989 do markGraphRewritten
990 (fuel, a, g) <- solve_and_rewrite_f_graph comp (oneLessFuel fuel) g in'
991 let (blocks, h') = G.splice_head' h g
992 propagate fuel h' a t (blocks `plusUFM` rewritten) bs
993 propagate fuel h in' t@(G.ZLast G.LastExit) rewritten bs =
994 do fc_exit_out comp in' fuel >>= \x -> case x of
998 rewrite_blocks fuel (G.insertBlock b rewritten) bs
1000 do markGraphRewritten
1001 (fuel, _, g) <- solve_and_rewrite_f_graph comp (oneLessFuel fuel) g in'
1002 let g' = G.splice_head_only' h g
1003 rewrite_blocks fuel (G.lg_blocks g' `plusUFM` rewritten) bs
1004 propagate fuel h in' t@(G.ZLast (G.LastOther l)) rewritten bs =
1005 do fc_last_outs comp in' l fuel >>= \x -> case x of
1009 rewrite_blocks fuel (G.insertBlock b rewritten) bs
1011 do markGraphRewritten
1012 (fuel, _, g) <- solve_and_rewrite_f_graph comp (oneLessFuel fuel) g in'
1013 let g' = G.splice_head_only' h g
1014 rewrite_blocks fuel (G.lg_blocks g' `plusUFM` rewritten) bs
1016 f_rewrite comp entry_fact g =
1017 do { fuel <- fuelRemaining
1018 ; (fuel', _, gc) <- solve_and_rewrite_f comp fuel g entry_fact
1019 ; fuelDecrement (fc_name comp) fuel fuel'
1025 debug_f :: (Outputable m, Outputable l, Outputable a) => FPass m l a -> FPass m l a
1027 let debug s (f, comp) =
1028 let pr = Printf.eprintf in
1029 let fact dir node a = pr "%s %s for %s = %s\n" f.fact_name dir node (s a) in
1030 let setter dir node run_sets set =
1031 run_sets (fun u a -> pr "%s %s for %s = %s\n" f.fact_name dir node (s a); set u a) in
1032 let rewr node g = pr "%s rewrites %s to <not-shown>\n" comp.name node in
1033 let wrap f nodestring wrap_answer in' node fuel =
1034 fact "in " (nodestring node) in';
1035 wrap_answer (nodestring node) (f in' node fuel)
1036 and wrap_fact n answer =
1037 let () = match answer with
1038 | Dataflow a -> fact "out" n a
1039 | Rewrite g -> rewr n g in
1041 and wrap_setter n answer =
1043 | Dataflow set -> Dataflow (setter "out" n set)
1044 | Rewrite g -> (rewr n g; Rewrite g) in
1045 let middle_out = wrap comp.middle_out (RS.rtl << G.mid_instr) wrap_fact in
1046 let last_outs = wrap comp.last_outs (RS.rtl << G.last_instr) wrap_setter in
1047 f, { comp with last_outs = last_outs; middle_out = middle_out; }
1050 anal_f comp = comp { fc_first_out = wrap2 $ fc_first_out comp
1051 , fc_middle_out = wrap2 $ fc_middle_out comp
1052 , fc_last_outs = wrap2 $ fc_last_outs comp
1053 , fc_exit_out = wrap1 $ fc_exit_out comp
1055 where wrap2 f out node _fuel = return $ Dataflow (f out node)
1056 wrap1 f fact _fuel = return $ Dataflow (f fact)
1060 let answer = answer' liftUSM
1061 first_out in' id fuel =
1062 answer fuel (fc_first_out tx in' id) (fc_first_out anal in' id)
1063 middle_out in' m fuel =
1064 answer fuel (fc_middle_out tx in' m) (fc_middle_out anal in' m)
1065 last_outs in' l fuel =
1066 answer fuel (fc_last_outs tx in' l) (fc_last_outs anal in' l)
1067 exit_out in' fuel = undefined
1068 answer fuel (fc_exit_out tx in') (fc_exit_out anal in')
1069 in FComp { fc_name = concat [fc_name anal, " and ", fc_name tx]
1070 , fc_last_outs = last_outs, fc_middle_out = middle_out
1071 , fc_first_out = first_out, fc_exit_out = exit_out }
1074 f4sep :: [SDoc] -> SDoc
1076 f4sep (d:ds) = fsep (d : map (nest 4) ds)
1078 subAnalysis' :: (Monad (m f), DataflowAnalysis m, Outputable f) =>
1081 do { a <- subAnalysis $
1082 do { a <- m; facts <- allFacts
1083 ; my_trace "after sub-analysis facts are" (pprFacts facts) $
1086 ; my_trace "in parent analysis facts are" (pprFacts facts) $
1088 where pprFacts env = nest 2 $ vcat $ map pprFact $ ufmToList env
1089 pprFact (id, a) = hang (ppr id <> colon) 4 (ppr a)
1092 _unused :: FS.FastString
1095 null_b_ft = BComp "do nothing" Nothing no2 no2 no2
1096 where no2 _ _ = Nothing
1098 null_f_ft = FComp "do nothing" no2 no2 no2 (\_ -> Nothing)
1099 where no2 _ _ = Nothing