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