diff options
Diffstat (limited to 'compiler/GHC/Driver')
| -rw-r--r-- | compiler/GHC/Driver/CodeOutput.hs | 12 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Hooks.hs | 4 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Main.hs | 7 |
3 files changed, 12 insertions, 11 deletions
diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs index 5e0c5f0c05..b459b7b447 100644 --- a/compiler/GHC/Driver/CodeOutput.hs +++ b/compiler/GHC/Driver/CodeOutput.hs @@ -210,7 +210,7 @@ outputForeignStubs logger dflags unit_state mod location stubs NoStubs -> return (False, Nothing) - ForeignStubs h_code c_code -> do + ForeignStubs (CHeader h_code) (CStub c_code) -> do let stub_c_output_d = pprCode CStyle c_code stub_c_output_w = showSDoc dflags stub_c_output_d @@ -285,9 +285,9 @@ outputForeignStubs_help fname doc_str header footer -- module; -- | Generate code to initialise cost centres -profilingInitCode :: Platform -> Module -> CollectedCCs -> SDoc +profilingInitCode :: Platform -> Module -> CollectedCCs -> CStub profilingInitCode platform this_mod (local_CCs, singleton_CCSs) - = vcat + = CStub $ vcat $ map emit_cc_decl local_CCs ++ map emit_ccs_decl singleton_CCSs ++ [emit_cc_list local_CCs] @@ -325,11 +325,11 @@ profilingInitCode platform this_mod (local_CCs, singleton_CCSs) -- | Generate code to initialise info pointer origin -- See note [Mapping Info Tables to Source Positions] -ipInitCode :: DynFlags -> Module -> [InfoProvEnt] -> SDoc +ipInitCode :: DynFlags -> Module -> [InfoProvEnt] -> CStub ipInitCode dflags this_mod ents = if not (gopt Opt_InfoTableMap dflags) - then empty - else withPprStyle (PprCode CStyle) $ vcat + then mempty + else CStub $ vcat $ map emit_ipe_decl ents ++ [emit_ipe_list ents] ++ [ text "static void ip_init_" <> ppr this_mod diff --git a/compiler/GHC/Driver/Hooks.hs b/compiler/GHC/Driver/Hooks.hs index 4cf62412b5..99c6ba8609 100644 --- a/compiler/GHC/Driver/Hooks.hs +++ b/compiler/GHC/Driver/Hooks.hs @@ -49,6 +49,7 @@ import GHC.Types.CostCentre import GHC.Types.IPE import GHC.Types.Meta import GHC.Types.HpcInfo +import GHC.Types.ForeignStubs import GHC.Unit.Module import GHC.Unit.Module.ModSummary @@ -71,7 +72,6 @@ import GHC.Data.Bag import qualified Data.Kind import System.Process -import GHC.Utils.Outputable ( SDoc ) {- ************************************************************************ @@ -146,7 +146,7 @@ data Hooks = Hooks -> IO (Maybe HValue))) , createIservProcessHook :: !(Maybe (CreateProcess -> IO ProcessHandle)) , stgToCmmHook :: !(Maybe (DynFlags -> Module -> InfoTableProvMap -> [TyCon] -> CollectedCCs - -> [CgStgTopBinding] -> HpcInfo -> Stream IO CmmGroup (SDoc, ModuleLFInfos))) + -> [CgStgTopBinding] -> HpcInfo -> Stream IO CmmGroup (CStub, ModuleLFInfos))) , cmmToRawCmmHook :: !(forall a . Maybe (DynFlags -> Maybe Module -> Stream IO CmmGroupSRTs a -> IO (Stream IO RawCmmGroup a))) } diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs index fea51a7f96..d3695177d3 100644 --- a/compiler/GHC/Driver/Main.hs +++ b/compiler/GHC/Driver/Main.hs @@ -1548,7 +1548,7 @@ hscGenHardCode hsc_env cgguts location output_filename = do platform = targetPlatform dflags prof_init | sccProfilingEnabled dflags = profilingInitCode platform this_mod cost_centre_info - | otherwise = empty + | otherwise = mempty ------------------ Code generation ------------------ -- The back-end is streamed: each top-level function goes @@ -1576,7 +1576,8 @@ hscGenHardCode hsc_env cgguts location output_filename = do return a rawcmms1 = Stream.mapM dump rawcmms0 - let foreign_stubs st = foreign_stubs0 `appendStubC` prof_init `appendStubC` (cgIPEStub st) + let foreign_stubs st = foreign_stubs0 `appendStubC` prof_init + `appendStubC` cgIPEStub st (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, cg_infos) <- {-# SCC "codeOutput" #-} @@ -1712,7 +1713,7 @@ doCodeGen hsc_env this_mod denv data_tycons Nothing -> StgToCmm.codeGen logger Just h -> h - let cmm_stream :: Stream IO CmmGroup (SDoc, ModuleLFInfos) + let cmm_stream :: Stream IO CmmGroup (CStub, ModuleLFInfos) -- See Note [Forcing of stg_binds] cmm_stream = stg_binds_w_fvs `seqList` {-# SCC "StgToCmm" #-} stg_to_cmm dflags this_mod denv data_tycons cost_centre_info stg_binds_w_fvs hpc_info |