1 {-# LANGUAGE ScopedTypeVariables #-}
3 ( AGraph, (<*>), catAGraphs
5 , emptyAGraph, withFreshLabel, withUnique
6 , mkMiddle, mkMiddles, mkLast, mkZTail, mkBranch, mkLabel, mkIfThenElse, mkWhileDo
8 , emptyGraph, graphOfMiddles, graphOfZTail
9 , lgraphOfAGraph, graphOfAGraph, labelAGraph, pprAGraph
13 import BlockId (BlockId(..), emptyBlockEnv, plusBlockEnv)
21 import Prelude hiding (zip, unzip, last)
23 #include "HsVersions.h"
25 -------------------------------------------------------------------------
26 -- GENERIC ZIPPER-BASED CONTROL-FLOW GRAPH (CONSTRUCTOR VIEW) --
27 -------------------------------------------------------------------------
31 You can think of an AGraph like this: it is the program built by
32 composing in sequence three kinds of nodes:
33 * Label nodes (e.g. L2:)
34 * Middle nodes (e.g. x = y*3)
35 * Last nodes (e.g. if b then goto L1 else goto L2)
37 The constructors mkLabel, mkMiddle, and mkLast build single-node
38 AGraphs of the indicated type. The composition operator <*> glues
39 AGraphs together in sequence (in constant time).
45 if x<10 then goto L1 else goto L2
50 Notice that the AGraph may begin without a label, and may end without
51 a control transfer. Control *always* falls through a label and middle
52 node, and *never* falls through a Last node.
54 A 'AGraph m l' is simply an abstract version of a 'Graph m l' from
55 module 'ZipCfg'. The only difference is that the 'AGraph m l'
56 supports a constant-time splicing operation, written infix <*>.
57 That splicing operation, together with the constructor functions in
58 this module (and with 'labelAGraph'), is the recommended way to build
59 large graphs. Each construction or splice has constant cost, and to
60 turn an AGraph into a Graph requires time linear in the number of
61 nodes and N log N in the number of basic blocks.
63 The splicing operation warrants careful explanation. Like a Graph, an
64 AGraph is a control-flow graph which begins with a distinguished,
65 unlabelled sequence of middle nodes called the *entry*. An unlabelled
66 graph may also end with a sequence of middle nodes called the *exit*.
67 The entry may fall straight through to the exit, or it may fall into
68 the rest of the graph, which may include arbitrary control flow.
70 Using ASCII art, here are examples of the two kinds of graph. On the
71 left, the entry and exit sequences are labelled A and B, where the
72 control flow in the middle is labelled X. On the right, there is no
88 The AGraph has these properties:
90 * A AGraph is opaque; nothing about its structure can be observed.
92 * A AGraph may be turned into a LGraph in time linear in the number
93 of nodes and O(N log N) in the number of basic blocks.
95 * Two AGraphs may be spliced in constant time by writing g1 <*> g2
97 There are two rules for splicing, depending on whether the left-hand
98 graph falls through. If it does, the rule is as follows:
105 | X | <*> | Y | = | X |
123 And in the case where the left-hand graph does not fall through, the
132 | X | <*> | Y | = | X |
146 In this case C will become unreachable and is lost; when such a graph
147 is converted into a data structure, the system will bleat about
148 unreachable code. Also it must be assumed that there are branches
149 from somewhere in X to labelled blocks in Y; otherwise Y and D are
150 unreachable as well. (However, it may be the case that X branches
151 into some third AGraph, which in turn branches into D; the
152 representation is agnostic on this point.)
157 (<*>) :: AGraph m l -> AGraph m l -> AGraph m l
159 catAGraphs :: [AGraph m l] -> AGraph m l
161 -- | A graph is built up by splicing together graphs each containing a
162 -- single node (where a label is considered a 'first' node. The empty
163 -- graph is a left and right unit for splicing. All of the AGraph
164 -- constructors (even complex ones like 'mkIfThenElse', as well as the
165 -- splicing operation <*>, are constant-time operations.
167 emptyAGraph :: AGraph m l
168 mkLabel :: (LastNode l) =>
169 BlockId -> StackInfo -> AGraph m l -- graph contains the label
170 mkMiddle :: m -> AGraph m l -- graph contains the node
171 mkLast :: (Outputable m, Outputable l, LastNode l) =>
172 l -> AGraph m l -- graph contains the node
174 -- | This function provides access to fresh labels without requiring
175 -- clients to be programmed monadically.
176 withFreshLabel :: String -> (BlockId -> AGraph m l) -> AGraph m l
177 withUnique :: (Unique -> AGraph m l) -> AGraph m l
180 outOfLine :: (LastNode l, Outputable m, Outputable l)
181 => AGraph m l -> AGraph m l
182 -- ^ The argument is an AGraph that has an
183 -- empty entry sequence and no exit sequence.
184 -- The result is a new AGraph that has an empty entry sequence
185 -- connected to an empty exit sequence, with the original graph
186 -- sitting to the side out-of-line.
188 -- Example: mkMiddle (x = 3)
189 -- <*> outOfLine (mkLabel L <*> ...stuff...)
190 -- <*> mkMiddle (y = x)
191 -- Control will flow directly from x=3 to y=x;
192 -- the block starting with L is "on the side".
194 -- N.B. algebraically forall g g' : g <*> outOfLine g' == outOfLine g' <*> g
198 -- below for convenience
199 mkMiddles :: [m] -> AGraph m l
200 mkZTail :: (Outputable m, Outputable l, LastNode l) =>
201 ZTail m l -> AGraph m l
202 mkBranch :: (Outputable m, Outputable l, LastNode l) =>
203 BlockId -> AGraph m l
205 -- | For the structured control-flow constructs, a condition is
206 -- represented as a function that takes as arguments the labels to
207 -- goto on truth or falsehood.
209 -- mkIfThenElse mk_cond then else
210 -- = (mk_cond L1 L2) <*> L1: then <*> goto J
211 -- <*> L2: else <*> goto J
214 -- where L1, L2, J are fresh
216 mkIfThenElse :: (Outputable m, Outputable l, LastNode l)
217 => (BlockId -> BlockId -> AGraph m l) -- branch condition
218 -> AGraph m l -- code in the 'then' branch
219 -> AGraph m l -- code in the 'else' branch
220 -> AGraph m l -- resulting if-then-else construct
222 mkWhileDo :: (Outputable m, Outputable l, LastNode l)
223 => (BlockId -> BlockId -> AGraph m l) -- loop condition
224 -> AGraph m l -- body of the bloop
225 -> AGraph m l -- the final while loop
227 -- | Converting an abstract graph to a concrete form is expensive: the
228 -- cost is linear in the number of nodes in the answer, plus N log N
229 -- in the number of basic blocks. The conversion is also monadic
230 -- because it may require the allocation of fresh, unique labels.
232 graphOfAGraph :: AGraph m l -> UniqSM (Graph m l)
233 lgraphOfAGraph :: Int -> AGraph m l -> UniqSM (LGraph m l)
234 -- ^ allocate a fresh label for the entry point
235 labelAGraph :: BlockId -> Int -> AGraph m l -> UniqSM (LGraph m l)
236 -- ^ use the given BlockId as the label of the entry point
239 -- | The functions below build Graphs directly; for convenience, they
240 -- are included here with the rest of the constructor functions.
242 emptyGraph :: Graph m l
243 graphOfMiddles :: [m] -> Graph m l
244 graphOfZTail :: ZTail m l -> Graph m l
247 -- ================================================================
249 -- ================================================================
251 newtype AGraph m l = AGraph (Graph m l -> UniqSM (Graph m l))
252 -- an AGraph is a monadic function from a successor Graph to a new Graph
254 AGraph f1 <*> AGraph f2 = AGraph f
255 where f g = f2 g >>= f1 -- note right associativity
257 catAGraphs = foldr (<*>) emptyAGraph
259 emptyAGraph = AGraph return
261 graphOfAGraph (AGraph f) = f emptyGraph
262 emptyGraph = Graph (ZLast LastExit) emptyBlockEnv
264 labelAGraph id args g =
265 do Graph tail blocks <- graphOfAGraph g
266 return $ LGraph id args $ insertBlock (Block id stackInfo tail) blocks
267 where stackInfo = StackInfo Nothing Nothing
269 lgraphOfAGraph args g = do id <- freshBlockId "graph entry"
270 labelAGraph id args g
272 -------------------------------------
275 mkLabel id args = AGraph f
276 where f (Graph tail blocks) =
277 return $ Graph (ZLast (mkBranchNode id))
278 (insertBlock (Block id args tail) blocks)
280 mkBranch target = mkLast $ mkBranchNode target
282 mkMiddle m = AGraph f
283 where f (Graph tail blocks) = return $ Graph (ZTail m tail) blocks
285 mkMiddles ms = AGraph f
286 where f (Graph tail blocks) = return $ Graph (foldr ZTail tail ms) blocks
288 graphOfMiddles ms = Graph (foldr ZTail (ZLast LastExit) ms) emptyBlockEnv
289 graphOfZTail t = Graph t emptyBlockEnv
293 where f (Graph tail blocks) =
294 do note_this_code_becomes_unreachable "mkLast" (ppr l <+> ppr blocks) tail
295 return $ Graph (ZLast (LastOther l)) blocks
297 mkZTail tail = AGraph f
298 where f (Graph utail blocks) =
299 do note_this_code_becomes_unreachable "mkZTail" (ppr tail) utail
300 return $ Graph tail blocks
302 withFreshLabel name ofId = AGraph f
303 where f g = do id <- freshBlockId name
304 let AGraph f' = ofId id
307 withUnique ofU = AGraph f
308 where f g = do u <- getUniqueM
309 let AGraph f' = ofU u
312 outOfLine (AGraph f) = AGraph f'
313 where f' (Graph tail' blocks') =
314 do Graph emptyEntrance blocks <- f emptyGraph
315 note_this_code_becomes_unreachable "outOfLine" (ppr tail') emptyEntrance
316 return $ Graph tail' (blocks `plusBlockEnv` blocks')
318 mkIfThenElse cbranch tbranch fbranch =
319 withFreshLabel "end of if" $ \endif ->
320 withFreshLabel "start of then" $ \tid ->
321 withFreshLabel "start of else" $ \fid ->
323 mkLabel tid emptyStackInfo <*> tbranch <*> mkBranch endif <*>
324 mkLabel fid emptyStackInfo <*> fbranch <*>
325 mkLabel endif emptyStackInfo
327 mkWhileDo cbranch body =
328 withFreshLabel "loop test" $ \test ->
329 withFreshLabel "loop head" $ \head ->
330 withFreshLabel "end while" $ \endwhile ->
331 -- Forrest Baskett's while-loop layout
332 mkBranch test <*> mkLabel head emptyStackInfo <*> body
333 <*> mkLabel test emptyStackInfo <*> cbranch head endwhile
334 <*> mkLabel endwhile emptyStackInfo
336 -- | Bleat if the insertion of a last node will create unreachable code
337 note_this_code_becomes_unreachable ::
338 (Monad m, LastNode l, Outputable middle, Outputable l) =>
339 String -> SDoc -> ZTail middle l -> m ()
341 note_this_code_becomes_unreachable str old = if debugIsOn then u else \_ -> return ()
342 where u (ZLast LastExit) = return ()
343 u (ZLast (LastOther l)) | isBranchNode l = return ()
344 -- Note [Branch follows branch]
345 u tail = fail ("unreachable code in " ++ str ++ ": " ++
346 (showSDoc ((ppr tail) <+> old)))
348 -- | The string argument to 'freshBlockId' was originally helpful in debugging
349 -- the Quick C-- compiler, so I have kept it here even though at present it is
350 -- thrown away at this spot---there's no reason a BlockId couldn't one day carry
353 freshBlockId :: MonadUnique m => String -> m BlockId
354 freshBlockId _s = getUniqueM >>= return . BlockId
356 -------------------------------------
359 pprAGraph :: (Outputable m, LastNode l, Outputable l) => AGraph m l -> UniqSM SDoc
360 pprAGraph g = graphOfAGraph g >>= return . ppr
363 Note [Branch follows branch]
364 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
365 Why do we say it's ok for a Branch to follow a Branch?
366 Because the standard constructor mkLabel-- has fall-through
367 semantics. So if you do a mkLabel, you finish the current block,
368 giving it a label, and start a new one that branches to that label.
369 Emitting a Branch at this point is fine:
370 goto L1; L2: ...stuff...