compiler/cmm/MkZipCfg.hs

   1 {-# LANGUAGE ScopedTypeVariables #-}
   2 module MkZipCfg
   3     ( AGraph, (<*>), sequence
   4     , emptyAGraph, withFreshLabel, withUnique
   5     , mkMiddle, mkMiddles, mkLast, mkZTail, mkBranch, mkLabel, mkIfThenElse, mkWhileDo
   6     , outOfLine
   7     , emptyGraph, graphOfMiddles, graphOfZTail
   8     , lgraphOfAGraph, graphOfAGraph, labelAGraph
   9     )
  10 where
  11
  12 import ZipCfg
  13
  14 import Outputable
  15 import Unique
  16 import UniqFM
  17 import UniqSupply
  18
  19 import Prelude hiding (zip, unzip, last, sequence)
  20
  21 #include "HsVersions.h"
  22
  23 -------------------------------------------------------------------------
  24 --     GENERIC ZIPPER-BASED CONTROL-FLOW GRAPH (CONSTRUCTOR VIEW)      --
  25 -------------------------------------------------------------------------
  26
  27 {-
  28
  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)
  34
  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).
  38
  39 For example:
  40        x = 0
  41   L1:
  42        x = x+1
  43        if x<10 then goto L1 else goto L2
  44   L2:
  45        y = y*x
  46        x = 0
  47
  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.
  51
  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.
  60
  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.
  67
  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
  71 exit sequence:
  72
  73         |                      |
  74         | A                    | C
  75         |                      |
  76        / \                    / \
  77       /   \                  /   \
  78      |  X  |                |  Y  |
  79       \   /                  \   /
  80        \ /                    \_/
  81         |
  82         | B
  83         |
  84
  85
  86 The AGraph has these properties:
  87
  88   * A AGraph is opaque; nothing about its structure can be observed.
  89
  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.
  92
  93   * Two AGraphs may be spliced in constant time by writing  g1 <*> g2
  94
  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:
  97
  98         |                      |                          |
  99         | A                    | C                        | A
 100         |                      |                          |
 101        / \                    / \                        / \
 102       /   \                  /   \                      /   \
 103      |  X  |      <*>       |  Y  |           =        |  X  |
 104       \   /                  \   /                      \   /
 105        \ /                    \_/                        \ /
 106         |                      |                          |
 107         | B                    | D                        | B
 108         |                      |                          |
 109                                                           |
 110                                                           | C
 111                                                           |
 112                                                          / \
 113                                                         /   \
 114                                                        |  Y  |
 115                                                         \   /
 116                                                          \ /
 117                                                           |
 118                                                           | D
 119                                                           |
 120
 121 And in the case where the left-hand graph does not fall through, the
 122 rule is
 123
 124
 125         |                      |                          |
 126         | A                    | C                        | A
 127         |                      |                          |
 128        / \                    / \                        / \
 129       /   \                  /   \                      /   \
 130      |  X  |      <*>       |  Y  |           =        |  X  |
 131       \   /                  \   /                      \   /
 132        \_/                    \_/                        \_/
 133                                |
 134                                | D                        _
 135                                |                         / \
 136                                                         /   \
 137                                                        |  Y  |
 138                                                         \   /
 139                                                          \ /
 140                                                           |
 141                                                           | D
 142                                                           |
 143
 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.)
 151
 152 -}
 153
 154 infixr 3 <*>
 155 (<*>) :: AGraph m l -> AGraph m l -> AGraph m l
 156
 157 sequence :: [AGraph m l] -> AGraph m l
 158
 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.
 164
 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
 171
 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
 176
 177
 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.
 185 --
 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".
 191 --
 192 -- N.B. algebraically forall g g' : g <*> outOfLine g' == outOfLine g' <*> g
 193
 194
 195
 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
 200
 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.
 204 --
 205 --      mkIfThenElse mk_cond then else
 206 --      = (mk_cond L1 L2) <*> L1: then <*> goto J
 207 --                        <*> L2: else <*> goto J
 208 --        <*> J:
 209 --
 210 -- where L1, L2, J are fresh
 211
 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
 217
 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
 222
 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.
 227
 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
 233
 234
 235 -- | The functions below build Graphs directly; for convenience, they
 236 -- are included here with the rest of the constructor functions.
 237
 238 emptyGraph     ::              Graph m l
 239 graphOfMiddles :: [m]       -> Graph m l
 240 graphOfZTail   :: ZTail m l -> Graph m l
 241
 242
 243 -- ================================================================
 244 --                          IMPLEMENTATION
 245 -- ================================================================
 246
 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
 249
 250 AGraph f1 <*> AGraph f2 = AGraph f
 251     where f g = f2 g >>= f1 -- note right associativity
 252
 253 sequence = foldr (<*>) emptyAGraph
 254
 255 emptyAGraph = AGraph return
 256
 257 graphOfAGraph (AGraph f) = f emptyGraph
 258 emptyGraph = Graph (ZLast LastExit) emptyBlockEnv
 259
 260 labelAGraph id g =
 261     do Graph tail blocks <- graphOfAGraph g
 262        return $ LGraph id $ insertBlock (Block id tail) blocks
 263
 264 lgraphOfAGraph g = do id <- freshBlockId "graph entry"
 265                       labelAGraph id g
 266
 267 -------------------------------------
 268 -- constructors
 269
 270 mkLabel id = AGraph f
 271     where f (Graph tail blocks) =
 272             return $ Graph (ZLast (mkBranchNode id))
 273                            (insertBlock (Block id tail) blocks)
 274
 275 mkBranch target = mkLast $ mkBranchNode target
 276
 277 mkMiddle m = AGraph f
 278     where f (Graph tail blocks) = return $ Graph (ZTail m tail) blocks
 279
 280 mkMiddles ms = AGraph f
 281     where f (Graph tail blocks) = return $ Graph (foldr ZTail tail ms) blocks
 282
 283 graphOfMiddles ms = Graph (foldr ZTail (ZLast LastExit) ms) emptyBlockEnv
 284 graphOfZTail   t  = Graph t emptyBlockEnv
 285
 286
 287 mkLast l = AGraph f
 288     where f (Graph tail blocks) =
 289             do note_this_code_becomes_unreachable tail
 290                return $ Graph (ZLast (LastOther l)) blocks
 291
 292 mkZTail tail = AGraph f
 293     where f (Graph utail blocks) =
 294             do note_this_code_becomes_unreachable utail
 295                return $ Graph tail blocks
 296
 297 withFreshLabel name ofId = AGraph f
 298   where f g = do id <- freshBlockId name
 299                  let AGraph f' = ofId id
 300                  f' g
 301
 302 withUnique ofU = AGraph f
 303   where f g = do u <- getUniqueUs
 304                  let AGraph f' = ofU u
 305                  f' g
 306
 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')
 312
 313
 314 mkIfThenElse cbranch tbranch fbranch =
 315     withFreshLabel "end of if"     $ \endif ->
 316     withFreshLabel "start of then" $ \tid ->
 317     withFreshLabel "start of else" $ \fid ->
 318         cbranch tid fid <*>
 319         mkLabel tid <*> tbranch <*> mkBranch endif <*>
 320         mkLabel fid <*> fbranch <*> mkLabel endif
 321
 322
 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
 330
 331
 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 ()
 335
 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))
 341
 342 {-
 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...
 351 -}
 352
 353 _unused :: FS.FastString
 354 _unused = undefined