compiler/cmm/PprCmm.hs

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