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