1 {-# LANGUAGE ScopedTypeVariables #-}
3 ( AGraph, (<*>), catAGraphs
4 , emptyAGraph, withFreshLabel, withUnique
5 , mkMiddle, mkMiddles, mkLast, mkZTail, mkBranch, mkLabel, mkIfThenElse, mkWhileDo
7 , emptyGraph, graphOfMiddles, graphOfZTail
8 , lgraphOfAGraph, graphOfAGraph, labelAGraph
20 import Prelude hiding (zip, unzip, last)
22 #include "HsVersions.h"
24 -------------------------------------------------------------------------
25 -- GENERIC ZIPPER-BASED CONTROL-FLOW GRAPH (CONSTRUCTOR VIEW) --
26 -------------------------------------------------------------------------
30 You can think of an AGraph like this: it is the program built by
31 composing in sequence three kinds of nodes:
32 * Label nodes (e.g. L2:)
33 * Middle nodes (e.g. x = y*3)
34 * Last nodes (e.g. if b then goto L1 else goto L2)
36 The constructors mkLabel, mkMiddle, and mkLast build single-node
37 AGraphs of the indicated type. The composition operator <*> glues
38 AGraphs together in sequence (in constant time).
44 if x<10 then goto L1 else goto L2
49 Notice that the AGraph may begin without a label, and may end without
50 a control transfer. Control *always* falls through a label and middle
51 node, and *never* falls through a Last node.
53 A 'AGraph m l' is simply an abstract version of a 'Graph m l' from
54 module 'ZipCfg'. The only difference is that the 'AGraph m l'
55 supports a constant-time splicing operation, written infix <*>.
56 That splicing operation, together with the constructor functions in
57 this module (and with 'labelAGraph'), is the recommended way to build
58 large graphs. Each construction or splice has constant cost, and to
59 turn an AGraph into a Graph requires time linear in the number of
60 nodes and N log N in the number of basic blocks.
62 The splicing operation warrants careful explanation. Like a Graph, an
63 AGraph is a control-flow graph which begins with a distinguished,
64 unlabelled sequence of middle nodes called the *entry*. An unlabelled
65 graph may also end with a sequence of middle nodes called the *exit*.
66 The entry may fall straight through to the exit, or it may fall into
67 the rest of the graph, which may include arbitrary control flow.
69 Using ASCII art, here are examples of the two kinds of graph. On the
70 left, the entry and exit sequences are labelled A and B, where the
71 control flow in the middle is labelled X. On the right, there is no
87 The AGraph has these properties:
89 * A AGraph is opaque; nothing about its structure can be observed.
91 * A AGraph may be turned into a LGraph in time linear in the number
92 of nodes and O(N log N) in the number of basic blocks.
94 * Two AGraphs may be spliced in constant time by writing g1 <*> g2
96 There are two rules for splicing, depending on whether the left-hand
97 graph falls through. If it does, the rule is as follows:
104 | X | <*> | Y | = | X |
122 And in the case where the left-hand graph does not fall through, the
131 | X | <*> | Y | = | X |
145 In this case C will become unreachable and is lost; when such a graph
146 is converted into a data structure, the system will bleat about
147 unreachable code. Also it must be assumed that there are branches
148 from somewhere in X to labelled blocks in Y; otherwise Y and D are
149 unreachable as well. (However, it may be the case that X branches
150 into some third AGraph, which in turn branches into D; the
151 representation is agnostic on this point.)
156 (<*>) :: AGraph m l -> AGraph m l -> AGraph m l
158 catAGraphs :: [AGraph m l] -> AGraph m l
160 -- | A graph is built up by splicing together graphs each containing a
161 -- single node (where a label is considered a 'first' node. The empty
162 -- graph is a left and right unit for splicing. All of the AGraph
163 -- constructors (even complex ones like 'mkIfThenElse', as well as the
164 -- splicing operation <*>, are constant-time operations.
166 emptyAGraph :: AGraph m l
167 mkLabel :: LastNode l =>
168 BlockId -> AGraph m l -- graph contains the label
169 mkMiddle :: m -> AGraph m l -- graph contains the node
170 mkLast :: (Outputable m, Outputable l, LastNode l) =>
171 l -> AGraph m l -- graph contains the node
173 -- | This function provides access to fresh labels without requiring
174 -- clients to be programmed monadically.
175 withFreshLabel :: String -> (BlockId -> AGraph m l) -> AGraph m l
176 withUnique :: (Unique -> AGraph m l) -> AGraph m l
179 outOfLine :: (LastNode l, Outputable m, Outputable l)
180 => AGraph m l -> AGraph m l
181 -- ^ The argument is an AGraph that has an
182 -- empty entry sequence and no exit sequence.
183 -- The result is a new AGraph that has an empty entry sequence
184 -- connected to an empty exit sequence, with the original graph
185 -- sitting to the side out-of-line.
187 -- Example: mkMiddle (x = 3)
188 -- <*> outOfLine (mkLabel L <*> ...stuff...)
189 -- <*> mkMiddle (y = x)
190 -- Control will flow directly from x=3 to y=x;
191 -- the block starting with L is "on the side".
193 -- N.B. algebraically forall g g' : g <*> outOfLine g' == outOfLine g' <*> g
197 -- below for convenience
198 mkMiddles :: [m] -> AGraph m l
199 mkZTail :: (Outputable m, Outputable l, LastNode l) => ZTail m l -> AGraph m l
200 mkBranch :: (Outputable m, Outputable l, LastNode l) => BlockId -> AGraph m l
202 -- | For the structured control-flow constructs, a condition is
203 -- represented as a function that takes as arguments the labels to
204 -- goto on truth or falsehood.
206 -- mkIfThenElse mk_cond then else
207 -- = (mk_cond L1 L2) <*> L1: then <*> goto J
208 -- <*> L2: else <*> goto J
211 -- where L1, L2, J are fresh
213 mkIfThenElse :: (Outputable m, Outputable l, LastNode l)
214 => (BlockId -> BlockId -> AGraph m l) -- branch condition
215 -> AGraph m l -- code in the 'then' branch
216 -> AGraph m l -- code in the 'else' branch
217 -> AGraph m l -- resulting if-then-else construct
219 mkWhileDo :: (Outputable m, Outputable l, LastNode l)
220 => (BlockId -> BlockId -> AGraph m l) -- loop condition
221 -> AGraph m l -- body of the bloop
222 -> AGraph m l -- the final while loop
224 -- | Converting an abstract graph to a concrete form is expensive: the
225 -- cost is linear in the number of nodes in the answer, plus N log N
226 -- in the number of basic blocks. The conversion is also monadic
227 -- because it may require the allocation of fresh, unique labels.
229 graphOfAGraph :: AGraph m l -> UniqSM (Graph m l)
230 lgraphOfAGraph :: AGraph m l -> UniqSM (LGraph m l)
231 -- ^ allocate a fresh label for the entry point
232 labelAGraph :: BlockId -> AGraph m l -> UniqSM (LGraph m l)
233 -- ^ use the given BlockId as the label of the entry point
236 -- | The functions below build Graphs directly; for convenience, they
237 -- are included here with the rest of the constructor functions.
239 emptyGraph :: Graph m l
240 graphOfMiddles :: [m] -> Graph m l
241 graphOfZTail :: ZTail m l -> Graph m l
244 -- ================================================================
246 -- ================================================================
248 newtype AGraph m l = AGraph (Graph m l -> UniqSM (Graph m l))
249 -- an AGraph is a monadic function from a successor Graph to a new Graph
251 AGraph f1 <*> AGraph f2 = AGraph f
252 where f g = f2 g >>= f1 -- note right associativity
254 catAGraphs = foldr (<*>) emptyAGraph
256 emptyAGraph = AGraph return
258 graphOfAGraph (AGraph f) = f emptyGraph
259 emptyGraph = Graph (ZLast LastExit) emptyBlockEnv
262 do Graph tail blocks <- graphOfAGraph g
263 return $ LGraph id $ insertBlock (Block id tail) blocks
265 lgraphOfAGraph g = do id <- freshBlockId "graph entry"
268 -------------------------------------
271 mkLabel id = AGraph f
272 where f (Graph tail blocks) =
273 return $ Graph (ZLast (mkBranchNode id))
274 (insertBlock (Block id tail) blocks)
276 mkBranch target = mkLast $ mkBranchNode target
278 mkMiddle m = AGraph f
279 where f (Graph tail blocks) = return $ Graph (ZTail m tail) blocks
281 mkMiddles ms = AGraph f
282 where f (Graph tail blocks) = return $ Graph (foldr ZTail tail ms) blocks
284 graphOfMiddles ms = Graph (foldr ZTail (ZLast LastExit) ms) emptyBlockEnv
285 graphOfZTail t = Graph t emptyBlockEnv
289 where f (Graph tail blocks) =
290 do note_this_code_becomes_unreachable tail
291 return $ Graph (ZLast (LastOther l)) blocks
293 mkZTail tail = AGraph f
294 where f (Graph utail blocks) =
295 do note_this_code_becomes_unreachable utail
296 return $ Graph tail blocks
298 withFreshLabel name ofId = AGraph f
299 where f g = do id <- freshBlockId name
300 let AGraph f' = ofId id
303 withUnique ofU = AGraph f
304 where f g = do u <- getUniqueUs
305 let AGraph f' = ofU u
308 outOfLine (AGraph f) = AGraph f'
309 where f' (Graph tail' blocks') =
310 do Graph emptyEntrance blocks <- f emptyGraph
311 note_this_code_becomes_unreachable emptyEntrance
312 return $ Graph tail' (blocks `plusUFM` blocks')
315 mkIfThenElse cbranch tbranch fbranch =
316 withFreshLabel "end of if" $ \endif ->
317 withFreshLabel "start of then" $ \tid ->
318 withFreshLabel "start of else" $ \fid ->
320 mkLabel tid <*> tbranch <*> mkBranch endif <*>
321 mkLabel fid <*> fbranch <*> mkLabel endif
324 mkWhileDo cbranch body =
325 withFreshLabel "loop test" $ \test ->
326 withFreshLabel "loop head" $ \head ->
327 withFreshLabel "end while" $ \endwhile ->
328 -- Forrest Baskett's while-loop layout
329 mkBranch test <*> mkLabel head <*> body <*> mkLabel test
330 <*> cbranch head endwhile <*> mkLabel endwhile
333 -- | Bleat if the insertion of a last node will create unreachable code
334 note_this_code_becomes_unreachable ::
335 (Monad m, LastNode l, Outputable middle, Outputable l) => ZTail middle l -> m ()
337 note_this_code_becomes_unreachable = if debugIsOn then u else \_ -> return ()
338 where u (ZLast LastExit) = return ()
339 u (ZLast (LastOther l)) | isBranchNode l = return ()
340 -- Note [Branch follows branch]
341 u tail = fail ("unreachable code: " ++ showSDoc (ppr tail))
344 Note [Branch follows branch]
345 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
346 Why do we say it's ok for a Branch to follow a Branch?
347 Because the standard constructor mkLabel-- has fall-through
348 semantics. So if you do a mkLabel, you finish the current block,
349 giving it a label, and start a new one that branches to that label.
350 Emitting a Branch at this point is fine:
351 goto L1; L2: ...stuff...
355 -- | The string argument to 'freshBlockId' was originally helpful in debugging
356 -- the Quick C-- compiler, so I have kept it here even though at present it is
357 -- thrown away at this spot---there's no reason a BlockId couldn't one day carry
360 freshBlockId :: String -> UniqSM BlockId
361 freshBlockId _ = do { u <- getUniqueUs; return $ BlockId u }