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