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)
20 #include "HsVersions.h"
22 -------------------------------------------------------------------------
23 -- GENERIC ZIPPER-BASED CONTROL-FLOW GRAPH (CONSTRUCTOR VIEW) --
24 -------------------------------------------------------------------------
28 You can think of an AGraph like this: it is the program built by
29 composing in sequence three kinds of nodes:
30 * Label nodes (e.g. L2:)
31 * Middle nodes (e.g. x = y*3)
32 * Last nodes (e.g. if b then goto L1 else goto L2)
34 The constructors mkLabel, mkMiddle, and mkLast build single-node
35 AGraphs of the indicated type. The composition operator <*> glues
36 AGraphs together in sequence (in constant time).
42 if x<10 then goto L1 else goto L2
47 Notice that the AGraph may begin without a label, and may end without
48 a control transfer. Control *always* falls through a label and middle
49 node, and *never* falls through a Last node.
51 A 'AGraph m l' is simply an abstract version of a 'Graph m l' from
52 module 'ZipCfg'. The only difference is that the 'AGraph m l'
53 supports a constant-time splicing operation, written infix <*>.
54 That splicing operation, together with the constructor functions in
55 this module (and with 'labelAGraph'), is the recommended way to build
56 large graphs. Each construction or splice has constant cost, and to
57 turn an AGraph into a Graph requires time linear in the number of
58 nodes and N log N in the number of basic blocks.
60 The splicing operation warrants careful explanation. Like a Graph, an
61 AGraph is a control-flow graph which begins with a distinguished,
62 unlabelled sequence of middle nodes called the *entry*. An unlabelled
63 graph may also end with a sequence of middle nodes called the *exit*.
64 The entry may fall straight through to the exit, or it may fall into
65 the rest of the graph, which may include arbitrary control flow.
67 Using ASCII art, here are examples of the two kinds of graph. On the
68 left, the entry and exit sequences are labelled A and B, where the
69 control flow in the middle is labelled X. On the right, there is no
85 The AGraph has these properties:
87 * A AGraph is opaque; nothing about its structure can be observed.
89 * A AGraph may be turned into a LGraph in time linear in the number
90 of nodes and O(N log N) in the number of basic blocks.
92 * Two AGraphs may be spliced in constant time by writing g1 <*> g2
94 There are two rules for splicing, depending on whether the left-hand
95 graph falls through. If it does, the rule is as follows:
102 | X | <*> | Y | = | X |
120 And in the case where the left-hand graph does not fall through, the
129 | X | <*> | Y | = | X |
143 In this case C will become unreachable and is lost; when such a graph
144 is converted into a data structure, the system will bleat about
145 unreachable code. Also it must be assumed that there are branches
146 from somewhere in X to labelled blocks in Y; otherwise Y and D are
147 unreachable as well. (However, it may be the case that X branches
148 into some third AGraph, which in turn branches into D; the
149 representation is agnostic on this point.)
154 (<*>) :: AGraph m l -> AGraph m l -> AGraph m l
156 -- | A graph is built up by splicing together graphs each containing a
157 -- single node (where a label is considered a 'first' node. The empty
158 -- graph is a left and right unit for splicing. All of the AGraph
159 -- constructors (even complex ones like 'mkIfThenElse', as well as the
160 -- splicing operation <*>, are constant-time operations.
162 emptyAGraph :: AGraph m l
163 mkLabel :: LastNode l =>
164 BlockId -> AGraph m l -- graph contains the label
165 mkMiddle :: m -> AGraph m l -- graph contains the node
166 mkLast :: (Outputable m, Outputable l, LastNode l) =>
167 l -> AGraph m l -- graph contains the node
169 -- | This function provides access to fresh labels without requiring
170 -- clients to be programmed monadically.
171 withFreshLabel :: String -> (BlockId -> AGraph m l) -> AGraph m l
172 withUnique :: (Unique -> AGraph m l) -> AGraph m l
175 outOfLine :: (LastNode l, Outputable m, Outputable l)
176 => AGraph m l -> AGraph m l
177 -- ^ The argument is an AGraph that has an
178 -- empty entry sequence and no exit sequence.
179 -- The result is a new AGraph that has an empty entry sequence
180 -- connected to an empty exit sequence, with the original graph
181 -- sitting to the side out-of-line.
183 -- Example: mkMiddle (x = 3)
184 -- <*> outOfLine (mkLabel L <*> ...stuff...)
185 -- <*> mkMiddle (y = x)
186 -- Control will flow directly from x=3 to y=x;
187 -- the block starting with L is "on the side".
189 -- N.B. algebraically forall g g' : g <*> outOfLine g' == outOfLine g' <*> g
193 -- below for convenience
194 mkMiddles :: [m] -> AGraph m l
195 mkZTail :: (Outputable m, Outputable l, LastNode l) => ZTail m l -> AGraph m l
196 mkBranch :: (Outputable m, Outputable l, LastNode l) => BlockId -> AGraph m l
198 -- | For the structured control-flow constructs, a condition is
199 -- represented as a function that takes as arguments the labels to
200 -- goto on truth or falsehood.
202 -- mkIfThenElse mk_cond then else
203 -- = (mk_cond L1 L2) <*> L1: then <*> goto J
204 -- <*> L2: else <*> goto J
207 -- where L1, L2, J are fresh
209 mkIfThenElse :: (Outputable m, Outputable l, LastNode l)
210 => (BlockId -> BlockId -> AGraph m l) -- branch condition
211 -> AGraph m l -- code in the 'then' branch
212 -> AGraph m l -- code in the 'else' branch
213 -> AGraph m l -- resulting if-then-else construct
215 mkWhileDo :: (Outputable m, Outputable l, LastNode l)
216 => (BlockId -> BlockId -> AGraph m l) -- loop condition
217 -> AGraph m l -- body of the bloop
218 -> AGraph m l -- the final while loop
220 -- | Converting an abstract graph to a concrete form is expensive: the
221 -- cost is linear in the number of nodes in the answer, plus N log N
222 -- in the number of basic blocks. The conversion is also monadic
223 -- because it may require the allocation of fresh, unique labels.
225 graphOfAGraph :: AGraph m l -> UniqSM (Graph m l)
226 lgraphOfAGraph :: AGraph m l -> UniqSM (LGraph m l)
227 -- ^ allocate a fresh label for the entry point
228 labelAGraph :: BlockId -> AGraph m l -> UniqSM (LGraph m l)
229 -- ^ use the given BlockId as the label of the entry point
232 -- | The functions below build Graphs directly; for convenience, they
233 -- are included here with the rest of the constructor functions.
235 emptyGraph :: Graph m l
236 graphOfMiddles :: [m] -> Graph m l
237 graphOfZTail :: ZTail m l -> Graph m l
240 -- ================================================================
242 -- ================================================================
244 newtype AGraph m l = AGraph (Graph m l -> UniqSM (Graph m l))
245 -- an AGraph is a monadic function from a successor Graph to a new Graph
247 AGraph f1 <*> AGraph f2 = AGraph f
248 where f g = f2 g >>= f1 -- note right associativity
250 emptyAGraph = AGraph return
252 graphOfAGraph (AGraph f) = f emptyGraph
253 emptyGraph = Graph (ZLast LastExit) emptyBlockEnv
256 do Graph tail blocks <- graphOfAGraph g
257 return $ LGraph id $ insertBlock (Block id tail) blocks
259 lgraphOfAGraph g = do id <- freshBlockId "graph entry"
262 -------------------------------------
265 mkLabel id = AGraph f
266 where f (Graph tail blocks) =
267 return $ Graph (ZLast (mkBranchNode id))
268 (insertBlock (Block id tail) blocks)
270 mkBranch target = mkLast $ mkBranchNode target
272 mkMiddle m = AGraph f
273 where f (Graph tail blocks) = return $ Graph (ZTail m tail) blocks
275 mkMiddles ms = AGraph f
276 where f (Graph tail blocks) = return $ Graph (foldr ZTail tail ms) blocks
278 graphOfMiddles ms = Graph (foldr ZTail (ZLast LastExit) ms) emptyBlockEnv
279 graphOfZTail t = Graph t emptyBlockEnv
283 where f (Graph tail blocks) =
284 do note_this_code_becomes_unreachable tail
285 return $ Graph (ZLast (LastOther l)) blocks
287 mkZTail tail = AGraph f
288 where f (Graph utail blocks) =
289 do note_this_code_becomes_unreachable utail
290 return $ Graph tail blocks
292 withFreshLabel name ofId = AGraph f
293 where f g = do id <- freshBlockId name
294 let AGraph f' = ofId id
297 withUnique ofU = AGraph f
298 where f g = do u <- getUniqueUs
299 let AGraph f' = ofU u
302 outOfLine (AGraph f) = AGraph f'
303 where f' (Graph tail' blocks') =
304 do Graph emptyEntrance blocks <- f emptyGraph
305 note_this_code_becomes_unreachable emptyEntrance
306 return $ Graph tail' (blocks `plusUFM` blocks')
309 mkIfThenElse cbranch tbranch fbranch =
310 withFreshLabel "end of if" $ \endif ->
311 withFreshLabel "start of then" $ \tid ->
312 withFreshLabel "start of else" $ \fid ->
314 mkLabel tid <*> tbranch <*> mkBranch endif <*>
315 mkLabel fid <*> fbranch <*> mkLabel endif
318 mkWhileDo cbranch body =
319 withFreshLabel "loop test" $ \test ->
320 withFreshLabel "loop head" $ \head ->
321 withFreshLabel "end while" $ \endwhile ->
322 -- Forrest Baskett's while-loop layout
323 mkBranch test <*> mkLabel head <*> body <*> mkLabel test
324 <*> cbranch head endwhile <*> mkLabel endwhile
327 -- | Bleat if the insertion of a last node will create unreachable code
328 note_this_code_becomes_unreachable ::
329 (Monad m, LastNode l, Outputable middle, Outputable l) => ZTail middle l -> m ()
331 note_this_code_becomes_unreachable = if debugIsOn then u else \_ -> return ()
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))
338 Note [Branch follows branch]
339 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
340 Why do we say it's ok for a Branch to follow a Branch?
341 Because the standard constructor mkLabel-- has fall-through
342 semantics. So if you do a mkLabel, you finish the current block,
343 giving it a label, and start a new one that branches to that label.
344 Emitting a Branch at this point is fine:
345 goto L1; L2: ...stuff...
348 _unused :: FS.FastString