compiler/cmm/MkZipCfg.hs

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