compiler/cmm/ZipCfgCmmRep.hs

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