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