summaryrefslogtreecommitdiff
path: root/compiler/cmm/PprCmmDecl.hs
diff options
context:
space:
mode:
authorIan Lynagh <igloo@earth.li>2011-10-02 01:31:05 +0100
committerIan Lynagh <igloo@earth.li>2011-10-02 16:39:08 +0100
commitac7a7eb93397a2343402f77f1a8a8b4a0e0298df (patch)
tree86fae1d7598b2ddb94b1c00906468eb54af9a48e /compiler/cmm/PprCmmDecl.hs
parentd8d161749c8b13c3db802f348761cff662741c53 (diff)
downloadhaskell-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.hs64
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')