compiler/cmm/MkZipCfg.hs

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