compiler/cmm/ZipCfgCmmRep.hs

   1 -- This module is pure representation and should be imported only by
   2 -- clients that need to manipulate representation and know what
   3 -- they're doing.  Clients that need to create flow graphs should
   4 -- instead import MkZipCfgCmm.
   5
   6 module ZipCfgCmmRep
   7   ( CmmZ, CmmTopZ, CmmGraph, CmmBlock, CmmAGraph
   8   , Middle(..), Last(..), MidCallTarget(..), UpdFrameOffset
   9   , Convention(..), ForeignConvention(..), ForeignSafety(..)
  10   , ValueDirection(..), ForeignHint(..)
  11   , CmmBackwardFixedPoint, CmmForwardFixedPoint, pprHinted
  12   , insertBetween, mapExpMiddle, mapExpLast, mapExpDeepMiddle, mapExpDeepLast
  13   , foldExpMiddle, foldExpLast, foldExpDeepMiddle, foldExpDeepLast, joinOuts
  14   )
  15 where
  16
  17 import BlockId
  18 import CmmExpr
  19 import Cmm ( GenCmm(..), GenCmmTop(..), CmmStatic, CmmInfo
  20            , CallishMachOp(..), ForeignHint(..)
  21            , CmmActuals, CmmFormals, CmmHinted(..)
  22            , CmmStmt(..) -- imported in order to call ppr on Switch and to
  23                          -- implement pprCmmGraphLikeCmm
  24            )
  25 import DFMonad
  26 import PprCmm()
  27 import CmmTx
  28
  29 import CLabel
  30 import FastString
  31 import ForeignCall
  32 import qualified ZipDataflow as DF
  33 import ZipCfg
  34 import MkZipCfg
  35 import Util
  36
  37 import BasicTypes
  38 import Maybes
  39 import Control.Monad
  40 import Outputable
  41 import Prelude hiding (zip, unzip, last)
  42 import SMRep (ByteOff)
  43 import UniqSupply
  44
  45 ----------------------------------------------------------------------
  46 ----- Type synonyms and definitions
  47
  48 type CmmGraph                = LGraph Middle Last
  49 type CmmAGraph               = AGraph Middle Last
  50 type CmmBlock                = Block  Middle Last
  51 type CmmStackInfo            = (ByteOff, Maybe ByteOff)
  52   -- probably want a record; (SP offset on entry, update frame space)
  53 type CmmZ                    = GenCmm    CmmStatic CmmInfo (CmmStackInfo, CmmGraph)
  54 type CmmTopZ                 = GenCmmTop CmmStatic CmmInfo (CmmStackInfo, CmmGraph)
  55 type CmmBackwardFixedPoint a = DF.BackwardFixedPoint Middle Last a ()
  56 type CmmForwardFixedPoint  a = DF.ForwardFixedPoint  Middle Last a ()
  57
  58 type UpdFrameOffset = ByteOff
  59
  60 data Middle
  61   = MidComment FastString
  62
  63   | MidAssign CmmReg CmmExpr     -- Assign to register
  64
  65   | MidStore  CmmExpr CmmExpr    -- Assign to memory location.  Size is
  66                                  -- given by cmmExprType of the rhs.
  67
  68   | MidForeignCall               -- A foreign call; see Note [Foreign calls]
  69      ForeignSafety               -- Is it a safe or unsafe call?
  70      MidCallTarget               -- call target and convention
  71      CmmFormals                  -- zero or more results
  72      CmmActuals                  -- zero or more arguments
  73   deriving Eq
  74
  75 data Last
  76   = LastBranch BlockId  -- Goto another block in the same procedure
  77
  78   | LastCondBranch {            -- conditional branch
  79         cml_pred :: CmmExpr,
  80         cml_true, cml_false :: BlockId
  81     }
  82   | LastSwitch CmmExpr [Maybe BlockId]   -- Table branch
  83         -- The scrutinee is zero-based;
  84         --      zero -> first block
  85         --      one  -> second block etc
  86         -- Undefined outside range, and when there's a Nothing
  87   | LastCall {                   -- A call (native or safe foreign)
  88         cml_target  :: CmmExpr,  -- never a CmmPrim to a CallishMachOp!
  89         cml_cont    :: Maybe BlockId,
  90             -- BlockId of continuation (Nothing for return or tail call)
  91         cml_args    :: ByteOff,  -- byte offset for youngest outgoing arg
  92                                  -- (includes update frame, which must be younger)
  93         cml_ret_args:: ByteOff,  -- byte offset for youngest incoming arg
  94         cml_ret_off :: Maybe UpdFrameOffset}
  95           -- stack offset for return (update frames);
  96           -- The return offset should be Nothing only if we have to create
  97           -- a new call, e.g. for a procpoint, in which case it's an invariant
  98           -- that the call does not stand for a return or a tail call,
  99           -- and the successor does not need an info table.
 100
 101 data MidCallTarget      -- The target of a MidUnsafeCall
 102   = ForeignTarget       -- A foreign procedure
 103         CmmExpr                 -- Its address
 104         ForeignConvention       -- Its calling convention
 105
 106   | PrimTarget          -- A possibly-side-effecting machine operation
 107         CallishMachOp           -- Which one
 108   deriving Eq
 109
 110 data Convention
 111   = NativeDirectCall -- Native C-- call skipping the node (closure) argument
 112
 113   | NativeNodeCall   -- Native C-- call including the node argument
 114
 115   | NativeReturn     -- Native C-- return
 116
 117   | Slow             -- Slow entry points: all args pushed on the stack
 118
 119   | GC               -- Entry to the garbage collector: uses the node reg!
 120
 121   | PrimOpCall       -- Calling prim ops
 122
 123   | PrimOpReturn     -- Returning from prim ops
 124
 125   | Foreign          -- Foreign call/return
 126         ForeignConvention
 127
 128   | Private
 129         -- Used for control transfers within a (pre-CPS) procedure All
 130         -- jump sites known, never pushed on the stack (hence no SRT)
 131         -- You can choose whatever calling convention you please
 132         -- (provided you make sure all the call sites agree)!
 133         -- This data type eventually to be extended to record the convention.
 134   deriving( Eq )
 135
 136 data ForeignConvention
 137   = ForeignConvention
 138         CCallConv               -- Which foreign-call convention
 139         [ForeignHint]           -- Extra info about the args
 140         [ForeignHint]           -- Extra info about the result
 141   deriving Eq
 142
 143 data ForeignSafety
 144   = Unsafe              -- unsafe call
 145   | Safe BlockId        -- making infotable requires: 1. label
 146          UpdFrameOffset --                            2. where the upd frame is
 147   deriving Eq
 148
 149 data ValueDirection = Arguments | Results
 150   -- Arguments go with procedure definitions, jumps, and arguments to calls
 151   -- Results go with returns and with results of calls.
 152   deriving Eq
 153
 154 {- Note [Foreign calls]
 155 ~~~~~~~~~~~~~~~~~~~~~~~
 156 A MidForeign call is used *all* foreign calls, both *unsafe* and *safe*.
 157 Unsafe ones are easy: think of them as a "fat machine instruction".
 158
 159 Safe ones are trickier.  A safe foreign call
 160      r = f(x)
 161 ultimately expands to
 162      push "return address"      -- Never used to return to;
 163                                 -- just points an info table
 164      save registers into TSO
 165      call suspendThread
 166      r = f(x)                   -- Make the call
 167      call resumeThread
 168      restore registers
 169      pop "return address"
 170 We cannot "lower" a safe foreign call to this sequence of Cmms, because
 171 after we've saved Sp all the Cmm optimiser's assumptions are broken.
 172 Furthermore, currently the smart Cmm constructors know the calling
 173 conventions for Haskell, the garbage collector, etc, and "lower" them
 174 so that a LastCall passes no parameters or results.  But the smart
 175 constructors do *not* (currently) know the foreign call conventions.
 176
 177 For these reasons use MidForeignCall for all calls. The only annoying thing
 178 is that a safe foreign call needs an info table.
 179 -}
 180
 181 ----------------------------------------------------------------------
 182 ----- Splicing between blocks
 183 -- Given a middle node, a block, and a successor BlockId,
 184 -- we can insert the middle node between the block and the successor.
 185 -- We return the updated block and a list of new blocks that must be added
 186 -- to the graph.
 187 -- The semantics is a bit tricky. We consider cases on the last node:
 188 -- o For a branch, we can just insert before the branch,
 189 --   but sometimes the optimizer does better if we actually insert
 190 --   a fresh basic block, enabling some common blockification.
 191 -- o For a conditional branch, switch statement, or call, we must insert
 192 --   a new basic block.
 193 -- o For a jump or return, this operation is impossible.
 194
 195 insertBetween :: MonadUnique m => CmmBlock -> [Middle] -> BlockId -> m (CmmBlock, [CmmBlock])
 196 insertBetween b ms succId = insert $ goto_end $ unzip b
 197   where insert (h, LastOther (LastBranch bid)) =
 198           if bid == succId then
 199             do (bid', bs) <- newBlocks
 200                return (zipht h (ZLast (LastOther (LastBranch bid'))), bs)
 201           else panic "tried invalid block insertBetween"
 202         insert (h, LastOther (LastCondBranch c t f)) =
 203           do (t', tbs) <- if t == succId then newBlocks else return $ (t, [])
 204              (f', fbs) <- if f == succId then newBlocks else return $ (f, [])
 205              return (zipht h $ ZLast $ LastOther (LastCondBranch c t' f'), tbs ++ fbs)
 206         insert (h, LastOther (LastSwitch e ks)) =
 207           do (ids, bs) <- mapAndUnzipM mbNewBlocks ks
 208              return (zipht h $ ZLast $ LastOther (LastSwitch e ids), join bs)
 209         insert (_, LastOther (LastCall {})) =
 210           panic "unimp: insertBetween after a call -- probably not a good idea"
 211         insert (_, LastExit) = panic "cannot insert after exit"
 212         newBlocks = do id <- liftM BlockId $ getUniqueM
 213                        return $ (id, [Block id $
 214                                    foldr ZTail (ZLast (LastOther (LastBranch succId))) ms])
 215         mbNewBlocks (Just k) = if k == succId then liftM lift newBlocks
 216                                else return (Just k, [])
 217         mbNewBlocks Nothing  = return (Nothing, [])
 218         lift (id, bs) = (Just id, bs)
 219
 220 ----------------------------------------------------------------------
 221 ----- Instance declarations for control flow
 222
 223 instance HavingSuccessors Last where
 224     succs = cmmSuccs
 225     fold_succs = fold_cmm_succs
 226
 227 instance LastNode Last where
 228     mkBranchNode id = LastBranch id
 229     isBranchNode (LastBranch _) = True
 230     isBranchNode _ = False
 231     branchNodeTarget (LastBranch id) = id
 232     branchNodeTarget _ = panic "asked for target of non-branch"
 233
 234 cmmSuccs :: Last -> [BlockId]
 235 cmmSuccs (LastBranch id)              = [id]
 236 cmmSuccs (LastCall _ Nothing   _ _ _) = []
 237 cmmSuccs (LastCall _ (Just id) _ _ _) = [id]
 238 cmmSuccs (LastCondBranch _ t f)       = [f, t]  -- meets layout constraint
 239 cmmSuccs (LastSwitch _ edges)         = catMaybes edges
 240
 241 fold_cmm_succs :: (BlockId -> a -> a) -> Last -> a -> a
 242 fold_cmm_succs  f (LastBranch id)              z = f id z
 243 fold_cmm_succs  _ (LastCall _ Nothing _ _ _)   z = z
 244 fold_cmm_succs  f (LastCall _ (Just id) _ _ _) z = f id z
 245 fold_cmm_succs  f (LastCondBranch _ te fe)     z = f te (f fe z)
 246 fold_cmm_succs  f (LastSwitch _ edges)         z = foldl (flip f) z $ catMaybes edges
 247
 248 ----------------------------------------------------------------------
 249 ----- Instance declarations for register use
 250
 251 instance UserOfLocalRegs Middle where
 252     foldRegsUsed f z m = middle m
 253       where middle (MidComment {})               = z
 254             middle (MidAssign _lhs expr)         = fold f z expr
 255             middle (MidStore addr rval)          = fold f (fold f z addr) rval
 256             middle (MidForeignCall _ tgt _ args) = fold f (fold f z tgt) args
 257             fold f z m = foldRegsUsed f z m  -- avoid monomorphism restriction
 258
 259 instance UserOfLocalRegs MidCallTarget where
 260   foldRegsUsed _f z (PrimTarget _)      = z
 261   foldRegsUsed f  z (ForeignTarget e _) = foldRegsUsed f z e
 262
 263 instance UserOfSlots MidCallTarget where
 264   foldSlotsUsed _f z (PrimTarget _)      = z
 265   foldSlotsUsed f  z (ForeignTarget e _) = foldSlotsUsed f z e
 266
 267 instance (UserOfLocalRegs a) => UserOfLocalRegs (Maybe a) where
 268   foldRegsUsed f z (Just x) = foldRegsUsed f z x
 269   foldRegsUsed _ z Nothing  = z
 270
 271 instance (UserOfSlots a) => UserOfSlots (Maybe a) where
 272   foldSlotsUsed f z (Just x) = foldSlotsUsed f z x
 273   foldSlotsUsed _ z Nothing  = z
 274
 275 instance UserOfLocalRegs Last where
 276     foldRegsUsed f z l = last l
 277       where last (LastBranch _id)       = z
 278             last (LastCall tgt _ _ _ _) = foldRegsUsed f z tgt
 279             last (LastCondBranch e _ _) = foldRegsUsed f z e
 280             last (LastSwitch e _tbl)    = foldRegsUsed f z e
 281
 282 instance DefinerOfLocalRegs Middle where
 283     foldRegsDefd f z m = middle m
 284       where middle (MidComment {})           = z
 285             middle (MidAssign lhs _)         = fold f z lhs
 286             middle (MidStore _ _)            = z
 287             middle (MidForeignCall _ _ fs _) = fold f z fs
 288             fold f z m = foldRegsDefd f z m  -- avoid monomorphism restriction
 289
 290 instance DefinerOfLocalRegs Last where
 291     foldRegsDefd _ z _ = z
 292
 293
 294 ----------------------------------------------------------------------
 295 ----- Instance declarations for stack slot use
 296
 297 instance UserOfSlots Middle where
 298     foldSlotsUsed f z m = middle m
 299       where middle (MidComment {})                   = z
 300             middle (MidAssign _lhs expr)             = fold f z expr
 301             middle (MidStore addr rval)              = fold f (fold f z addr) rval
 302             middle (MidForeignCall _ tgt _ress args) = fold f (fold f z tgt) args
 303             fold f z e = foldSlotsUsed f z e  -- avoid monomorphism restriction
 304
 305 instance UserOfSlots Last where
 306     foldSlotsUsed f z l = last l
 307       where last (LastBranch _id)       = z
 308             last (LastCall tgt _ _ _ _) = foldSlotsUsed f z tgt
 309             last (LastCondBranch e _ _) = foldSlotsUsed f z e
 310             last (LastSwitch e _tbl)    = foldSlotsUsed f z e
 311
 312 instance UserOfSlots l => UserOfSlots (ZLast l) where
 313     foldSlotsUsed f z (LastOther l) = foldSlotsUsed f z l
 314     foldSlotsUsed _ z LastExit      = z
 315
 316 instance DefinerOfSlots Middle where
 317     foldSlotsDefd f z m = middle m
 318       where middle (MidComment {})    = z
 319             middle (MidAssign _ _)    = z
 320             middle (MidForeignCall {}) = z
 321             middle (MidStore (CmmStackSlot a i) e) =
 322               f z (a, i, widthInBytes $ typeWidth $ cmmExprType e)
 323             middle (MidStore _ _)     = z
 324
 325 instance DefinerOfSlots Last where
 326     foldSlotsDefd _ z _ = z
 327
 328 instance DefinerOfSlots l => DefinerOfSlots (ZLast l) where
 329     foldSlotsDefd f z (LastOther l) = foldSlotsDefd f z l
 330     foldSlotsDefd _ z LastExit      = z
 331
 332 ----------------------------------------------------------------------
 333 ----- Code for manipulating Middle and Last nodes
 334
 335 mapExpMiddle :: (CmmExpr -> CmmExpr) -> Middle -> Middle
 336 mapExpMiddle _   m@(MidComment _)            = m
 337 mapExpMiddle exp   (MidAssign r e)           = MidAssign r (exp e)
 338 mapExpMiddle exp   (MidStore addr e)         = MidStore (exp addr) (exp e)
 339 mapExpMiddle exp   (MidForeignCall s tgt fs as) =
 340   MidForeignCall s (mapExpMidcall exp tgt) fs (map exp as)
 341
 342 foldExpMiddle :: (CmmExpr -> z -> z) -> Middle -> z -> z
 343 foldExpMiddle _   (MidComment _)              z = z
 344 foldExpMiddle exp (MidAssign _ e)             z = exp e z
 345 foldExpMiddle exp (MidStore addr e)           z = exp addr $ exp e z
 346 foldExpMiddle exp (MidForeignCall _ tgt _ as) z = foldExpMidcall exp tgt $ foldr exp z as
 347
 348 mapExpLast :: (CmmExpr -> CmmExpr) -> Last -> Last
 349 mapExpLast _   l@(LastBranch _)           = l
 350 mapExpLast exp (LastCondBranch e ti fi)   = LastCondBranch (exp e) ti fi
 351 mapExpLast exp (LastSwitch e tbl)         = LastSwitch (exp e) tbl
 352 mapExpLast exp (LastCall tgt mb_id o i s) = LastCall (exp tgt) mb_id o i s
 353
 354 foldExpLast :: (CmmExpr -> z -> z) -> Last -> z -> z
 355 foldExpLast _   (LastBranch _)         z = z
 356 foldExpLast exp (LastCondBranch e _ _) z = exp e z
 357 foldExpLast exp (LastSwitch e _)       z = exp e z
 358 foldExpLast exp (LastCall tgt _ _ _ _) z = exp tgt z
 359
 360 mapExpMidcall :: (CmmExpr -> CmmExpr) -> MidCallTarget -> MidCallTarget
 361 mapExpMidcall exp   (ForeignTarget e c) = ForeignTarget (exp e) c
 362 mapExpMidcall _   m@(PrimTarget _)      = m
 363
 364 foldExpMidcall :: (CmmExpr -> z -> z) -> MidCallTarget -> z -> z
 365 foldExpMidcall exp (ForeignTarget e _) z = exp e z
 366 foldExpMidcall _   (PrimTarget _)      z = z
 367
 368 -- Take a transformer on expressions and apply it recursively.
 369 wrapRecExp :: (CmmExpr -> CmmExpr) -> CmmExpr -> CmmExpr
 370 wrapRecExp f (CmmMachOp op es)    = f (CmmMachOp op $ map (wrapRecExp f) es)
 371 wrapRecExp f (CmmLoad addr ty)    = f (CmmLoad (wrapRecExp f addr) ty)
 372 wrapRecExp f e                    = f e
 373
 374 mapExpDeepMiddle :: (CmmExpr -> CmmExpr) -> Middle -> Middle
 375 mapExpDeepLast   :: (CmmExpr -> CmmExpr) -> Last   -> Last
 376 mapExpDeepMiddle f = mapExpMiddle $ wrapRecExp f
 377 mapExpDeepLast   f = mapExpLast   $ wrapRecExp f
 378
 379 -- Take a folder on expressions and apply it recursively.
 380 wrapRecExpf :: (CmmExpr -> z -> z) -> CmmExpr -> z -> z
 381 wrapRecExpf f e@(CmmMachOp _ es) z = foldr (wrapRecExpf f) (f e z) es
 382 wrapRecExpf f e@(CmmLoad addr _) z = wrapRecExpf f addr (f e z)
 383 wrapRecExpf f e                  z = f e z
 384
 385 foldExpDeepMiddle :: (CmmExpr -> z -> z) -> Middle -> z -> z
 386 foldExpDeepLast   :: (CmmExpr -> z -> z) -> Last   -> z -> z
 387 foldExpDeepMiddle f = foldExpMiddle $ wrapRecExpf f
 388 foldExpDeepLast   f = foldExpLast   $ wrapRecExpf f
 389
 390 ----------------------------------------------------------------------
 391 -- Compute the join of facts live out of a Last node. Useful for most backward
 392 -- analyses.
 393 joinOuts :: DataflowLattice a -> (BlockId -> a) -> Last -> a
 394 joinOuts lattice env l =
 395   let bot  = fact_bot lattice
 396       join x y = txVal $ fact_add_to lattice x y
 397   in case l of
 398        (LastBranch id)             -> env id
 399        (LastCall _ Nothing _ _ _)  -> bot
 400        (LastCall _ (Just k) _ _ _) -> env k
 401        (LastCondBranch _ t f)      -> join (env t) (env f)
 402        (LastSwitch _ tbl)          -> foldr join bot (map env $ catMaybes tbl)
 403
 404 ----------------------------------------------------------------------
 405 ----- Instance declarations for prettyprinting (avoids recursive imports)
 406
 407 instance Outputable Middle where
 408     ppr s = pprMiddle s
 409
 410 instance Outputable Last where
 411     ppr s = pprLast s
 412
 413 instance Outputable Convention where
 414     ppr = pprConvention
 415
 416 instance Outputable ForeignConvention where
 417     ppr = pprForeignConvention
 418
 419 instance Outputable ValueDirection where
 420     ppr Arguments = ptext $ sLit "args"
 421     ppr Results   = ptext $ sLit "results"
 422
 423 instance DF.DebugNodes Middle Last
 424
 425 debugPpr :: Bool
 426 debugPpr = debugIsOn
 427
 428 pprMiddle :: Middle -> SDoc
 429 pprMiddle stmt = pp_stmt <+> pp_debug
 430   where
 431     pp_stmt = case stmt of
 432         --  // text
 433         MidComment s -> text "//" <+> ftext s
 434
 435         -- reg = expr;
 436         MidAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
 437
 438         -- rep[lv] = expr;
 439         MidStore lv expr -> rep <> brackets(ppr lv) <+> equals <+> ppr expr <> semi
 440             where
 441               rep = ppr ( cmmExprType expr )
 442
 443         -- call "ccall" foo(x, y)[r1, r2];
 444         -- ToDo ppr volatile
 445         MidForeignCall safety target results args ->
 446             hsep [ if null results
 447                       then empty
 448                       else parens (commafy $ map ppr results) <+> equals,
 449                       ppr_safety safety,
 450                    ptext $ sLit "call",
 451                    ppr_call_target target <> parens (commafy $ map ppr args) <> semi]
 452
 453     pp_debug =
 454       if not debugPpr then empty
 455       else text " //" <+>
 456            case stmt of
 457              MidComment     {} -> text "MidComment"
 458              MidAssign      {} -> text "MidAssign"
 459              MidStore       {} -> text "MidStore"
 460              MidForeignCall {} -> text "MidForeignCall"
 461
 462 ppr_fc :: ForeignConvention -> SDoc
 463 ppr_fc (ForeignConvention c args res) =
 464   doubleQuotes (ppr c) <+> text "args: " <+> ppr args <+> text " results: " <+> ppr res
 465
 466 ppr_safety :: ForeignSafety -> SDoc
 467 ppr_safety (Safe bid upd) = text "safe<" <> ppr bid <> text ", " <> ppr upd <> text ">"
 468 ppr_safety Unsafe         = text "unsafe"
 469
 470 ppr_call_target :: MidCallTarget -> SDoc
 471 ppr_call_target (ForeignTarget fn c) = ppr_fc c <+> ppr_target fn
 472 ppr_call_target (PrimTarget op)      = ppr (CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False IsFunction))
 473
 474 ppr_target :: CmmExpr -> SDoc
 475 ppr_target t@(CmmLit _) = ppr t
 476 ppr_target fn'          = parens (ppr fn')
 477
 478 pprHinted :: Outputable a => CmmHinted a -> SDoc
 479 pprHinted (CmmHinted a NoHint)     = ppr a
 480 pprHinted (CmmHinted a AddrHint)   = doubleQuotes (text "address") <+> ppr a
 481 pprHinted (CmmHinted a SignedHint) = doubleQuotes (text "signed")  <+> ppr a
 482
 483 pprLast :: Last -> SDoc
 484 pprLast stmt = pp_stmt <+> pp_debug
 485   where
 486     pp_stmt = case stmt of
 487        LastBranch ident                -> ptext (sLit "goto") <+> ppr ident <> semi
 488        LastCondBranch expr t f         -> genFullCondBranch expr t f
 489        LastSwitch arg ids              -> ppr $ CmmSwitch arg ids
 490        LastCall tgt k out res updfr_off -> genBareCall tgt k out res updfr_off
 491
 492     pp_debug = text " //" <+> case stmt of
 493            LastBranch {} -> text "LastBranch"
 494            LastCondBranch {} -> text "LastCondBranch"
 495            LastSwitch {} -> text "LastSwitch"
 496            LastCall {} -> text "LastCall"
 497
 498 genBareCall :: CmmExpr -> Maybe BlockId -> ByteOff -> ByteOff ->
 499                           Maybe UpdFrameOffset -> SDoc
 500 genBareCall fn k out res updfr_off =
 501         hcat [ ptext (sLit "call"), space
 502              , pprFun fn, ptext (sLit "(...)"), space
 503              , ptext (sLit "returns to") <+> ppr k <+> parens (ppr out)
 504                                                    <+> parens (ppr res)
 505              , ptext (sLit " with update frame") <+> ppr updfr_off
 506              , semi ]
 507
 508 pprFun :: CmmExpr -> SDoc
 509 pprFun f@(CmmLit _) = ppr f
 510 pprFun f = parens (ppr f)
 511
 512 genFullCondBranch :: Outputable id => CmmExpr -> id -> id -> SDoc
 513 genFullCondBranch expr t f =
 514     hsep [ ptext (sLit "if")
 515          , parens(ppr expr)
 516          , ptext (sLit "goto")
 517          , ppr t <> semi
 518          , ptext (sLit "else goto")
 519          , ppr f <> semi
 520          ]
 521
 522 pprConvention :: Convention -> SDoc
 523 pprConvention (NativeNodeCall   {}) = text "<native-node-call-convention>"
 524 pprConvention (NativeDirectCall {}) = text "<native-direct-call-convention>"
 525 pprConvention (NativeReturn {})     = text "<native-ret-convention>"
 526 pprConvention  Slow                 = text "<slow-convention>"
 527 pprConvention  GC                   = text "<gc-convention>"
 528 pprConvention  PrimOpCall           = text "<primop-call-convention>"
 529 pprConvention  PrimOpReturn         = text "<primop-ret-convention>"
 530 pprConvention (Foreign c)           = ppr c
 531 pprConvention (Private {})          = text "<private-convention>"
 532
 533 pprForeignConvention :: ForeignConvention -> SDoc
 534 pprForeignConvention (ForeignConvention c as rs) = ppr c <> ppr as <> ppr rs
 535
 536 commafy :: [SDoc] -> SDoc
 537 commafy xs = hsep $ punctuate comma xs