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