compiler/cmm/MkZipCfg.hs

   1 {-# OPTIONS -Wall -fno-warn-name-shadowing #-}
   2 module MkZipCfg
   3     ( AGraph, (<*>), emptyAGraph, withFreshLabel, withUnique
   4     , mkMiddle, mkMiddles, mkLast, mkZTail, mkBranch, mkLabel, mkIfThenElse, mkWhileDo
   5     , outOfLine
   6     , emptyGraph, graphOfMiddles, graphOfZTail
   7     , lgraphOfAGraph, graphOfAGraph, labelAGraph
   8     )
   9 where
  10
  11 import ZipCfg
  12
  13 import Outputable
  14 import Unique
  15 import UniqFM
  16 import UniqSupply
  17
  18 import Prelude hiding (zip, unzip, last)
  19
  20
  21 -------------------------------------------------------------------------
  22 --     GENERIC ZIPPER-BASED CONTROL-FLOW GRAPH (CONSTRUCTOR VIEW)      --
  23 -------------------------------------------------------------------------
  24
  25 {-
  26
  27 You can think of an AGraph like this: it is the program built by
  28 composing in sequence three kinds of nodes:
  29   * Label nodes (e.g. L2:)
  30   * Middle nodes (e.g. x = y*3)
  31   * Last nodes (e.g. if b then goto L1 else goto L2)
  32
  33 The constructors mkLabel, mkMiddle, and mkLast build single-node
  34 AGraphs of the indicated type.  The composition operator <*> glues
  35 AGraphs together in sequence (in constant time).
  36
  37 For example:
  38        x = 0
  39   L1:
  40        x = x+1
  41        if x<10 then goto L1 else goto L2
  42   L2:
  43        y = y*x
  44        x = 0
  45
  46 Notice that the AGraph may begin without a label, and may end without
  47 a control transfer.  Control *always* falls through a label and middle
  48 node, and *never* falls through a Last node.
  49
  50 A 'AGraph m l' is simply an abstract version of a 'Graph m l' from
  51 module 'ZipCfg'.  The only difference is that the 'AGraph m l'
  52 supports a constant-time splicing operation, written infix <*>.
  53 That splicing operation, together with the constructor functions in
  54 this module (and with 'labelAGraph'), is the recommended way to build
  55 large graphs.  Each construction or splice has constant cost, and to
  56 turn an AGraph into a Graph requires time linear in the number of
  57 nodes and N log N in the number of basic blocks.
  58
  59 The splicing operation warrants careful explanation.  Like a Graph, an
  60 AGraph is a control-flow graph which begins with a distinguished,
  61 unlabelled sequence of middle nodes called the *entry*.  An unlabelled
  62 graph may also end with a sequence of middle nodes called the *exit*.
  63 The entry may fall straight through to the exit, or it may fall into
  64 the rest of the graph, which may include arbitrary control flow.
  65
  66 Using ASCII art, here are examples of the two kinds of graph.  On the
  67 left, the entry and exit sequences are labelled A and B, where the
  68 control flow in the middle is labelled X.   On the right, there is no
  69 exit sequence:
  70
  71         |                      |
  72         | A                    | C
  73         |                      |
  74        / \                    / \
  75       /   \                  /   \
  76      |  X  |                |  Y  |
  77       \   /                  \   /
  78        \ /                    \_/
  79         |
  80         | B
  81         |
  82
  83
  84 The AGraph has these properties:
  85
  86   * A AGraph is opaque; nothing about its structure can be observed.
  87
  88   * A AGraph may be turned into a LGraph in time linear in the number
  89     of nodes and O(N log N) in the number of basic blocks.
  90
  91   * Two AGraphs may be spliced in constant time by writing  g1 <*> g2
  92
  93 There are two rules for splicing, depending on whether the left-hand
  94 graph falls through.  If it does, the rule is as follows:
  95
  96         |                      |                          |
  97         | A                    | C                        | A
  98         |                      |                          |
  99        / \                    / \                        / \
 100       /   \                  /   \                      /   \
 101      |  X  |      <*>       |  Y  |           =        |  X  |
 102       \   /                  \   /                      \   /
 103        \ /                    \_/                        \ /
 104         |                      |                          |
 105         | B                    | D                        | B
 106         |                      |                          |
 107                                                           |
 108                                                           | C
 109                                                           |
 110                                                          / \
 111                                                         /   \
 112                                                        |  Y  |
 113                                                         \   /
 114                                                          \ /
 115                                                           |
 116                                                           | D
 117                                                           |
 118
 119 And in the case where the left-hand graph does not fall through, the
 120 rule is
 121
 122
 123         |                      |                          |
 124         | A                    | C                        | A
 125         |                      |                          |
 126        / \                    / \                        / \
 127       /   \                  /   \                      /   \
 128      |  X  |      <*>       |  Y  |           =        |  X  |
 129       \   /                  \   /                      \   /
 130        \_/                    \_/                        \_/
 131                                |
 132                                | D                        _
 133                                |                         / \
 134                                                         /   \
 135                                                        |  Y  |
 136                                                         \   /
 137                                                          \ /
 138                                                           |
 139                                                           | D
 140                                                           |
 141
 142 In this case C will become unreachable and is lost; when such a graph
 143 is converted into a data structure, the system will bleat about
 144 unreachable code.  Also it must be assumed that there are branches
 145 from somewhere in X to labelled blocks in Y; otherwise Y and D are
 146 unreachable as well.   (However, it may be the case that X branches
 147 into some third AGraph, which in turn branches into D; the
 148 representation is agnostic on this point.)
 149
 150 -}
 151
 152 infixr 3 <*>
 153 (<*>) :: AGraph m l -> AGraph m l -> AGraph m l
 154
 155 -- | A graph is built up by splicing together graphs each containing a
 156 -- single node (where a label is considered a 'first' node.  The empty
 157 -- graph is a left and right unit for splicing.  All of the AGraph
 158 -- constructors (even complex ones like 'mkIfThenElse', as well as the
 159 -- splicing operation <*>, are constant-time operations.
 160
 161 emptyAGraph :: AGraph m l
 162 mkLabel     :: LastNode l =>
 163                BlockId -> AGraph m l              -- graph contains the label
 164 mkMiddle    :: m       -> AGraph m l              -- graph contains the node
 165 mkLast      :: (Outputable m, Outputable l, LastNode l) =>
 166                l       -> AGraph m l              -- graph contains the node
 167
 168 -- | This function provides access to fresh labels without requiring
 169 -- clients to be programmed monadically.
 170 withFreshLabel :: String -> (BlockId -> AGraph m l) -> AGraph m l
 171 withUnique     :: (Unique -> AGraph m l) -> AGraph m l
 172
 173
 174 outOfLine :: (LastNode l, Outputable m, Outputable l)
 175           => AGraph m l -> AGraph m l
 176 -- ^ The argument is an AGraph that has an
 177 -- empty entry sequence and no exit sequence.
 178 -- The result is a new AGraph that has an empty entry sequence
 179 -- connected to an empty exit sequence, with the original graph
 180 -- sitting to the side out-of-line.
 181 --
 182 -- Example:  mkMiddle (x = 3)
 183 --           <*> outOfLine (mkLabel L <*> ...stuff...)
 184 --           <*> mkMiddle (y = x)
 185 -- Control will flow directly from x=3 to y=x;
 186 -- the block starting with L is "on the side".
 187 --
 188 -- N.B. algebraically forall g g' : g <*> outOfLine g' == outOfLine g' <*> g
 189
 190
 191
 192 -- below for convenience
 193 mkMiddles ::                                             [m]       -> AGraph m l
 194 mkZTail   :: (Outputable m, Outputable l, LastNode l) => ZTail m l -> AGraph m l
 195 mkBranch  :: (Outputable m, Outputable l, LastNode l) => BlockId   -> AGraph m l
 196
 197 -- | For the structured control-flow constructs, a condition is
 198 -- represented as a function that takes as arguments the labels to
 199 -- goto on truth or falsehood.
 200
 201 mkIfThenElse :: (Outputable m, Outputable l, LastNode l)
 202                 => (BlockId -> BlockId -> AGraph m l) -- branch condition
 203                 -> AGraph m l   -- code in the 'then' branch
 204                 -> AGraph m l   -- code in the 'else' branch
 205                 -> AGraph m l   -- resulting if-then-else construct
 206
 207 mkWhileDo    :: (Outputable m, Outputable l, LastNode l)
 208                 => (BlockId -> BlockId -> AGraph m l) -- loop condition
 209                 -> AGraph m l  -- body of the bloop
 210                 -> AGraph m l  -- the final while loop
 211
 212 -- | Converting an abstract graph to a concrete form is expensive: the
 213 -- cost is linear in the number of nodes in the answer, plus N log N
 214 -- in the number of basic blocks.  The conversion is also monadic
 215 -- because it may require the allocation of fresh, unique labels.
 216
 217 graphOfAGraph  ::            AGraph m l -> UniqSM (Graph  m l)
 218 lgraphOfAGraph ::            AGraph m l -> UniqSM (LGraph m l)
 219   -- ^ allocate a fresh label for the entry point
 220 labelAGraph    :: BlockId -> AGraph m l -> UniqSM (LGraph m l)
 221   -- ^ use the given BlockId as the label of the entry point
 222
 223
 224 -- | The functions below build Graphs directly; for convenience, they
 225 -- are included here with the rest of the constructor functions.
 226
 227 emptyGraph     ::              Graph m l
 228 graphOfMiddles :: [m]       -> Graph m l
 229 graphOfZTail   :: ZTail m l -> Graph m l
 230
 231
 232 -- ================================================================
 233 --                          IMPLEMENTATION
 234 -- ================================================================
 235
 236 newtype AGraph m l = AGraph (Graph m l -> UniqSM (Graph m l))
 237   -- an AGraph is a monadic function from a successor Graph to a new Graph
 238
 239 AGraph f1 <*> AGraph f2 = AGraph f
 240     where f g = f2 g >>= f1 -- note right associativity
 241
 242 emptyAGraph = AGraph return
 243
 244 graphOfAGraph (AGraph f) = f emptyGraph
 245 emptyGraph = Graph (ZLast LastExit) emptyBlockEnv
 246
 247 labelAGraph id g =
 248     do Graph tail blocks <- graphOfAGraph g
 249        return $ LGraph id $ insertBlock (Block id tail) blocks
 250
 251 lgraphOfAGraph g = do id <- freshBlockId "graph entry"
 252                       labelAGraph id g
 253
 254 -------------------------------------
 255 -- constructors
 256
 257 mkLabel id = AGraph f
 258     where f (Graph tail blocks) =
 259             return $ Graph (ZLast (mkBranchNode id))
 260                            (insertBlock (Block id tail) blocks)
 261
 262 mkBranch target = mkLast $ mkBranchNode target
 263
 264 mkMiddle m = AGraph f
 265     where f (Graph tail blocks) = return $ Graph (ZTail m tail) blocks
 266
 267 mkMiddles ms = AGraph f
 268     where f (Graph tail blocks) = return $ Graph (foldr ZTail tail ms) blocks
 269
 270 graphOfMiddles ms = Graph (foldr ZTail (ZLast LastExit) ms) emptyBlockEnv
 271 graphOfZTail   t  = Graph t emptyBlockEnv
 272
 273
 274 mkLast l = AGraph f
 275     where f (Graph tail blocks) =
 276             do note_this_code_becomes_unreachable tail
 277                return $ Graph (ZLast (LastOther l)) blocks
 278
 279 mkZTail tail = AGraph f
 280     where f (Graph utail blocks) =
 281             do note_this_code_becomes_unreachable utail
 282                return $ Graph tail blocks
 283
 284 withFreshLabel name ofId = AGraph f
 285   where f g = do id <- freshBlockId name
 286                  let AGraph f' = ofId id
 287                  f' g
 288
 289 withUnique ofU = AGraph f
 290   where f g = do u <- getUniqueUs
 291                  let AGraph f' = ofU u
 292                  f' g
 293
 294 outOfLine (AGraph f) = AGraph f'
 295     where f' (Graph tail' blocks') =
 296             do Graph emptyEntrance blocks <- f emptyGraph
 297                note_this_code_becomes_unreachable emptyEntrance
 298                return $ Graph tail' (blocks `plusUFM` blocks')
 299
 300
 301 mkIfThenElse cbranch tbranch fbranch =
 302     withFreshLabel "end of if"     $ \endif ->
 303     withFreshLabel "start of then" $ \tid ->
 304     withFreshLabel "start of else" $ \fid ->
 305         cbranch tid fid <*>
 306         mkLabel tid <*> tbranch <*> mkBranch endif <*>
 307         mkLabel fid <*> fbranch <*> mkLabel endif
 308
 309
 310 mkWhileDo cbranch body =
 311   withFreshLabel "loop test" $ \test ->
 312   withFreshLabel "loop head" $ \head ->
 313   withFreshLabel "end while" $ \endwhile ->
 314      -- Forrest Baskett's while-loop layout
 315      mkBranch test <*> mkLabel head <*> body <*> mkLabel test
 316                    <*> cbranch head endwhile <*> mkLabel endwhile
 317
 318
 319 -- | Bleat if the insertion of a last node will create unreachable code
 320 note_this_code_becomes_unreachable ::
 321     (Monad m, LastNode l, Outputable middle, Outputable l) => ZTail middle l -> m ()
 322
 323 #ifdef DEBUG
 324 note_this_code_becomes_unreachable = u
 325     where u (ZLast LastExit)                       = return ()
 326           u (ZLast (LastOther l)) | isBranchNode l = return ()
 327                                     -- Note [Branch follows branch]
 328           u tail = fail ("unreachable code: " ++ showSDoc (ppr tail))
 329 #else
 330 note_this_code_becomes_unreachable _ = return ()
 331 #endif
 332
 333 {-
 334 Note [Branch follows branch]
 335 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 336 Why do we say it's ok for a Branch to follow a Branch?
 337 Because the standard constructor mkLabel-- has fall-through
 338 semantics. So if you do a mkLabel, you finish the current block,
 339 giving it a label, and start a new one that branches to that label.
 340 Emitting a Branch at this point is fine:
 341        goto L1; L2: ...stuff...
 342 -}