compiler/cmm/MkZipCfg.hs

   1 {-# LANGUAGE ScopedTypeVariables #-}
   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 mk_cond then else
 202 --      = (mk_cond L1 L2) <*> L1: then <*> goto J
 203 --                        <*> L2: else <*> goto J
 204 --        <*> J:
 205 --
 206 -- where L1, L2, J are fresh
 207
 208 mkIfThenElse :: (Outputable m, Outputable l, LastNode l)
 209                 => (BlockId -> BlockId -> AGraph m l) -- branch condition
 210                 -> AGraph m l   -- code in the 'then' branch
 211                 -> AGraph m l   -- code in the 'else' branch
 212                 -> AGraph m l   -- resulting if-then-else construct
 213
 214 mkWhileDo    :: (Outputable m, Outputable l, LastNode l)
 215                 => (BlockId -> BlockId -> AGraph m l) -- loop condition
 216                 -> AGraph m l  -- body of the bloop
 217                 -> AGraph m l  -- the final while loop
 218
 219 -- | Converting an abstract graph to a concrete form is expensive: the
 220 -- cost is linear in the number of nodes in the answer, plus N log N
 221 -- in the number of basic blocks.  The conversion is also monadic
 222 -- because it may require the allocation of fresh, unique labels.
 223
 224 graphOfAGraph  ::            AGraph m l -> UniqSM (Graph  m l)
 225 lgraphOfAGraph ::            AGraph m l -> UniqSM (LGraph m l)
 226   -- ^ allocate a fresh label for the entry point
 227 labelAGraph    :: BlockId -> AGraph m l -> UniqSM (LGraph m l)
 228   -- ^ use the given BlockId as the label of the entry point
 229
 230
 231 -- | The functions below build Graphs directly; for convenience, they
 232 -- are included here with the rest of the constructor functions.
 233
 234 emptyGraph     ::              Graph m l
 235 graphOfMiddles :: [m]       -> Graph m l
 236 graphOfZTail   :: ZTail m l -> Graph m l
 237
 238
 239 -- ================================================================
 240 --                          IMPLEMENTATION
 241 -- ================================================================
 242
 243 newtype AGraph m l = AGraph (Graph m l -> UniqSM (Graph m l))
 244   -- an AGraph is a monadic function from a successor Graph to a new Graph
 245
 246 AGraph f1 <*> AGraph f2 = AGraph f
 247     where f g = f2 g >>= f1 -- note right associativity
 248
 249 emptyAGraph = AGraph return
 250
 251 graphOfAGraph (AGraph f) = f emptyGraph
 252 emptyGraph = Graph (ZLast LastExit) emptyBlockEnv
 253
 254 labelAGraph id g =
 255     do Graph tail blocks <- graphOfAGraph g
 256        return $ LGraph id $ insertBlock (Block id tail) blocks
 257
 258 lgraphOfAGraph g = do id <- freshBlockId "graph entry"
 259                       labelAGraph id g
 260
 261 -------------------------------------
 262 -- constructors
 263
 264 mkLabel id = AGraph f
 265     where f (Graph tail blocks) =
 266             return $ Graph (ZLast (mkBranchNode id))
 267                            (insertBlock (Block id tail) blocks)
 268
 269 mkBranch target = mkLast $ mkBranchNode target
 270
 271 mkMiddle m = AGraph f
 272     where f (Graph tail blocks) = return $ Graph (ZTail m tail) blocks
 273
 274 mkMiddles ms = AGraph f
 275     where f (Graph tail blocks) = return $ Graph (foldr ZTail tail ms) blocks
 276
 277 graphOfMiddles ms = Graph (foldr ZTail (ZLast LastExit) ms) emptyBlockEnv
 278 graphOfZTail   t  = Graph t emptyBlockEnv
 279
 280
 281 mkLast l = AGraph f
 282     where f (Graph tail blocks) =
 283             do note_this_code_becomes_unreachable tail
 284                return $ Graph (ZLast (LastOther l)) blocks
 285
 286 mkZTail tail = AGraph f
 287     where f (Graph utail blocks) =
 288             do note_this_code_becomes_unreachable utail
 289                return $ Graph tail blocks
 290
 291 withFreshLabel name ofId = AGraph f
 292   where f g = do id <- freshBlockId name
 293                  let AGraph f' = ofId id
 294                  f' g
 295
 296 withUnique ofU = AGraph f
 297   where f g = do u <- getUniqueUs
 298                  let AGraph f' = ofU u
 299                  f' g
 300
 301 outOfLine (AGraph f) = AGraph f'
 302     where f' (Graph tail' blocks') =
 303             do Graph emptyEntrance blocks <- f emptyGraph
 304                note_this_code_becomes_unreachable emptyEntrance
 305                return $ Graph tail' (blocks `plusUFM` blocks')
 306
 307
 308 mkIfThenElse cbranch tbranch fbranch =
 309     withFreshLabel "end of if"     $ \endif ->
 310     withFreshLabel "start of then" $ \tid ->
 311     withFreshLabel "start of else" $ \fid ->
 312         cbranch tid fid <*>
 313         mkLabel tid <*> tbranch <*> mkBranch endif <*>
 314         mkLabel fid <*> fbranch <*> mkLabel endif
 315
 316
 317 mkWhileDo cbranch body =
 318   withFreshLabel "loop test" $ \test ->
 319   withFreshLabel "loop head" $ \head ->
 320   withFreshLabel "end while" $ \endwhile ->
 321      -- Forrest Baskett's while-loop layout
 322      mkBranch test <*> mkLabel head <*> body <*> mkLabel test
 323                    <*> cbranch head endwhile <*> mkLabel endwhile
 324
 325
 326 -- | Bleat if the insertion of a last node will create unreachable code
 327 note_this_code_becomes_unreachable ::
 328     (Monad m, LastNode l, Outputable middle, Outputable l) => ZTail middle l -> m ()
 329
 330 #ifdef DEBUG
 331 note_this_code_becomes_unreachable = u
 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))
 336 #else
 337 note_this_code_becomes_unreachable _ = return ()
 338 #endif
 339
 340 {-
 341 Note [Branch follows branch]
 342 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 343 Why do we say it's ok for a Branch to follow a Branch?
 344 Because the standard constructor mkLabel-- has fall-through
 345 semantics. So if you do a mkLabel, you finish the current block,
 346 giving it a label, and start a new one that branches to that label.
 347 Emitting a Branch at this point is fine:
 348        goto L1; L2: ...stuff...
 349 -}