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