diff options
| author | Sylvain Henry <sylvain@haskus.fr> | 2020-09-02 19:42:01 +0200 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-09-17 20:04:08 -0400 |
| commit | ca48076ae866665913b9c81cbc0c76f0afef7a00 (patch) | |
| tree | 52ad46e313b99fc564bd77de2efeb0bfb8babb47 /compiler/GHC/Driver/CodeOutput.hs | |
| parent | 9dec8600ad4734607bea2b4dc3b40a5af788996b (diff) | |
| download | haskell-ca48076ae866665913b9c81cbc0c76f0afef7a00.tar.gz | |
Introduce OutputableP
Some types need a Platform value to be pretty-printed: CLabel, Cmm
types, instructions, etc.
Before this patch they had an Outputable instance and the Platform value
was obtained via sdocWithDynFlags. It meant that the *renderer* of the
SDoc was responsible of passing the appropriate Platform value (e.g. via
the DynFlags given to showSDoc). It put the burden of passing the
Platform value on the renderer while the generator of the SDoc knows the
Platform it is generating the SDoc for and there is no point passing a
different Platform at rendering time.
With this patch, we introduce a new OutputableP class:
class OutputableP a where
pdoc :: Platform -> a -> SDoc
With this class we still have some polymorphism as we have with `ppr`
(i.e. we can use `pdoc` on a variety of types instead of having a
dedicated `pprXXX` function for each XXX type).
One step closer removing `sdocWithDynFlags` (#10143) and supporting
several platforms (#14335).
Diffstat (limited to 'compiler/GHC/Driver/CodeOutput.hs')
| -rw-r--r-- | compiler/GHC/Driver/CodeOutput.hs | 13 |
1 files changed, 7 insertions, 6 deletions
diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs index 841fa79d33..0e43b64c77 100644 --- a/compiler/GHC/Driver/CodeOutput.hs +++ b/compiler/GHC/Driver/CodeOutput.hs @@ -16,6 +16,7 @@ where #include "HsVersions.h" import GHC.Prelude +import GHC.Platform import GHC.CmmToAsm ( nativeCodeGen ) import GHC.CmmToLlvm ( llvmCodeGen ) @@ -260,8 +261,8 @@ outputForeignStubs_help fname doc_str header footer -- module; -- | Generate code to initialise cost centres -profilingInitCode :: Module -> CollectedCCs -> SDoc -profilingInitCode this_mod (local_CCs, singleton_CCSs) +profilingInitCode :: Platform -> Module -> CollectedCCs -> SDoc +profilingInitCode platform this_mod (local_CCs, singleton_CCSs) = vcat $ map emit_cc_decl local_CCs ++ map emit_ccs_decl singleton_CCSs @@ -278,22 +279,22 @@ profilingInitCode this_mod (local_CCs, singleton_CCSs) where emit_cc_decl cc = text "extern CostCentre" <+> cc_lbl <> text "[];" - where cc_lbl = ppr (mkCCLabel cc) + where cc_lbl = pdoc platform (mkCCLabel cc) local_cc_list_label = text "local_cc_" <> ppr this_mod emit_cc_list ccs = text "static CostCentre *" <> local_cc_list_label <> text "[] =" - <+> braces (vcat $ [ ppr (mkCCLabel cc) <> comma + <+> braces (vcat $ [ pdoc platform (mkCCLabel cc) <> comma | cc <- ccs ] ++ [text "NULL"]) <> semi emit_ccs_decl ccs = text "extern CostCentreStack" <+> ccs_lbl <> text "[];" - where ccs_lbl = ppr (mkCCSLabel ccs) + where ccs_lbl = pdoc platform (mkCCSLabel ccs) singleton_cc_list_label = text "singleton_cc_" <> ppr this_mod emit_ccs_list ccs = text "static CostCentreStack *" <> singleton_cc_list_label <> text "[] =" - <+> braces (vcat $ [ ppr (mkCCSLabel cc) <> comma + <+> braces (vcat $ [ pdoc platform (mkCCSLabel cc) <> comma | cc <- ccs ] ++ [text "NULL"]) <> semi |