compiler/cmm/PprCmm.hs

   1 ----------------------------------------------------------------------------
   2 --
   3 -- Pretty-printing of Cmm as (a superset of) C--
   4 --
   5 -- (c) The University of Glasgow 2004-2006
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 --
  10 -- This is where we walk over Cmm emitting an external representation,
  11 -- suitable for parsing, in a syntax strongly reminiscent of C--. This
  12 -- is the "External Core" for the Cmm layer.
  13 --
  14 -- As such, this should be a well-defined syntax: we want it to look nice.
  15 -- Thus, we try wherever possible to use syntax defined in [1],
  16 -- "The C-- Reference Manual", http://www.cminusminus.org/. We differ
  17 -- slightly, in some cases. For one, we use I8 .. I64 for types, rather
  18 -- than C--'s bits8 .. bits64.
  19 --
  20 -- We try to ensure that all information available in the abstract
  21 -- syntax is reproduced, or reproducible, in the concrete syntax.
  22 -- Data that is not in printed out can be reconstructed according to
  23 -- conventions used in the pretty printer. There are at least two such
  24 -- cases:
  25 --      1) if a value has wordRep type, the type is not appended in the
  26 --      output.
  27 --      2) MachOps that operate over wordRep type are printed in a
  28 --      C-style, rather than as their internal MachRep name.
  29 --
  30 -- These conventions produce much more readable Cmm output.
  31 --
  32 -- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs
  33 --
  34
  35 module PprCmm
  36     ( writeCmms, pprCmms, pprCmm, pprStmt, pprExpr, pprSection, pprStatic, pprLit
  37     )
  38 where
  39
  40 import Cmm
  41 import CmmExpr
  42 import CmmUtils
  43 import MachOp
  44 import CLabel
  45
  46 import ForeignCall
  47 import Unique
  48 import Outputable
  49 import FastString
  50
  51 import Data.List
  52 import System.IO
  53 import Data.Maybe
  54
  55 pprCmms :: (Outputable info, Outputable g) => [GenCmm CmmStatic info g] -> SDoc
  56 pprCmms cmms = pprCode CStyle (vcat (intersperse separator $ map ppr cmms))
  57         where
  58           separator = space $$ ptext (sLit "-------------------") $$ space
  59
  60 writeCmms :: Handle -> [Cmm] -> IO ()
  61 writeCmms handle cmms = printForC handle (pprCmms cmms)
  62
  63 -----------------------------------------------------------------------------
  64
  65 instance (Outputable d, Outputable info, Outputable g)
  66     => Outputable (GenCmm d info g) where
  67     ppr c = pprCmm c
  68
  69 instance (Outputable d, Outputable info, Outputable i)
  70         => Outputable (GenCmmTop d info i) where
  71     ppr t = pprTop t
  72
  73 instance (Outputable instr) => Outputable (ListGraph instr) where
  74     ppr (ListGraph blocks) = vcat (map ppr blocks)
  75
  76 instance (Outputable instr) => Outputable (GenBasicBlock instr) where
  77     ppr b = pprBBlock b
  78
  79 instance Outputable CmmStmt where
  80     ppr s = pprStmt s
  81
  82 instance Outputable CmmExpr where
  83     ppr e = pprExpr e
  84
  85 instance Outputable CmmReg where
  86     ppr e = pprReg e
  87
  88 instance Outputable CmmLit where
  89     ppr l = pprLit l
  90
  91 instance Outputable LocalReg where
  92     ppr e = pprLocalReg e
  93
  94 instance Outputable GlobalReg where
  95     ppr e = pprGlobalReg e
  96
  97 instance Outputable CmmStatic where
  98     ppr e = pprStatic e
  99
 100 instance Outputable CmmInfo where
 101     ppr e = pprInfo e
 102
 103
 104
 105 -----------------------------------------------------------------------------
 106
 107 pprCmm :: (Outputable d, Outputable info, Outputable g) => GenCmm d info g -> SDoc
 108 pprCmm (Cmm tops) = vcat $ intersperse (text "") $ map pprTop tops
 109
 110 -- --------------------------------------------------------------------------
 111 -- Top level `procedure' blocks.
 112 --
 113 pprTop  :: (Outputable d, Outputable info, Outputable i)
 114         => GenCmmTop d info i -> SDoc
 115
 116 pprTop (CmmProc info lbl params graph )
 117
 118   = vcat [ pprCLabel lbl <> parens (commafy $ map ppr params) <+> lbrace
 119          , nest 8 $ lbrace <+> ppr info $$ rbrace
 120          , nest 4 $ ppr graph
 121          , rbrace ]
 122
 123 -- --------------------------------------------------------------------------
 124 -- We follow [1], 4.5
 125 --
 126 --      section "data" { ... }
 127 --
 128 pprTop (CmmData section ds) =
 129     (hang (pprSection section <+> lbrace) 4 (vcat (map ppr ds)))
 130     $$ rbrace
 131
 132 -- --------------------------------------------------------------------------
 133 instance Outputable CmmSafety where
 134   ppr CmmUnsafe = ptext (sLit "_unsafe_call_")
 135   ppr (CmmSafe srt) = ppr srt
 136
 137 -- --------------------------------------------------------------------------
 138 -- Info tables. The current pretty printer needs refinement
 139 -- but will work for now.
 140 --
 141 -- For ideas on how to refine it, they used to be printed in the
 142 -- style of C--'s 'stackdata' declaration, just inside the proc body,
 143 -- and were labelled with the procedure name ++ "_info".
 144 pprInfo :: CmmInfo -> SDoc
 145 pprInfo (CmmInfo _gc_target update_frame CmmNonInfoTable) =
 146     vcat [{-ptext (sLit "gc_target: ") <>
 147                 maybe (ptext (sLit "<none>")) pprBlockId gc_target,-}
 148           ptext (sLit "update_frame: ") <>
 149                 maybe (ptext (sLit "<none>")) pprUpdateFrame update_frame]
 150 pprInfo (CmmInfo _gc_target update_frame
 151          (CmmInfoTable (ProfilingInfo closure_type closure_desc) tag info)) =
 152     vcat [{-ptext (sLit "gc_target: ") <>
 153                 maybe (ptext (sLit "<none>")) pprBlockId gc_target,-}
 154           ptext (sLit "update_frame: ") <>
 155                 maybe (ptext (sLit "<none>")) pprUpdateFrame update_frame,
 156           ptext (sLit "type: ") <> pprLit closure_type,
 157           ptext (sLit "desc: ") <> pprLit closure_desc,
 158           ptext (sLit "tag: ") <> integer (toInteger tag),
 159           pprTypeInfo info]
 160
 161 pprTypeInfo :: ClosureTypeInfo -> SDoc
 162 pprTypeInfo (ConstrInfo layout constr descr) =
 163     vcat [ptext (sLit "ptrs: ") <> integer (toInteger (fst layout)),
 164           ptext (sLit "nptrs: ") <> integer (toInteger (snd layout)),
 165           ptext (sLit "constructor: ") <> integer (toInteger constr),
 166           pprLit descr]
 167 pprTypeInfo (FunInfo layout srt fun_type arity _args slow_entry) =
 168     vcat [ptext (sLit "ptrs: ") <> integer (toInteger (fst layout)),
 169           ptext (sLit "nptrs: ") <> integer (toInteger (snd layout)),
 170           ptext (sLit "srt: ") <> ppr srt,
 171           ptext (sLit "fun_type: ") <> integer (toInteger fun_type),
 172           ptext (sLit "arity: ") <> integer (toInteger arity),
 173           --ptext (sLit "args: ") <> ppr args, -- TODO: needs to be printed
 174           ptext (sLit "slow: ") <> pprLit slow_entry
 175          ]
 176 pprTypeInfo (ThunkInfo layout srt) =
 177     vcat [ptext (sLit "ptrs: ") <> integer (toInteger (fst layout)),
 178           ptext (sLit "nptrs: ") <> integer (toInteger (snd layout)),
 179           ptext (sLit "srt: ") <> ppr srt]
 180 pprTypeInfo (ThunkSelectorInfo offset srt) =
 181     vcat [ptext (sLit "ptrs: ") <> integer (toInteger offset),
 182           ptext (sLit "srt: ") <> ppr srt]
 183 pprTypeInfo (ContInfo stack srt) =
 184     vcat [ptext (sLit "stack: ") <> ppr stack,
 185           ptext (sLit "srt: ") <> ppr srt]
 186
 187 pprUpdateFrame :: UpdateFrame -> SDoc
 188 pprUpdateFrame (UpdateFrame expr args) =
 189     hcat [ ptext (sLit "jump")
 190          , space
 191          , if isTrivialCmmExpr expr
 192                 then pprExpr expr
 193                 else case expr of
 194                     CmmLoad (CmmReg _) _ -> pprExpr expr
 195                     _ -> parens (pprExpr expr)
 196          , space
 197          , parens  ( commafy $ map ppr args ) ]
 198
 199
 200 -- --------------------------------------------------------------------------
 201 -- Basic blocks look like assembly blocks.
 202 --      lbl: stmt ; stmt ; ..
 203 pprBBlock :: Outputable stmt => GenBasicBlock stmt -> SDoc
 204 pprBBlock (BasicBlock ident stmts) =
 205     hang (pprBlockId ident <> colon) 4 (vcat (map ppr stmts))
 206
 207 -- --------------------------------------------------------------------------
 208 -- Statements. C-- usually, exceptions to this should be obvious.
 209 --
 210 pprStmt :: CmmStmt -> SDoc
 211 pprStmt stmt = case stmt of
 212
 213     -- ;
 214     CmmNop -> semi
 215
 216     --  // text
 217     CmmComment s -> text "//" <+> ftext s
 218
 219     -- reg = expr;
 220     CmmAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
 221
 222     -- rep[lv] = expr;
 223     CmmStore lv expr -> rep <> brackets(ppr lv) <+> equals <+> ppr expr <> semi
 224         where
 225           rep = ppr ( cmmExprRep expr )
 226
 227     -- call "ccall" foo(x, y)[r1, r2];
 228     -- ToDo ppr volatile
 229     CmmCall (CmmCallee fn cconv) results args safety ret ->
 230         hcat [ if null results
 231                   then empty
 232                   else parens (commafy $ map ppr results) <>
 233                        ptext (sLit " = "),
 234                ptext (sLit "foreign"), space,
 235                doubleQuotes(ppr cconv), space,
 236                target fn, parens  ( commafy $ map ppr args ),
 237                brackets (ppr safety),
 238                case ret of CmmMayReturn -> empty
 239                            CmmNeverReturns -> ptext (sLit " never returns"),
 240                semi ]
 241         where
 242           ---- With the following three functions, I was going somewhere
 243           ---- useful, but I don't remember where.  Probably making
 244           ---- emitted Cmm output look better. ---NR, 2 May 2008
 245           _pp_lhs | null results = empty
 246                   | otherwise    = commafy (map ppr_ar results) <+> equals
 247                 -- Don't print the hints on a native C-- call
 248           ppr_ar arg = case cconv of
 249                             CmmCallConv -> ppr (hintlessCmm arg)
 250                             _           -> doubleQuotes (ppr $ cmmHint arg) <+>
 251                                            ppr (hintlessCmm arg)
 252           _pp_conv = case cconv of
 253                       CmmCallConv -> empty
 254                       _ -> ptext (sLit "foreign") <+> doubleQuotes (ppr cconv)
 255
 256           target (CmmLit lit) = pprLit lit
 257           target fn'          = parens (ppr fn')
 258
 259     CmmCall (CmmPrim op) results args safety ret ->
 260         pprStmt (CmmCall (CmmCallee (CmmLit lbl) CCallConv)
 261                         results args safety ret)
 262         where
 263           lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False)
 264
 265     CmmBranch ident          -> genBranch ident
 266     CmmCondBranch expr ident -> genCondBranch expr ident
 267     CmmJump expr params      -> genJump expr params
 268     CmmReturn params         -> genReturn params
 269     CmmSwitch arg ids        -> genSwitch arg ids
 270
 271 -- --------------------------------------------------------------------------
 272 -- goto local label. [1], section 6.6
 273 --
 274 --     goto lbl;
 275 --
 276 genBranch :: BlockId -> SDoc
 277 genBranch ident =
 278     ptext (sLit "goto") <+> pprBlockId ident <> semi
 279
 280 -- --------------------------------------------------------------------------
 281 -- Conditional. [1], section 6.4
 282 --
 283 --     if (expr) { goto lbl; }
 284 --
 285 genCondBranch :: CmmExpr -> BlockId -> SDoc
 286 genCondBranch expr ident =
 287     hsep [ ptext (sLit "if")
 288          , parens(ppr expr)
 289          , ptext (sLit "goto")
 290          , pprBlockId ident <> semi ]
 291
 292 -- --------------------------------------------------------------------------
 293 -- A tail call. [1], Section 6.9
 294 --
 295 --     jump foo(a, b, c);
 296 --
 297 genJump :: CmmExpr -> [CmmHinted CmmExpr] -> SDoc
 298 genJump expr args =
 299
 300     hcat [ ptext (sLit "jump")
 301          , space
 302          , if isTrivialCmmExpr expr
 303                 then pprExpr expr
 304                 else case expr of
 305                     CmmLoad (CmmReg _) _ -> pprExpr expr
 306                     _ -> parens (pprExpr expr)
 307          , space
 308          , parens  ( commafy $ map pprHinted args )
 309          , semi ]
 310
 311 pprHinted :: Outputable a => (CmmHinted a) -> SDoc
 312 pprHinted (CmmHinted a NoHint)     = ppr a
 313 pprHinted (CmmHinted a PtrHint)    = quotes(text "address") <+> ppr a
 314 pprHinted (CmmHinted a SignedHint) = quotes(text "signed")  <+> ppr a
 315 pprHinted (CmmHinted a FloatHint)  = quotes(text "float")   <+> ppr a
 316
 317 -- --------------------------------------------------------------------------
 318 -- Return from a function. [1], Section 6.8.2 of version 1.128
 319 --
 320 --     return (a, b, c);
 321 --
 322 genReturn :: [CmmHinted CmmExpr] -> SDoc
 323 genReturn args =
 324
 325     hcat [ ptext (sLit "return")
 326          , space
 327          , parens  ( commafy $ map ppr args )
 328          , semi ]
 329
 330 -- --------------------------------------------------------------------------
 331 -- Tabled jump to local label
 332 --
 333 -- The syntax is from [1], section 6.5
 334 --
 335 --      switch [0 .. n] (expr) { case ... ; }
 336 --
 337 genSwitch :: CmmExpr -> [Maybe BlockId] -> SDoc
 338 genSwitch expr maybe_ids
 339
 340     = let pairs = groupBy snds (zip [0 .. ] maybe_ids )
 341
 342       in hang (hcat [ ptext (sLit "switch [0 .. ")
 343                     , int (length maybe_ids - 1)
 344                     , ptext (sLit "] ")
 345                     , if isTrivialCmmExpr expr
 346                         then pprExpr expr
 347                         else parens (pprExpr expr)
 348                     , ptext (sLit " {")
 349                     ])
 350             4 (vcat ( map caseify pairs )) $$ rbrace
 351
 352     where
 353       snds a b = (snd a) == (snd b)
 354
 355       caseify :: [(Int,Maybe BlockId)] -> SDoc
 356       caseify ixs@((_,Nothing):_)
 357         = ptext (sLit "/* impossible: ") <> hcat (intersperse comma (map (int.fst) ixs))
 358                 <> ptext (sLit " */")
 359       caseify as
 360         = let (is,ids) = unzip as
 361           in hsep [ ptext (sLit "case")
 362                   , hcat (punctuate comma (map int is))
 363                   , ptext (sLit ": goto")
 364                   , pprBlockId (head [ id | Just id <- ids]) <> semi ]
 365
 366 -- --------------------------------------------------------------------------
 367 -- Expressions
 368 --
 369
 370 pprExpr :: CmmExpr -> SDoc
 371 pprExpr e
 372     = case e of
 373         CmmRegOff reg i ->
 374                 pprExpr (CmmMachOp (MO_Add rep)
 375                            [CmmReg reg, CmmLit (CmmInt (fromIntegral i) rep)])
 376                 where rep = cmmRegRep reg
 377         CmmLit lit -> pprLit lit
 378         _other     -> pprExpr1 e
 379
 380 -- Here's the precedence table from CmmParse.y:
 381 -- %nonassoc '>=' '>' '<=' '<' '!=' '=='
 382 -- %left '|'
 383 -- %left '^'
 384 -- %left '&'
 385 -- %left '>>' '<<'
 386 -- %left '-' '+'
 387 -- %left '/' '*' '%'
 388 -- %right '~'
 389
 390 -- We just cope with the common operators for now, the rest will get
 391 -- a default conservative behaviour.
 392
 393 -- %nonassoc '>=' '>' '<=' '<' '!=' '=='
 394 pprExpr1, pprExpr7, pprExpr8 :: CmmExpr -> SDoc
 395 pprExpr1 (CmmMachOp op [x,y]) | Just doc <- infixMachOp1 op
 396    = pprExpr7 x <+> doc <+> pprExpr7 y
 397 pprExpr1 e = pprExpr7 e
 398
 399 infixMachOp1, infixMachOp7, infixMachOp8 :: MachOp -> Maybe SDoc
 400
 401 infixMachOp1 (MO_Eq     _) = Just (ptext (sLit "=="))
 402 infixMachOp1 (MO_Ne     _) = Just (ptext (sLit "!="))
 403 infixMachOp1 (MO_Shl    _) = Just (ptext (sLit "<<"))
 404 infixMachOp1 (MO_U_Shr  _) = Just (ptext (sLit ">>"))
 405 infixMachOp1 (MO_U_Ge   _) = Just (ptext (sLit ">="))
 406 infixMachOp1 (MO_U_Le   _) = Just (ptext (sLit "<="))
 407 infixMachOp1 (MO_U_Gt   _) = Just (char '>')
 408 infixMachOp1 (MO_U_Lt   _) = Just (char '<')
 409 infixMachOp1 _             = Nothing
 410
 411 -- %left '-' '+'
 412 pprExpr7 (CmmMachOp (MO_Add rep1) [x, CmmLit (CmmInt i rep2)]) | i < 0
 413    = pprExpr7 (CmmMachOp (MO_Sub rep1) [x, CmmLit (CmmInt (negate i) rep2)])
 414 pprExpr7 (CmmMachOp op [x,y]) | Just doc <- infixMachOp7 op
 415    = pprExpr7 x <+> doc <+> pprExpr8 y
 416 pprExpr7 e = pprExpr8 e
 417
 418 infixMachOp7 (MO_Add _)  = Just (char '+')
 419 infixMachOp7 (MO_Sub _)  = Just (char '-')
 420 infixMachOp7 _           = Nothing
 421
 422 -- %left '/' '*' '%'
 423 pprExpr8 (CmmMachOp op [x,y]) | Just doc <- infixMachOp8 op
 424    = pprExpr8 x <+> doc <+> pprExpr9 y
 425 pprExpr8 e = pprExpr9 e
 426
 427 infixMachOp8 (MO_U_Quot _) = Just (char '/')
 428 infixMachOp8 (MO_Mul _)    = Just (char '*')
 429 infixMachOp8 (MO_U_Rem _)  = Just (char '%')
 430 infixMachOp8 _             = Nothing
 431
 432 pprExpr9 :: CmmExpr -> SDoc
 433 pprExpr9 e =
 434    case e of
 435         CmmLit    lit       -> pprLit1 lit
 436         CmmLoad   expr rep  -> ppr rep <> brackets( ppr expr )
 437         CmmReg    reg       -> ppr reg
 438         CmmRegOff reg off   -> parens (ppr reg <+> char '+' <+> int off)
 439         CmmMachOp mop args  -> genMachOp mop args
 440
 441 genMachOp :: MachOp -> [CmmExpr] -> SDoc
 442 genMachOp mop args
 443    | Just doc <- infixMachOp mop = case args of
 444         -- dyadic
 445         [x,y] -> pprExpr9 x <+> doc <+> pprExpr9 y
 446
 447         -- unary
 448         [x]   -> doc <> pprExpr9 x
 449
 450         _     -> pprTrace "PprCmm.genMachOp: machop with strange number of args"
 451                           (pprMachOp mop <+>
 452                             parens (hcat $ punctuate comma (map pprExpr args)))
 453                           empty
 454
 455    | isJust (infixMachOp1 mop)
 456    || isJust (infixMachOp7 mop)
 457    || isJust (infixMachOp8 mop)  = parens (pprExpr (CmmMachOp mop args))
 458
 459    | otherwise = char '%' <> ppr_op <> parens (commafy (map pprExpr args))
 460         where ppr_op = text (map (\c -> if c == ' ' then '_' else c)
 461                                  (show mop))
 462                 -- replace spaces in (show mop) with underscores,
 463
 464 --
 465 -- Unsigned ops on the word size of the machine get nice symbols.
 466 -- All else get dumped in their ugly format.
 467 --
 468 infixMachOp :: MachOp -> Maybe SDoc
 469 infixMachOp mop
 470         = case mop of
 471             MO_And    _ -> Just $ char '&'
 472             MO_Or     _ -> Just $ char '|'
 473             MO_Xor    _ -> Just $ char '^'
 474             MO_Not    _ -> Just $ char '~'
 475             MO_S_Neg  _ -> Just $ char '-' -- there is no unsigned neg :)
 476             _ -> Nothing
 477
 478 -- --------------------------------------------------------------------------
 479 -- Literals.
 480 --  To minimise line noise we adopt the convention that if the literal
 481 --  has the natural machine word size, we do not append the type
 482 --
 483 pprLit :: CmmLit -> SDoc
 484 pprLit lit = case lit of
 485     CmmInt i rep ->
 486         hcat [ (if i < 0 then parens else id)(integer i)
 487              , (if rep == wordRep
 488                     then empty
 489                     else space <> dcolon <+> ppr rep) ]
 490
 491     CmmFloat f rep     -> hsep [ rational f, dcolon, ppr rep ]
 492     CmmLabel clbl      -> pprCLabel clbl
 493     CmmLabelOff clbl i -> pprCLabel clbl <> ppr_offset i
 494     CmmLabelDiffOff clbl1 clbl2 i -> pprCLabel clbl1 <> char '-'
 495                                   <> pprCLabel clbl2 <> ppr_offset i
 496
 497 pprLit1 :: CmmLit -> SDoc
 498 pprLit1 lit@(CmmLabelOff {}) = parens (pprLit lit)
 499 pprLit1 lit                  = pprLit lit
 500
 501 ppr_offset :: Int -> SDoc
 502 ppr_offset i
 503     | i==0      = empty
 504     | i>=0      = char '+' <> int i
 505     | otherwise = char '-' <> int (-i)
 506
 507 -- --------------------------------------------------------------------------
 508 -- Static data.
 509 --      Strings are printed as C strings, and we print them as I8[],
 510 --      following C--
 511 --
 512 pprStatic :: CmmStatic -> SDoc
 513 pprStatic s = case s of
 514     CmmStaticLit lit   -> nest 4 $ ptext (sLit "const") <+> pprLit lit <> semi
 515     CmmUninitialised i -> nest 4 $ text "I8" <> brackets (int i)
 516     CmmAlign i         -> nest 4 $ text "align" <+> int i
 517     CmmDataLabel clbl  -> pprCLabel clbl <> colon
 518     CmmString s'       -> nest 4 $ text "I8[]" <+> text (show s')
 519
 520 -- --------------------------------------------------------------------------
 521 -- Registers, whether local (temps) or global
 522 --
 523 pprReg :: CmmReg -> SDoc
 524 pprReg r
 525     = case r of
 526         CmmLocal  local  -> pprLocalReg local
 527         CmmGlobal global -> pprGlobalReg global
 528
 529 --
 530 -- We only print the type of the local reg if it isn't wordRep
 531 --
 532 pprLocalReg :: LocalReg -> SDoc
 533 pprLocalReg (LocalReg uniq rep follow)
 534     = hcat [ char '_', ppr uniq, ty ] where
 535   ty = if rep == wordRep && follow == GCKindNonPtr
 536                 then empty
 537                 else dcolon <> ptr <> ppr rep
 538   ptr = if follow == GCKindNonPtr
 539                 then empty
 540                 else doubleQuotes (text "ptr")
 541
 542 -- needs to be kept in syn with Cmm.hs.GlobalReg
 543 --
 544 pprGlobalReg :: GlobalReg -> SDoc
 545 pprGlobalReg gr
 546     = case gr of
 547         VanillaReg n   -> char 'R' <> int n
 548         FloatReg   n   -> char 'F' <> int n
 549         DoubleReg  n   -> char 'D' <> int n
 550         LongReg    n   -> char 'L' <> int n
 551         Sp             -> ptext (sLit "Sp")
 552         SpLim          -> ptext (sLit "SpLim")
 553         Hp             -> ptext (sLit "Hp")
 554         HpLim          -> ptext (sLit "HpLim")
 555         CurrentTSO     -> ptext (sLit "CurrentTSO")
 556         CurrentNursery -> ptext (sLit "CurrentNursery")
 557         HpAlloc        -> ptext (sLit "HpAlloc")
 558         GCEnter1       -> ptext (sLit "stg_gc_enter_1")
 559         GCFun          -> ptext (sLit "stg_gc_fun")
 560         BaseReg        -> ptext (sLit "BaseReg")
 561         PicBaseReg     -> ptext (sLit "PicBaseReg")
 562
 563 -- --------------------------------------------------------------------------
 564 -- data sections
 565 --
 566 pprSection :: Section -> SDoc
 567 pprSection s = case s of
 568     Text              -> section <+> doubleQuotes (ptext (sLit "text"))
 569     Data              -> section <+> doubleQuotes (ptext (sLit "data"))
 570     ReadOnlyData      -> section <+> doubleQuotes (ptext (sLit "readonly"))
 571     ReadOnlyData16    -> section <+> doubleQuotes (ptext (sLit "readonly16"))
 572     RelocatableReadOnlyData
 573                       -> section <+> doubleQuotes (ptext (sLit "relreadonly"))
 574     UninitialisedData -> section <+> doubleQuotes (ptext (sLit "uninitialised"))
 575     OtherSection s'   -> section <+> doubleQuotes (text s')
 576  where
 577     section = ptext (sLit "section")
 578
 579 -- --------------------------------------------------------------------------
 580 -- Basic block ids
 581 --
 582 pprBlockId :: BlockId -> SDoc
 583 pprBlockId b = ppr $ getUnique b
 584
 585 -----------------------------------------------------------------------------
 586
 587 commafy :: [SDoc] -> SDoc
 588 commafy xs = fsep $ punctuate comma xs