1 {-# LANGUAGE ScopedTypeVariables #-}
2 {-# OPTIONS -Wall -fno-warn-name-shadowing #-}
4 ( AGraph, (<*>), emptyAGraph, withFreshLabel
5 , mkMiddle, mkMiddles, mkLast, mkZTail, mkBranch, mkLabel, mkIfThenElse, mkWhileDo
6 , emptyGraph, graphOfMiddles, graphOfZTail
7 , lgraphOfAGraph, graphOfAGraph, labelAGraph
12 import Prelude hiding (zip, unzip, last)
16 -------------------------------------------------------------------------
17 -- GENERIC ZIPPER-BASED CONTROL-FLOW GRAPH (CONSTRUCTOR VIEW) --
18 -------------------------------------------------------------------------
22 You can think of an AGraph like this: it is the program built by
23 composing in sequence three kinds of nodes:
24 * Label nodes (e.g. L2:)
25 * Middle nodes (e.g. x = y*3)
26 * Last nodes (e.g. if b then goto L1 else goto L2)
28 The constructors mkLabel, mkMiddle, and mkLast build single-node
29 AGraphs of the indicated type. The composition operator <*> glues
30 AGraphs together in sequence (in constant time).
36 if x<10 then goto L1 else goto L2
41 Notice that the AGraph may begin without a label, and may end without
42 a control transfer. Control *always* falls through a label and middle
43 node, and *never* falls through a Last node.
45 A 'AGraph m l' is simply an abstract version of a 'Graph m l' from
46 module 'ZipCfg'. The only difference is that the 'AGraph m l'
47 supports a constant-time splicing operation, written infix <*>.
48 That splicing operation, together with the constructor functions in
49 this module (and with 'labelAGraph'), is the recommended way to build
50 large graphs. Each construction or splice has constant cost, and to
51 turn an AGraph into a Graph requires time linear in the number of
52 nodes and N log N in the number of basic blocks.
54 The splicing operation warrants careful explanation. Like a Graph, an
55 AGraph is a control-flow graph which begins with a distinguished,
56 unlabelled sequence of middle nodes called the *entry*. An unlabelled
57 graph may also end with a sequence of middle nodes called the *exit*.
58 The entry may fall straight through to the exit, or it may fall into
59 the rest of the graph, which may include arbitrary control flow.
61 Using ASCII art, here are examples of the two kinds of graph. On the
62 left, the entry and exit sequences are labelled A and B, where the
63 control flow in the middle is labelled X. On the right, there is no
79 The AGraph has these properties:
81 * A AGraph is opaque; nothing about its structure can be observed.
83 * A AGraph may be turned into a LGraph in time linear in the number
84 of nodes and O(N log N) in the number of basic blocks.
86 * Two AGraphs may be spliced in constant time by writing g1 <*> g2
88 There are two rules for splicing, depending on whether the left-hand
89 graph falls through. If it does, the rule is as follows:
96 | X | <*> | Y | = | X |
114 And in the case where the left-hand graph does not fall through, the
123 | X | <*> | Y | = | X |
137 In this case C will become unreachable and is lost; when such a graph
138 is converted into a data structure, the system will bleat about
139 unreachable code. Also it must be assumed that there are branches
140 from somewhere in X to labelled blocks in Y; otherwise Y and D are
141 unreachable as well. (However, it may be the case that X branches
142 into some third AGraph, which in turn branches into D; the
143 representation is agnostic on this point.)
148 (<*>) :: AGraph m l -> AGraph m l -> AGraph m l
150 -- | A graph is built up by splicing together graphs each containing a
151 -- single node (where a label is considered a 'first' node. The empty
152 -- graph is a left and right unit for splicing. All of the AGraph
153 -- constructors (even complex ones like 'mkIfThenElse', as well as the
154 -- splicing operation <*>, are constant-time operations.
156 emptyAGraph :: AGraph m l
157 mkLabel :: LastNode l =>
158 BlockId -> AGraph m l -- graph contains the label
159 mkMiddle :: m -> AGraph m l -- graph contains the node
160 mkLast :: (Outputable m, Outputable l, LastNode l) =>
161 l -> AGraph m l -- graph contains the node
163 -- | This function provides access to fresh labels without requiring
164 -- clients to be programmed monadically.
165 withFreshLabel :: String -> (BlockId -> AGraph m l) -> AGraph m l
167 -- below for convenience
168 mkMiddles :: [m] -> AGraph m l
169 mkZTail :: (Outputable m, Outputable l, LastNode l) => ZTail m l -> AGraph m l
170 mkBranch :: (Outputable m, Outputable l, LastNode l) => BlockId -> AGraph m l
172 -- | For the structured control-flow constructs, a condition is
173 -- represented as a function that takes as arguments the labels to
174 -- goto on truth or falsehood.
176 mkIfThenElse :: (Outputable m, Outputable l, LastNode l)
177 => (BlockId -> BlockId -> AGraph m l) -- branch condition
178 -> AGraph m l -- code in the 'then' branch
179 -> AGraph m l -- code in the 'else' branch
180 -> AGraph m l -- resulting if-then-else construct
182 mkWhileDo :: (Outputable m, Outputable l, LastNode l)
183 => (BlockId -> BlockId -> AGraph m l) -- loop condition
184 -> AGraph m l -- body of the bloop
185 -> AGraph m l -- the final while loop
187 -- | Converting an abstract graph to a concrete form is expensive: the
188 -- cost is linear in the number of nodes in the answer, plus N log N
189 -- in the number of basic blocks. The conversion is also monadic
190 -- because it may require the allocation of fresh, unique labels.
192 graphOfAGraph :: AGraph m l -> UniqSM (Graph m l)
193 lgraphOfAGraph :: AGraph m l -> UniqSM (LGraph m l)
194 -- ^ allocate a fresh label for the entry point
195 labelAGraph :: BlockId -> AGraph m l -> UniqSM (LGraph m l)
196 -- ^ use the given BlockId as the label of the entry point
199 -- | The functions below build Graphs directly; for convenience, they
200 -- are included here with the rest of the constructor functions.
202 emptyGraph :: Graph m l
203 graphOfMiddles :: [m] -> Graph m l
204 graphOfZTail :: ZTail m l -> Graph m l
207 -- ================================================================
209 -- ================================================================
211 newtype AGraph m l = AGraph (Graph m l -> UniqSM (Graph m l))
212 -- an AGraph is a monadic function from a successor Graph to a new Graph
214 AGraph f1 <*> AGraph f2 = AGraph f
215 where f g = f2 g >>= f1 -- note right associativity
217 emptyAGraph = AGraph return
219 graphOfAGraph (AGraph f) = f emptyGraph
220 emptyGraph = Graph (ZLast LastExit) emptyBlockEnv
223 do Graph tail blocks <- graphOfAGraph g
224 return $ LGraph id $ insertBlock (Block id tail) blocks
226 lgraphOfAGraph g = do id <- freshBlockId "graph entry"
229 -------------------------------------
232 mkLabel id = AGraph f
233 where f (Graph tail blocks) =
234 return $ Graph (ZLast (mkBranchNode id))
235 (insertBlock (Block id tail) blocks)
237 mkBranch target = mkLast $ mkBranchNode target
239 mkMiddle m = AGraph f
240 where f (Graph tail blocks) = return $ Graph (ZTail m tail) blocks
242 mkMiddles ms = AGraph f
243 where f (Graph tail blocks) = return $ Graph (foldr ZTail tail ms) blocks
245 graphOfMiddles ms = Graph (foldr ZTail (ZLast LastExit) ms) emptyBlockEnv
246 graphOfZTail t = Graph t emptyBlockEnv
250 where f (Graph tail blocks) =
251 do note_this_code_becomes_unreachable tail
252 return $ Graph (ZLast (LastOther l)) blocks
254 mkZTail tail = AGraph f
255 where f (Graph utail blocks) =
256 do note_this_code_becomes_unreachable utail
257 return $ Graph tail blocks
259 withFreshLabel name ofId = AGraph f
260 where f g = do id <- freshBlockId name
261 let AGraph f' = ofId id
264 mkIfThenElse cbranch tbranch fbranch =
265 withFreshLabel "end of if" $ \endif ->
266 withFreshLabel "start of then" $ \tid ->
267 withFreshLabel "start of else" $ \fid ->
269 mkLabel tid <*> tbranch <*> mkBranch endif <*>
270 mkLabel fid <*> fbranch <*> mkLabel endif
273 mkWhileDo cbranch body =
274 withFreshLabel "loop test" $ \test ->
275 withFreshLabel "loop head" $ \head ->
276 withFreshLabel "end while" $ \endwhile ->
277 -- Forrest Baskett's while-loop layout
278 mkBranch test <*> mkLabel head <*> body <*> mkLabel test
279 <*> cbranch head endwhile <*> mkLabel endwhile
282 -- | Bleat if the insertion of a last node will create unreachable code
283 note_this_code_becomes_unreachable ::
284 (Monad m, LastNode l, Outputable middle, Outputable l) => ZTail middle l -> m ()
286 note_this_code_becomes_unreachable = u
287 where u (ZLast LastExit) = return ()
288 u (ZLast (LastOther l)) | isBranchNode l = return ()
289 -- Note [Branch follows branch]
290 u tail = fail ("unreachable code: " ++ showSDoc (ppr tail))
292 Note [Branch follows branch]
293 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
294 Why do we say it's ok for a Branch to follow a Branch?
295 Because the standard constructor mkLabel-- has fall-through
296 semantics. So if you do a mkLabel, you finish the current block,
297 giving it a label, and start a new one that branches to that label.
298 Emitting a Branch at this point is fine:
299 goto L1; L2: ...stuff...