1 {-# LANGUAGE ScopedTypeVariables #-}
3 ( AGraph, (<*>), emptyAGraph, withFreshLabel, withUnique
4 , mkMiddle, mkMiddles, mkLast, mkZTail, mkBranch, mkLabel, mkIfThenElse, mkWhileDo
6 , emptyGraph, graphOfMiddles, graphOfZTail
7 , lgraphOfAGraph, graphOfAGraph, labelAGraph
18 import Prelude hiding (zip, unzip, last)
21 -------------------------------------------------------------------------
22 -- GENERIC ZIPPER-BASED CONTROL-FLOW GRAPH (CONSTRUCTOR VIEW) --
23 -------------------------------------------------------------------------
27 You can think of an AGraph like this: it is the program built by
28 composing in sequence three kinds of nodes:
29 * Label nodes (e.g. L2:)
30 * Middle nodes (e.g. x = y*3)
31 * Last nodes (e.g. if b then goto L1 else goto L2)
33 The constructors mkLabel, mkMiddle, and mkLast build single-node
34 AGraphs of the indicated type. The composition operator <*> glues
35 AGraphs together in sequence (in constant time).
41 if x<10 then goto L1 else goto L2
46 Notice that the AGraph may begin without a label, and may end without
47 a control transfer. Control *always* falls through a label and middle
48 node, and *never* falls through a Last node.
50 A 'AGraph m l' is simply an abstract version of a 'Graph m l' from
51 module 'ZipCfg'. The only difference is that the 'AGraph m l'
52 supports a constant-time splicing operation, written infix <*>.
53 That splicing operation, together with the constructor functions in
54 this module (and with 'labelAGraph'), is the recommended way to build
55 large graphs. Each construction or splice has constant cost, and to
56 turn an AGraph into a Graph requires time linear in the number of
57 nodes and N log N in the number of basic blocks.
59 The splicing operation warrants careful explanation. Like a Graph, an
60 AGraph is a control-flow graph which begins with a distinguished,
61 unlabelled sequence of middle nodes called the *entry*. An unlabelled
62 graph may also end with a sequence of middle nodes called the *exit*.
63 The entry may fall straight through to the exit, or it may fall into
64 the rest of the graph, which may include arbitrary control flow.
66 Using ASCII art, here are examples of the two kinds of graph. On the
67 left, the entry and exit sequences are labelled A and B, where the
68 control flow in the middle is labelled X. On the right, there is no
84 The AGraph has these properties:
86 * A AGraph is opaque; nothing about its structure can be observed.
88 * A AGraph may be turned into a LGraph in time linear in the number
89 of nodes and O(N log N) in the number of basic blocks.
91 * Two AGraphs may be spliced in constant time by writing g1 <*> g2
93 There are two rules for splicing, depending on whether the left-hand
94 graph falls through. If it does, the rule is as follows:
101 | X | <*> | Y | = | X |
119 And in the case where the left-hand graph does not fall through, the
128 | X | <*> | Y | = | X |
142 In this case C will become unreachable and is lost; when such a graph
143 is converted into a data structure, the system will bleat about
144 unreachable code. Also it must be assumed that there are branches
145 from somewhere in X to labelled blocks in Y; otherwise Y and D are
146 unreachable as well. (However, it may be the case that X branches
147 into some third AGraph, which in turn branches into D; the
148 representation is agnostic on this point.)
153 (<*>) :: AGraph m l -> AGraph m l -> AGraph m l
155 -- | A graph is built up by splicing together graphs each containing a
156 -- single node (where a label is considered a 'first' node. The empty
157 -- graph is a left and right unit for splicing. All of the AGraph
158 -- constructors (even complex ones like 'mkIfThenElse', as well as the
159 -- splicing operation <*>, are constant-time operations.
161 emptyAGraph :: AGraph m l
162 mkLabel :: LastNode l =>
163 BlockId -> AGraph m l -- graph contains the label
164 mkMiddle :: m -> AGraph m l -- graph contains the node
165 mkLast :: (Outputable m, Outputable l, LastNode l) =>
166 l -> AGraph m l -- graph contains the node
168 -- | This function provides access to fresh labels without requiring
169 -- clients to be programmed monadically.
170 withFreshLabel :: String -> (BlockId -> AGraph m l) -> AGraph m l
171 withUnique :: (Unique -> AGraph m l) -> AGraph m l
174 outOfLine :: (LastNode l, Outputable m, Outputable l)
175 => AGraph m l -> AGraph m l
176 -- ^ The argument is an AGraph that has an
177 -- empty entry sequence and no exit sequence.
178 -- The result is a new AGraph that has an empty entry sequence
179 -- connected to an empty exit sequence, with the original graph
180 -- sitting to the side out-of-line.
182 -- Example: mkMiddle (x = 3)
183 -- <*> outOfLine (mkLabel L <*> ...stuff...)
184 -- <*> mkMiddle (y = x)
185 -- Control will flow directly from x=3 to y=x;
186 -- the block starting with L is "on the side".
188 -- N.B. algebraically forall g g' : g <*> outOfLine g' == outOfLine g' <*> g
192 -- below for convenience
193 mkMiddles :: [m] -> AGraph m l
194 mkZTail :: (Outputable m, Outputable l, LastNode l) => ZTail m l -> AGraph m l
195 mkBranch :: (Outputable m, Outputable l, LastNode l) => BlockId -> AGraph m l
197 -- | For the structured control-flow constructs, a condition is
198 -- represented as a function that takes as arguments the labels to
199 -- goto on truth or falsehood.
201 -- mkIfThenElse mk_cond then else
202 -- = (mk_cond L1 L2) <*> L1: then <*> goto J
203 -- <*> L2: else <*> goto J
206 -- where L1, L2, J are fresh
208 mkIfThenElse :: (Outputable m, Outputable l, LastNode l)
209 => (BlockId -> BlockId -> AGraph m l) -- branch condition
210 -> AGraph m l -- code in the 'then' branch
211 -> AGraph m l -- code in the 'else' branch
212 -> AGraph m l -- resulting if-then-else construct
214 mkWhileDo :: (Outputable m, Outputable l, LastNode l)
215 => (BlockId -> BlockId -> AGraph m l) -- loop condition
216 -> AGraph m l -- body of the bloop
217 -> AGraph m l -- the final while loop
219 -- | Converting an abstract graph to a concrete form is expensive: the
220 -- cost is linear in the number of nodes in the answer, plus N log N
221 -- in the number of basic blocks. The conversion is also monadic
222 -- because it may require the allocation of fresh, unique labels.
224 graphOfAGraph :: AGraph m l -> UniqSM (Graph m l)
225 lgraphOfAGraph :: AGraph m l -> UniqSM (LGraph m l)
226 -- ^ allocate a fresh label for the entry point
227 labelAGraph :: BlockId -> AGraph m l -> UniqSM (LGraph m l)
228 -- ^ use the given BlockId as the label of the entry point
231 -- | The functions below build Graphs directly; for convenience, they
232 -- are included here with the rest of the constructor functions.
234 emptyGraph :: Graph m l
235 graphOfMiddles :: [m] -> Graph m l
236 graphOfZTail :: ZTail m l -> Graph m l
239 -- ================================================================
241 -- ================================================================
243 newtype AGraph m l = AGraph (Graph m l -> UniqSM (Graph m l))
244 -- an AGraph is a monadic function from a successor Graph to a new Graph
246 AGraph f1 <*> AGraph f2 = AGraph f
247 where f g = f2 g >>= f1 -- note right associativity
249 emptyAGraph = AGraph return
251 graphOfAGraph (AGraph f) = f emptyGraph
252 emptyGraph = Graph (ZLast LastExit) emptyBlockEnv
255 do Graph tail blocks <- graphOfAGraph g
256 return $ LGraph id $ insertBlock (Block id tail) blocks
258 lgraphOfAGraph g = do id <- freshBlockId "graph entry"
261 -------------------------------------
264 mkLabel id = AGraph f
265 where f (Graph tail blocks) =
266 return $ Graph (ZLast (mkBranchNode id))
267 (insertBlock (Block id tail) blocks)
269 mkBranch target = mkLast $ mkBranchNode target
271 mkMiddle m = AGraph f
272 where f (Graph tail blocks) = return $ Graph (ZTail m tail) blocks
274 mkMiddles ms = AGraph f
275 where f (Graph tail blocks) = return $ Graph (foldr ZTail tail ms) blocks
277 graphOfMiddles ms = Graph (foldr ZTail (ZLast LastExit) ms) emptyBlockEnv
278 graphOfZTail t = Graph t emptyBlockEnv
282 where f (Graph tail blocks) =
283 do note_this_code_becomes_unreachable tail
284 return $ Graph (ZLast (LastOther l)) blocks
286 mkZTail tail = AGraph f
287 where f (Graph utail blocks) =
288 do note_this_code_becomes_unreachable utail
289 return $ Graph tail blocks
291 withFreshLabel name ofId = AGraph f
292 where f g = do id <- freshBlockId name
293 let AGraph f' = ofId id
296 withUnique ofU = AGraph f
297 where f g = do u <- getUniqueUs
298 let AGraph f' = ofU u
301 outOfLine (AGraph f) = AGraph f'
302 where f' (Graph tail' blocks') =
303 do Graph emptyEntrance blocks <- f emptyGraph
304 note_this_code_becomes_unreachable emptyEntrance
305 return $ Graph tail' (blocks `plusUFM` blocks')
308 mkIfThenElse cbranch tbranch fbranch =
309 withFreshLabel "end of if" $ \endif ->
310 withFreshLabel "start of then" $ \tid ->
311 withFreshLabel "start of else" $ \fid ->
313 mkLabel tid <*> tbranch <*> mkBranch endif <*>
314 mkLabel fid <*> fbranch <*> mkLabel endif
317 mkWhileDo cbranch body =
318 withFreshLabel "loop test" $ \test ->
319 withFreshLabel "loop head" $ \head ->
320 withFreshLabel "end while" $ \endwhile ->
321 -- Forrest Baskett's while-loop layout
322 mkBranch test <*> mkLabel head <*> body <*> mkLabel test
323 <*> cbranch head endwhile <*> mkLabel endwhile
326 -- | Bleat if the insertion of a last node will create unreachable code
327 note_this_code_becomes_unreachable ::
328 (Monad m, LastNode l, Outputable middle, Outputable l) => ZTail middle l -> m ()
331 note_this_code_becomes_unreachable = u
332 where u (ZLast LastExit) = return ()
333 u (ZLast (LastOther l)) | isBranchNode l = return ()
334 -- Note [Branch follows branch]
335 u tail = fail ("unreachable code: " ++ showSDoc (ppr tail))
337 note_this_code_becomes_unreachable _ = return ()
341 Note [Branch follows branch]
342 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
343 Why do we say it's ok for a Branch to follow a Branch?
344 Because the standard constructor mkLabel-- has fall-through
345 semantics. So if you do a mkLabel, you finish the current block,
346 giving it a label, and start a new one that branches to that label.
347 Emitting a Branch at this point is fine:
348 goto L1; L2: ...stuff...