-- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs
--
-module PprCmm (
- writeCmms, pprCmms, pprCmm, pprStmt, pprExpr
- ) where
-
-#include "HsVersions.h"
+module PprCmm
+ ( writeCmms, pprCmms, pprCmm, pprStmt, pprExpr,
+ pprSection, pprStatic, pprLit
+ )
+where
+import BlockId
import Cmm
import CmmUtils
-import MachOp
import CLabel
+import BasicTypes
+
import ForeignCall
-import Unique
import Outputable
import FastString
import System.IO
import Data.Maybe
-pprCmms :: (Outputable info) => [GenCmm CmmStatic info CmmStmt] -> SDoc
+-- Temp Jan08
+import SMRep
+import ClosureInfo
+#include "../includes/rts/storage/FunTypes.h"
+
+
+pprCmms :: (Outputable info, Outputable g) => [GenCmm CmmStatic info g] -> SDoc
pprCmms cmms = pprCode CStyle (vcat (intersperse separator $ map ppr cmms))
where
- separator = space $$ ptext SLIT("-------------------") $$ space
+ separator = space $$ ptext (sLit "-------------------") $$ space
writeCmms :: Handle -> [Cmm] -> IO ()
writeCmms handle cmms = printForC handle (pprCmms cmms)
-----------------------------------------------------------------------------
-instance (Outputable info) => Outputable (GenCmm CmmStatic info CmmStmt) where
+instance (Outputable d, Outputable info, Outputable g)
+ => Outputable (GenCmm d info g) where
ppr c = pprCmm c
-instance (Outputable info) => Outputable (GenCmmTop CmmStatic info CmmStmt) where
+instance (Outputable d, Outputable info, Outputable i)
+ => Outputable (GenCmmTop d info i) where
ppr t = pprTop t
-instance Outputable CmmBasicBlock where
+instance (Outputable instr) => Outputable (ListGraph instr) where
+ ppr (ListGraph blocks) = vcat (map ppr blocks)
+
+instance (Outputable instr) => Outputable (GenBasicBlock instr) where
ppr b = pprBBlock b
instance Outputable CmmStmt where
instance Outputable CmmReg where
ppr e = pprReg e
+instance Outputable CmmLit where
+ ppr l = pprLit l
+
instance Outputable LocalReg where
ppr e = pprLocalReg e
+instance Outputable Area where
+ ppr e = pprArea e
+
instance Outputable GlobalReg where
ppr e = pprGlobalReg e
instance Outputable CmmInfo where
ppr e = pprInfo e
+
+
-----------------------------------------------------------------------------
-pprCmm :: (Outputable info) => GenCmm CmmStatic info CmmStmt -> SDoc
-pprCmm (Cmm tops) = vcat $ intersperse (text "") $ map pprTop tops
+pprCmm :: (Outputable d, Outputable info, Outputable g) => GenCmm d info g -> SDoc
+pprCmm (Cmm tops) = vcat $ intersperse blankLine $ map pprTop tops
-- --------------------------------------------------------------------------
-- Top level `procedure' blocks.
--
-pprTop :: (Outputable info) => GenCmmTop CmmStatic info CmmStmt -> SDoc
-pprTop (CmmProc info lbl params blocks )
+pprTop :: (Outputable d, Outputable info, Outputable i)
+ => GenCmmTop d info i -> SDoc
- = vcat [ pprCLabel lbl <> parens (commafy $ map ppr params) <+> lbrace
+pprTop (CmmProc info lbl params graph )
+
+ = vcat [ pprCLabel lbl <> parens (commafy $ map ppr params)
, nest 8 $ lbrace <+> ppr info $$ rbrace
- , nest 4 $ vcat (map ppr blocks)
+ , nest 4 $ ppr graph
, rbrace ]
-- --------------------------------------------------------------------------
-- section "data" { ... }
--
pprTop (CmmData section ds) =
- (hang (pprSection section <+> lbrace) 4 (vcat (map pprStatic ds)))
+ (hang (pprSection section <+> lbrace) 4 (vcat (map ppr ds)))
$$ rbrace
-- --------------------------------------------------------------------------
instance Outputable CmmSafety where
- ppr CmmUnsafe = ptext SLIT("_unsafe_call_")
+ ppr CmmUnsafe = ptext (sLit "_unsafe_call_")
ppr (CmmSafe srt) = ppr srt
+ ppr CmmInterruptible = ptext (sLit "_interruptible_call_")
-- --------------------------------------------------------------------------
-- Info tables. The current pretty printer needs refinement
-- For ideas on how to refine it, they used to be printed in the
-- style of C--'s 'stackdata' declaration, just inside the proc body,
-- and were labelled with the procedure name ++ "_info".
-pprInfo (CmmNonInfo gc_target) =
- ptext SLIT("gc_target: ") <>
- ptext SLIT("TODO") --maybe (ptext SLIT("<none>")) pprBlockId gc_target
- -- ^ gc_target is currently unused and wired to a panic
-pprInfo (CmmInfo (ProfilingInfo closure_type closure_desc)
- gc_target tag info) =
- vcat [ptext SLIT("type: ") <> pprLit closure_type,
- ptext SLIT("desc: ") <> pprLit closure_desc,
- ptext SLIT("gc_target: ") <>
- ptext SLIT("TODO"), --maybe (ptext SLIT("<none>")) pprBlockId gc_target,
- -- ^ gc_target is currently unused and wired to a panic
- ptext SLIT("tag: ") <> integer (toInteger tag),
+pprInfo :: CmmInfo -> SDoc
+pprInfo (CmmInfo _gc_target update_frame CmmNonInfoTable) =
+ vcat [{-ptext (sLit "gc_target: ") <>
+ maybe (ptext (sLit "<none>")) ppr gc_target,-}
+ ptext (sLit "update_frame: ") <>
+ maybe (ptext (sLit "<none>")) pprUpdateFrame update_frame]
+pprInfo (CmmInfo _gc_target update_frame
+ (CmmInfoTable stat_clos (ProfilingInfo closure_type closure_desc) tag info)) =
+ vcat [{-ptext (sLit "gc_target: ") <>
+ maybe (ptext (sLit "<none>")) ppr gc_target,-}
+ ptext (sLit "has static closure: ") <> ppr stat_clos <+>
+ ptext (sLit "update_frame: ") <>
+ maybe (ptext (sLit "<none>")) pprUpdateFrame update_frame,
+ ptext (sLit "type: ") <> pprLit closure_type,
+ ptext (sLit "desc: ") <> pprLit closure_desc,
+ ptext (sLit "tag: ") <> integer (toInteger tag),
pprTypeInfo info]
+pprTypeInfo :: ClosureTypeInfo -> SDoc
pprTypeInfo (ConstrInfo layout constr descr) =
- vcat [ptext SLIT("ptrs: ") <> integer (toInteger (fst layout)),
- ptext SLIT("nptrs: ") <> integer (toInteger (snd layout)),
- ptext SLIT("constructor: ") <> integer (toInteger constr),
+ vcat [ptext (sLit "ptrs: ") <> integer (toInteger (fst layout)),
+ ptext (sLit "nptrs: ") <> integer (toInteger (snd layout)),
+ ptext (sLit "constructor: ") <> integer (toInteger constr),
pprLit descr]
-pprTypeInfo (FunInfo layout srt fun_type arity args slow_entry) =
- vcat [ptext SLIT("ptrs: ") <> integer (toInteger (fst layout)),
- ptext SLIT("nptrs: ") <> integer (toInteger (snd layout)),
- ptext SLIT("srt: ") <> ppr srt,
- ptext SLIT("fun_type: ") <> integer (toInteger fun_type),
- ptext SLIT("arity: ") <> integer (toInteger arity)
- --ppr args, -- TODO: needs to be printed
- --ppr slow_entry -- TODO: needs to be printed
+pprTypeInfo (FunInfo layout srt arity _args slow_entry) =
+ vcat [ptext (sLit "ptrs: ") <> integer (toInteger (fst layout)),
+ ptext (sLit "nptrs: ") <> integer (toInteger (snd layout)),
+ ptext (sLit "srt: ") <> ppr srt,
+-- Temp Jan08
+ ptext (sLit ("fun_type: ")) <> integer (toInteger (argDescrType _args)),
+
+ ptext (sLit "arity: ") <> integer (toInteger arity),
+ --ptext (sLit "args: ") <> ppr args, -- TODO: needs to be printed
+ ptext (sLit "slow: ") <> pprLit slow_entry
]
pprTypeInfo (ThunkInfo layout srt) =
- vcat [ptext SLIT("ptrs: ") <> integer (toInteger (fst layout)),
- ptext SLIT("nptrs: ") <> integer (toInteger (snd layout)),
- ptext SLIT("srt: ") <> ppr srt]
+ vcat [ptext (sLit "ptrs: ") <> integer (toInteger (fst layout)),
+ ptext (sLit "nptrs: ") <> integer (toInteger (snd layout)),
+ ptext (sLit "srt: ") <> ppr srt]
pprTypeInfo (ThunkSelectorInfo offset srt) =
- vcat [ptext SLIT("ptrs: ") <> integer (toInteger offset),
- ptext SLIT("srt: ") <> ppr srt]
+ vcat [ptext (sLit "ptrs: ") <> integer (toInteger offset),
+ ptext (sLit "srt: ") <> ppr srt]
pprTypeInfo (ContInfo stack srt) =
- vcat [ptext SLIT("stack: ") <> ppr stack,
- ptext SLIT("srt: ") <> ppr srt]
+ vcat [ptext (sLit "stack: ") <> ppr stack,
+ ptext (sLit "srt: ") <> ppr srt]
+
+-- Temp Jan08
+argDescrType :: ArgDescr -> StgHalfWord
+-- The "argument type" RTS field type
+argDescrType (ArgSpec n) = n
+argDescrType (ArgGen liveness)
+ | isBigLiveness liveness = ARG_GEN_BIG
+ | otherwise = ARG_GEN
+
+-- Temp Jan08
+isBigLiveness :: Liveness -> Bool
+isBigLiveness (BigLiveness _) = True
+isBigLiveness (SmallLiveness _) = False
+
+
+pprUpdateFrame :: UpdateFrame -> SDoc
+pprUpdateFrame (UpdateFrame expr args) =
+ hcat [ ptext (sLit "jump")
+ , space
+ , if isTrivialCmmExpr expr
+ then pprExpr expr
+ else case expr of
+ CmmLoad (CmmReg _) _ -> pprExpr expr
+ _ -> parens (pprExpr expr)
+ , space
+ , parens ( commafy $ map ppr args ) ]
+
-- --------------------------------------------------------------------------
-- Basic blocks look like assembly blocks.
-- lbl: stmt ; stmt ; ..
-pprBBlock :: CmmBasicBlock -> SDoc
+pprBBlock :: Outputable stmt => GenBasicBlock stmt -> SDoc
pprBBlock (BasicBlock ident stmts) =
- hang (pprBlockId ident <> colon) 4 (vcat (map ppr stmts))
+ hang (ppr ident <> colon) 4 (vcat (map ppr stmts))
-- --------------------------------------------------------------------------
-- Statements. C-- usually, exceptions to this should be obvious.
-- rep[lv] = expr;
CmmStore lv expr -> rep <> brackets(ppr lv) <+> equals <+> ppr expr <> semi
where
- rep = ppr ( cmmExprRep expr )
+ rep = ppr ( cmmExprType expr )
-- call "ccall" foo(x, y)[r1, r2];
-- ToDo ppr volatile
- CmmCall (CmmForeignCall fn cconv) results args safety ->
- hcat [ if null results
- then empty
- else parens (commafy $ map ppr results) <>
- ptext SLIT(" = "),
- ptext SLIT("call"), space,
- doubleQuotes(ppr cconv), space,
- target fn, parens ( commafy $ map ppr args ),
- brackets (ppr safety), semi ]
+ CmmCall (CmmCallee fn cconv) results args safety ret ->
+ sep [ pp_lhs <+> pp_conv
+ , nest 2 (pprExpr9 fn <>
+ parens (commafy (map ppr_ar args)))
+ <> brackets (ppr safety)
+ , case ret of CmmMayReturn -> empty
+ CmmNeverReturns -> ptext $ sLit (" never returns")
+ ] <> semi
where
- target (CmmLit lit) = pprLit lit
- target fn' = parens (ppr fn')
-
- CmmCall (CmmPrim op) results args safety ->
- pprStmt (CmmCall (CmmForeignCall (CmmLit lbl) CCallConv)
- results args safety)
+ pp_lhs | null results = empty
+ | otherwise = commafy (map ppr_ar results) <+> equals
+ -- Don't print the hints on a native C-- call
+
+ ppr_ar :: Outputable a => CmmHinted a -> SDoc
+ ppr_ar (CmmHinted ar k) = case cconv of
+ CmmCallConv -> ppr ar
+ _ -> ppr (ar,k)
+ pp_conv = case cconv of
+ CmmCallConv -> empty
+ _ -> ptext (sLit("foreign")) <+> doubleQuotes (ppr cconv)
+
+ -- Call a CallishMachOp, like sin or cos that might be implemented as a library call.
+ CmmCall (CmmPrim op) results args safety ret ->
+ pprStmt (CmmCall (CmmCallee (CmmLit lbl) CCallConv)
+ results args safety ret)
where
- lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False)
+ -- HACK: A CallishMachOp doesn't really correspond to a ForeignLabel, but we
+ -- use one to get the label printed.
+ lbl = CmmLabel (mkForeignLabel
+ (mkFastString (show op))
+ Nothing ForeignLabelInThisPackage IsFunction)
CmmBranch ident -> genBranch ident
CmmCondBranch expr ident -> genCondBranch expr ident
CmmReturn params -> genReturn params
CmmSwitch arg ids -> genSwitch arg ids
+instance Outputable ForeignHint where
+ ppr NoHint = empty
+ ppr SignedHint = quotes(text "signed")
+-- ppr AddrHint = quotes(text "address")
+-- Temp Jan08
+ ppr AddrHint = (text "PtrHint")
+
+-- Just look like a tuple, since it was a tuple before
+-- ... is that a good idea? --Isaac Dupree
+instance (Outputable a) => Outputable (CmmHinted a) where
+ ppr (CmmHinted a k) = ppr (a, k)
+
-- --------------------------------------------------------------------------
-- goto local label. [1], section 6.6
--
--
genBranch :: BlockId -> SDoc
genBranch ident =
- ptext SLIT("goto") <+> pprBlockId ident <> semi
+ ptext (sLit "goto") <+> ppr ident <> semi
-- --------------------------------------------------------------------------
-- Conditional. [1], section 6.4
--
genCondBranch :: CmmExpr -> BlockId -> SDoc
genCondBranch expr ident =
- hsep [ ptext SLIT("if")
+ hsep [ ptext (sLit "if")
, parens(ppr expr)
- , ptext SLIT("goto")
- , pprBlockId ident <> semi ]
+ , ptext (sLit "goto")
+ , ppr ident <> semi ]
-- --------------------------------------------------------------------------
-- A tail call. [1], Section 6.9
--
-- jump foo(a, b, c);
--
-genJump :: CmmExpr -> [(CmmExpr, MachHint)] -> SDoc
+genJump :: CmmExpr -> [CmmHinted CmmExpr] -> SDoc
genJump expr args =
-
- hcat [ ptext SLIT("jump")
+ hcat [ ptext (sLit "jump")
, space
, if isTrivialCmmExpr expr
then pprExpr expr
, parens ( commafy $ map ppr args )
, semi ]
+
-- --------------------------------------------------------------------------
-- Return from a function. [1], Section 6.8.2 of version 1.128
--
-- return (a, b, c);
--
-genReturn :: [(CmmExpr, MachHint)] -> SDoc
+genReturn :: [CmmHinted CmmExpr] -> SDoc
genReturn args =
-
- hcat [ ptext SLIT("return")
+ hcat [ ptext (sLit "return")
, space
, parens ( commafy $ map ppr args )
, semi ]
= let pairs = groupBy snds (zip [0 .. ] maybe_ids )
- in hang (hcat [ ptext SLIT("switch [0 .. ")
+ in hang (hcat [ ptext (sLit "switch [0 .. ")
, int (length maybe_ids - 1)
- , ptext SLIT("] ")
+ , ptext (sLit "] ")
, if isTrivialCmmExpr expr
then pprExpr expr
else parens (pprExpr expr)
- , ptext SLIT(" {")
+ , ptext (sLit " {")
])
4 (vcat ( map caseify pairs )) $$ rbrace
snds a b = (snd a) == (snd b)
caseify :: [(Int,Maybe BlockId)] -> SDoc
- caseify ixs@((i,Nothing):_)
- = ptext SLIT("/* impossible: ") <> hcat (intersperse comma (map (int.fst) ixs))
- <> ptext SLIT(" */")
+ caseify ixs@((_,Nothing):_)
+ = ptext (sLit "/* impossible: ") <> hcat (intersperse comma (map (int.fst) ixs))
+ <> ptext (sLit " */")
caseify as
= let (is,ids) = unzip as
- in hsep [ ptext SLIT("case")
+ in hsep [ ptext (sLit "case")
, hcat (punctuate comma (map int is))
- , ptext SLIT(": goto")
- , pprBlockId (head [ id | Just id <- ids]) <> semi ]
+ , ptext (sLit ": goto")
+ , ppr (head [ id | Just id <- ids]) <> semi ]
-- --------------------------------------------------------------------------
-- Expressions
CmmRegOff reg i ->
pprExpr (CmmMachOp (MO_Add rep)
[CmmReg reg, CmmLit (CmmInt (fromIntegral i) rep)])
- where rep = cmmRegRep reg
+ where rep = typeWidth (cmmRegType reg)
CmmLit lit -> pprLit lit
_other -> pprExpr1 e
-- a default conservative behaviour.
-- %nonassoc '>=' '>' '<=' '<' '!=' '=='
+pprExpr1, pprExpr7, pprExpr8 :: CmmExpr -> SDoc
pprExpr1 (CmmMachOp op [x,y]) | Just doc <- infixMachOp1 op
= pprExpr7 x <+> doc <+> pprExpr7 y
pprExpr1 e = pprExpr7 e
-infixMachOp1 (MO_Eq _) = Just (ptext SLIT("=="))
-infixMachOp1 (MO_Ne _) = Just (ptext SLIT("!="))
-infixMachOp1 (MO_Shl _) = Just (ptext SLIT("<<"))
-infixMachOp1 (MO_U_Shr _) = Just (ptext SLIT(">>"))
-infixMachOp1 (MO_U_Ge _) = Just (ptext SLIT(">="))
-infixMachOp1 (MO_U_Le _) = Just (ptext SLIT("<="))
+infixMachOp1, infixMachOp7, infixMachOp8 :: MachOp -> Maybe SDoc
+
+infixMachOp1 (MO_Eq _) = Just (ptext (sLit "=="))
+infixMachOp1 (MO_Ne _) = Just (ptext (sLit "!="))
+infixMachOp1 (MO_Shl _) = Just (ptext (sLit "<<"))
+infixMachOp1 (MO_U_Shr _) = Just (ptext (sLit ">>"))
+infixMachOp1 (MO_U_Ge _) = Just (ptext (sLit ">="))
+infixMachOp1 (MO_U_Le _) = Just (ptext (sLit "<="))
infixMachOp1 (MO_U_Gt _) = Just (char '>')
infixMachOp1 (MO_U_Lt _) = Just (char '<')
infixMachOp1 _ = Nothing
CmmLit lit -> pprLit1 lit
CmmLoad expr rep -> ppr rep <> brackets( ppr expr )
CmmReg reg -> ppr reg
- CmmRegOff reg off -> parens (ppr reg <+> char '+' <+> int off)
+ CmmRegOff reg off -> parens (ppr reg <+> char '+' <+> int off)
+ CmmStackSlot a off -> parens (ppr a <+> char '+' <+> int off)
CmmMachOp mop args -> genMachOp mop args
genMachOp :: MachOp -> [CmmExpr] -> SDoc
pprLit lit = case lit of
CmmInt i rep ->
hcat [ (if i < 0 then parens else id)(integer i)
- , (if rep == wordRep
- then empty
- else space <> dcolon <+> ppr rep) ]
+ , ppUnless (rep == wordWidth) $
+ space <> dcolon <+> ppr rep ]
CmmFloat f rep -> hsep [ rational f, dcolon, ppr rep ]
CmmLabel clbl -> pprCLabel clbl
CmmLabelOff clbl i -> pprCLabel clbl <> ppr_offset i
CmmLabelDiffOff clbl1 clbl2 i -> pprCLabel clbl1 <> char '-'
<> pprCLabel clbl2 <> ppr_offset i
+ CmmBlock id -> ppr id
+ CmmHighStackMark -> text "<highSp>"
-pprLit1 lit@(CmmLabelOff clbl i) = parens (pprLit lit)
-pprLit1 lit = pprLit lit
+pprLit1 :: CmmLit -> SDoc
+pprLit1 lit@(CmmLabelOff {}) = parens (pprLit lit)
+pprLit1 lit = pprLit lit
ppr_offset :: Int -> SDoc
ppr_offset i
--
pprStatic :: CmmStatic -> SDoc
pprStatic s = case s of
- CmmStaticLit lit -> nest 4 $ ptext SLIT("const") <+> pprLit lit <> semi
+ CmmStaticLit lit -> nest 4 $ ptext (sLit "const") <+> pprLit lit <> semi
CmmUninitialised i -> nest 4 $ text "I8" <> brackets (int i)
CmmAlign i -> nest 4 $ text "align" <+> int i
CmmDataLabel clbl -> pprCLabel clbl <> colon
pprReg :: CmmReg -> SDoc
pprReg r
= case r of
- CmmLocal local -> pprLocalReg local
+ CmmLocal local -> pprLocalReg local
CmmGlobal global -> pprGlobalReg global
--
-- We only print the type of the local reg if it isn't wordRep
--
pprLocalReg :: LocalReg -> SDoc
-pprLocalReg (LocalReg uniq rep follow)
- = hcat [ char '_', ppr uniq, ty ] where
- ty = if rep == wordRep && follow == KindNonPtr
- then empty
- else dcolon <> ptr <> ppr rep
- ptr = if follow == KindNonPtr
- then empty
- else doubleQuotes (text "ptr")
+pprLocalReg (LocalReg uniq rep)
+-- = ppr rep <> char '_' <> ppr uniq
+-- Temp Jan08
+ = char '_' <> ppr uniq <>
+ (if isWord32 rep -- && not (isGcPtrType rep) -- Temp Jan08 -- sigh
+ then dcolon <> ptr <> ppr rep
+ else dcolon <> ptr <> ppr rep)
+ where
+ ptr = empty
+ --if isGcPtrType rep
+ -- then doubleQuotes (text "ptr")
+ -- else empty
+
+-- Stack areas
+pprArea :: Area -> SDoc
+pprArea (RegSlot r) = hcat [ text "slot<", ppr r, text ">" ]
+pprArea (CallArea id) = pprAreaId id
+
+pprAreaId :: AreaId -> SDoc
+pprAreaId Old = text "old"
+pprAreaId (Young id) = hcat [ text "young<", ppr id, text ">" ]
-- needs to be kept in syn with Cmm.hs.GlobalReg
--
pprGlobalReg :: GlobalReg -> SDoc
pprGlobalReg gr
= case gr of
- VanillaReg n -> char 'R' <> int n
+ VanillaReg n _ -> char 'R' <> int n
+-- Temp Jan08
+-- VanillaReg n VNonGcPtr -> char 'R' <> int n
+-- VanillaReg n VGcPtr -> char 'P' <> int n
FloatReg n -> char 'F' <> int n
DoubleReg n -> char 'D' <> int n
LongReg n -> char 'L' <> int n
- Sp -> ptext SLIT("Sp")
- SpLim -> ptext SLIT("SpLim")
- Hp -> ptext SLIT("Hp")
- HpLim -> ptext SLIT("HpLim")
- CurrentTSO -> ptext SLIT("CurrentTSO")
- CurrentNursery -> ptext SLIT("CurrentNursery")
- HpAlloc -> ptext SLIT("HpAlloc")
- GCEnter1 -> ptext SLIT("stg_gc_enter_1")
- GCFun -> ptext SLIT("stg_gc_fun")
- BaseReg -> ptext SLIT("BaseReg")
- PicBaseReg -> ptext SLIT("PicBaseReg")
+ Sp -> ptext (sLit "Sp")
+ SpLim -> ptext (sLit "SpLim")
+ Hp -> ptext (sLit "Hp")
+ HpLim -> ptext (sLit "HpLim")
+ CurrentTSO -> ptext (sLit "CurrentTSO")
+ CurrentNursery -> ptext (sLit "CurrentNursery")
+ HpAlloc -> ptext (sLit "HpAlloc")
+ EagerBlackholeInfo -> ptext (sLit "stg_EAGER_BLACKHOLE_info")
+ GCEnter1 -> ptext (sLit "stg_gc_enter_1")
+ GCFun -> ptext (sLit "stg_gc_fun")
+ BaseReg -> ptext (sLit "BaseReg")
+ PicBaseReg -> ptext (sLit "PicBaseReg")
-- --------------------------------------------------------------------------
-- data sections
--
pprSection :: Section -> SDoc
pprSection s = case s of
- Text -> section <+> doubleQuotes (ptext SLIT("text"))
- Data -> section <+> doubleQuotes (ptext SLIT("data"))
- ReadOnlyData -> section <+> doubleQuotes (ptext SLIT("readonly"))
+ Text -> section <+> doubleQuotes (ptext (sLit "text"))
+ Data -> section <+> doubleQuotes (ptext (sLit "data"))
+ ReadOnlyData -> section <+> doubleQuotes (ptext (sLit "readonly"))
+ ReadOnlyData16 -> section <+> doubleQuotes (ptext (sLit "readonly16"))
RelocatableReadOnlyData
- -> section <+> doubleQuotes (ptext SLIT("relreadonly"))
- UninitialisedData -> section <+> doubleQuotes (ptext SLIT("uninitialised"))
+ -> section <+> doubleQuotes (ptext (sLit "relreadonly"))
+ UninitialisedData -> section <+> doubleQuotes (ptext (sLit "uninitialised"))
OtherSection s' -> section <+> doubleQuotes (text s')
where
- section = ptext SLIT("section")
-
--- --------------------------------------------------------------------------
--- Basic block ids
---
-pprBlockId :: BlockId -> SDoc
-pprBlockId b = ppr $ getUnique b
+ section = ptext (sLit "section")
-----------------------------------------------------------------------------
commafy :: [SDoc] -> SDoc
-commafy xs = hsep $ punctuate comma xs
-
+commafy xs = fsep $ punctuate comma xs
projects / ghc-hetmet.git / blobdiff