diff options
Diffstat (limited to 'compiler/cmm/PprCmmDecl.hs')
| -rw-r--r-- | compiler/cmm/PprCmmDecl.hs | 54 |
1 files changed, 32 insertions, 22 deletions
diff --git a/compiler/cmm/PprCmmDecl.hs b/compiler/cmm/PprCmmDecl.hs index 1f520bfc90..f688f211fb 100644 --- a/compiler/cmm/PprCmmDecl.hs +++ b/compiler/cmm/PprCmmDecl.hs @@ -43,6 +43,7 @@ import PprCmmExpr import Outputable +import Platform import FastString import Data.List @@ -54,23 +55,28 @@ 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)) +pprCmms :: (Outputable info, PlatformOutputable g) + => Platform -> [GenCmm 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, Outputable g) => Handle -> [GenCmm CmmStatic info g] -> IO () -writeCmms handle cmms = printForC handle (pprCmms cmms) +writeCmms :: (Outputable info, PlatformOutputable g) + => Platform -> Handle -> [GenCmm CmmStatics info g] -> IO () +writeCmms platform handle cmms = printForC handle (pprCmms platform cmms) ----------------------------------------------------------------------------- -instance (Outputable d, Outputable info, Outputable g) - => Outputable (GenCmm d info g) where - ppr c = pprCmm c +instance (Outputable d, Outputable info, PlatformOutputable g) + => PlatformOutputable (GenCmm d info g) where + pprPlatform platform c = pprCmm platform c -instance (Outputable d, Outputable info, Outputable i) - => Outputable (GenCmmTop d info i) where - ppr t = pprTop t +instance (Outputable d, Outputable info, PlatformOutputable i) + => PlatformOutputable (GenCmmTop d info i) where + pprPlatform platform t = pprTop platform t + +instance Outputable CmmStatics where + ppr e = pprStatics e instance Outputable CmmStatic where ppr e = pprStatic e @@ -81,20 +87,22 @@ instance Outputable CmmInfoTable where ----------------------------------------------------------------------------- -pprCmm :: (Outputable d, Outputable info, Outputable g) => GenCmm d info g -> SDoc -pprCmm (Cmm tops) = vcat $ intersperse blankLine $ map pprTop tops +pprCmm :: (Outputable d, Outputable info, PlatformOutputable g) + => Platform -> GenCmm d info g -> SDoc +pprCmm platform (Cmm tops) + = vcat $ intersperse blankLine $ map (pprTop platform) tops -- -------------------------------------------------------------------------- -- Top level `procedure' blocks. -- -pprTop :: (Outputable d, Outputable info, Outputable i) - => GenCmmTop d info i -> SDoc +pprTop :: (Outputable d, Outputable info, PlatformOutputable i) + => Platform -> GenCmmTop d info i -> SDoc -pprTop (CmmProc info lbl graph) +pprTop platform (CmmProc info lbl graph) = vcat [ pprCLabel lbl <> lparen <> rparen , nest 8 $ lbrace <+> ppr info $$ rbrace - , nest 4 $ ppr graph + , nest 4 $ pprPlatform platform graph , rbrace ] -- -------------------------------------------------------------------------- @@ -102,8 +110,8 @@ pprTop (CmmProc info lbl graph) -- -- section "data" { ... } -- -pprTop (CmmData section ds) = - (hang (pprSection section <+> lbrace) 4 (vcat (map ppr ds))) +pprTop _ (CmmData section ds) = + (hang (pprSection section <+> lbrace) 4 (ppr ds)) $$ rbrace -- -------------------------------------------------------------------------- @@ -111,8 +119,9 @@ pprTop (CmmData section ds) = pprInfoTable :: CmmInfoTable -> SDoc pprInfoTable CmmNonInfoTable = empty -pprInfoTable (CmmInfoTable stat_clos (ProfilingInfo closure_type closure_desc) tag info) = - vcat [ptext (sLit "has static closure: ") <> ppr stat_clos <+> +pprInfoTable (CmmInfoTable is_local stat_clos (ProfilingInfo closure_type closure_desc) tag info) = + vcat [ptext (sLit "is local: ") <> ppr is_local <+> + ptext (sLit "has static closure: ") <> ppr stat_clos <+> ptext (sLit "type: ") <> pprLit closure_type, ptext (sLit "desc: ") <> pprLit closure_desc, ptext (sLit "tag: ") <> integer (toInteger tag), @@ -171,12 +180,13 @@ instance Outputable ForeignHint where -- 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) + pprStatic :: CmmStatic -> SDoc pprStatic s = case s of 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 CmmString s' -> nest 4 $ text "I8[]" <+> text (show s') -- -------------------------------------------------------------------------- |