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