diff options
author | Ian Lynagh <igloo@earth.li> | 2011-10-02 01:31:05 +0100 |
---|---|---|
committer | Ian Lynagh <igloo@earth.li> | 2011-10-02 16:39:08 +0100 |
commit | ac7a7eb93397a2343402f77f1a8a8b4a0e0298df (patch) | |
tree | 86fae1d7598b2ddb94b1c00906468eb54af9a48e /compiler/cmm/PprCmmDecl.hs | |
parent | d8d161749c8b13c3db802f348761cff662741c53 (diff) | |
download | haskell-ac7a7eb93397a2343402f77f1a8a8b4a0e0298df.tar.gz |
More CPP removal: pprDynamicLinkerAsmLabel in CLabel
And some knock-on changes
Diffstat (limited to 'compiler/cmm/PprCmmDecl.hs')
-rw-r--r-- | compiler/cmm/PprCmmDecl.hs | 64 |
1 files changed, 35 insertions, 29 deletions
diff --git a/compiler/cmm/PprCmmDecl.hs b/compiler/cmm/PprCmmDecl.hs index 5cd3501b11..370428d750 100644 --- a/compiler/cmm/PprCmmDecl.hs +++ b/compiler/cmm/PprCmmDecl.hs @@ -53,49 +53,51 @@ import SMRep #include "../includes/rts/storage/FunTypes.h" -pprCmms :: (Outputable info, PlatformOutputable g) +pprCmms :: (PlatformOutputable info, PlatformOutputable g) => Platform -> [GenCmmGroup CmmStatics info g] -> SDoc pprCmms platform cmms = pprCode CStyle (vcat (intersperse separator $ map (pprPlatform platform) cmms)) where separator = space $$ ptext (sLit "-------------------") $$ space -writeCmms :: (Outputable info, PlatformOutputable g) +writeCmms :: (PlatformOutputable info, PlatformOutputable g) => Platform -> Handle -> [GenCmmGroup CmmStatics info g] -> IO () writeCmms platform handle cmms = printForC handle (pprCmms platform cmms) ----------------------------------------------------------------------------- -instance (Outputable d, Outputable info, PlatformOutputable i) +instance (PlatformOutputable d, PlatformOutputable info, PlatformOutputable i) => PlatformOutputable (GenCmmDecl d info i) where pprPlatform platform t = pprTop platform t -instance Outputable CmmStatics where - ppr e = pprStatics e +instance PlatformOutputable CmmStatics where + pprPlatform = pprStatics -instance Outputable CmmStatic where - ppr e = pprStatic e +instance PlatformOutputable CmmStatic where + pprPlatform = pprStatic -instance Outputable CmmInfoTable where - ppr e = pprInfoTable e +instance PlatformOutputable CmmInfoTable where + pprPlatform = pprInfoTable ----------------------------------------------------------------------------- -pprCmmGroup :: (Outputable d, Outputable info, PlatformOutputable g) - => Platform -> GenCmmGroup d info g -> SDoc +pprCmmGroup :: (PlatformOutputable d, + PlatformOutputable info, + PlatformOutputable g) + => Platform -> GenCmmGroup d info g -> SDoc pprCmmGroup platform tops = vcat $ intersperse blankLine $ map (pprTop platform) tops -- -------------------------------------------------------------------------- -- Top level `procedure' blocks. -- -pprTop :: (Outputable d, Outputable info, PlatformOutputable i) +pprTop :: (PlatformOutputable d, PlatformOutputable info, PlatformOutputable i) => Platform -> GenCmmDecl d info i -> SDoc pprTop platform (CmmProc info lbl graph) - = vcat [ pprCLabel lbl <> lparen <> rparen - , nest 8 $ lbrace <+> ppr info $$ rbrace + = vcat [ pprCLabel platform lbl <> lparen <> rparen + , nest 8 $ lbrace <+> pprPlatform platform info $$ rbrace , nest 4 $ pprPlatform platform graph , rbrace ] @@ -104,30 +106,32 @@ pprTop platform (CmmProc info lbl graph) -- -- section "data" { ... } -- -pprTop _ (CmmData section ds) = - (hang (pprSection section <+> lbrace) 4 (ppr ds)) +pprTop platform (CmmData section ds) = + (hang (pprSection section <+> lbrace) 4 (pprPlatform platform ds)) $$ rbrace -- -------------------------------------------------------------------------- -- Info tables. -pprInfoTable :: CmmInfoTable -> SDoc -pprInfoTable CmmNonInfoTable +pprInfoTable :: Platform -> CmmInfoTable -> SDoc +pprInfoTable _ CmmNonInfoTable = empty -pprInfoTable (CmmInfoTable { cit_lbl = lbl, cit_rep = rep +pprInfoTable platform + (CmmInfoTable { cit_lbl = lbl, cit_rep = rep , cit_prof = prof_info , cit_srt = _srt }) - = vcat [ ptext (sLit "label:") <+> ppr lbl + = vcat [ ptext (sLit "label:") <+> pprPlatform platform lbl , ptext (sLit "rep:") <> ppr rep , case prof_info of NoProfilingInfo -> empty ProfilingInfo ct cd -> vcat [ ptext (sLit "type:") <+> pprWord8String ct , ptext (sLit "desc: ") <> pprWord8String cd ] ] -instance Outputable C_SRT where - ppr (NoC_SRT) = ptext (sLit "_no_srt_") - ppr (C_SRT label off bitmap) = parens (ppr label <> comma <> ppr off <> comma - <> text (show bitmap)) +instance PlatformOutputable C_SRT where + pprPlatform _ (NoC_SRT) = ptext (sLit "_no_srt_") + pprPlatform platform (C_SRT label off bitmap) + = parens (pprPlatform platform label <> comma <> ppr off + <> comma <> text (show bitmap)) instance Outputable ForeignHint where ppr NoHint = empty @@ -135,18 +139,20 @@ instance Outputable ForeignHint where -- ppr AddrHint = quotes(text "address") -- Temp Jan08 ppr AddrHint = (text "PtrHint") +instance PlatformOutputable ForeignHint where + pprPlatform _ = ppr -- -------------------------------------------------------------------------- -- Static data. -- Strings are printed as C strings, and we print them as I8[], -- following C-- -- -pprStatics :: CmmStatics -> SDoc -pprStatics (Statics lbl ds) = vcat ((pprCLabel lbl <> colon) : map ppr ds) +pprStatics :: Platform -> CmmStatics -> SDoc +pprStatics platform (Statics lbl ds) = vcat ((pprCLabel platform lbl <> colon) : map (pprPlatform platform) ds) -pprStatic :: CmmStatic -> SDoc -pprStatic s = case s of - CmmStaticLit lit -> nest 4 $ ptext (sLit "const") <+> pprLit lit <> semi +pprStatic :: Platform -> CmmStatic -> SDoc +pprStatic platform s = case s of + CmmStaticLit lit -> nest 4 $ ptext (sLit "const") <+> pprLit platform lit <> semi CmmUninitialised i -> nest 4 $ text "I8" <> brackets (int i) CmmString s' -> nest 4 $ text "I8[]" <+> text (show s') |