[Git][ghc/ghc][wip/andreask/ghci-tag-nullary] Tag inference is great, but not so great that we should run it twice
Andreas Klebinger (@AndreasK)
gitlab at gitlab.haskell.org
Tue Aug 16 19:33:34 UTC 2022
Andreas Klebinger pushed to branch wip/andreask/ghci-tag-nullary at Glasgow Haskell Compiler / GHC
Commits:
8ac0f2d9 by Andreas Klebinger at 2022-08-16T21:33:12+02:00
Tag inference is great, but not so great that we should run it twice
- - - - -
2 changed files:
- compiler/GHC/Driver/GenerateCgIPEStub.hs
- compiler/GHC/Driver/Main.hs
Changes:
=====================================
compiler/GHC/Driver/GenerateCgIPEStub.hs
=====================================
@@ -27,13 +27,12 @@ import GHC.Settings (Platform, platformUnregisterised)
import GHC.StgToCmm.Monad (getCmm, initC, runC, initFCodeState)
import GHC.StgToCmm.Prof (initInfoTableProv)
import GHC.StgToCmm.Types (CgInfos (..), ModuleLFInfos)
-import GHC.Stg.InferTags.TagSig (TagSig)
import GHC.Types.IPE (InfoTableProvMap (provInfoTables), IpeSourceLocation)
import GHC.Types.Name.Set (NonCaffySet)
-import GHC.Types.Name.Env (NameEnv)
import GHC.Types.Tickish (GenTickish (SourceNote))
import GHC.Unit.Types (Module)
import GHC.Utils.Misc
+import GHC.Stg.Pipeline (StgCgInfos)
{-
Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)]
@@ -180,8 +179,8 @@ The find the tick:
remembered in a `Maybe`.
-}
-generateCgIPEStub :: HscEnv -> Module -> InfoTableProvMap -> NameEnv TagSig -> Stream IO CmmGroupSRTs (NonCaffySet, ModuleLFInfos) -> Stream IO CmmGroupSRTs CgInfos
-generateCgIPEStub hsc_env this_mod denv tag_sigs s = do
+generateCgIPEStub :: HscEnv -> Module -> InfoTableProvMap -> StgCgInfos -> Stream IO CmmGroupSRTs (NonCaffySet, ModuleLFInfos) -> Stream IO CmmGroupSRTs CgInfos
+generateCgIPEStub hsc_env this_mod denv stg_cg_infos s = do
let dflags = hsc_dflags hsc_env
platform = targetPlatform dflags
logger = hsc_logger hsc_env
@@ -200,7 +199,7 @@ generateCgIPEStub hsc_env this_mod denv tag_sigs s = do
(_, ipeCmmGroupSRTs) <- liftIO $ cmmPipeline logger cmm_cfg (emptySRT this_mod) ipeCmmGroup
Stream.yield ipeCmmGroupSRTs
- return CgInfos {cgNonCafs = nonCaffySet, cgLFInfos = moduleLFInfos, cgIPEStub = ipeStub, cgTagSigs = tag_sigs}
+ return CgInfos {cgNonCafs = nonCaffySet, cgLFInfos = moduleLFInfos, cgIPEStub = ipeStub, cgTagSigs = stg_cg_infos}
where
collect :: Platform -> [(Label, CmmInfoTable, Maybe IpeSourceLocation)] -> CmmGroupSRTs -> IO ([(Label, CmmInfoTable, Maybe IpeSourceLocation)], CmmGroupSRTs)
collect platform acc cmmGroupSRTs = do
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -187,7 +187,6 @@ import GHC.Tc.Utils.Zonk ( ZonkFlexi (DefaultFlexi) )
import GHC.Stg.Syntax
import GHC.Stg.Pipeline ( stg2stg, StgCgInfos )
-import GHC.Stg.InferTags
import GHC.Builtin.Utils
import GHC.Builtin.Names
@@ -1752,7 +1751,7 @@ hscGenHardCode hsc_env cgguts location output_filename = do
cmms <- {-# SCC "StgToCmm" #-}
doCodeGen hsc_env this_mod denv data_tycons
cost_centre_info
- stg_binds hpc_info
+ stg_binds stg_cg_infos hpc_info
------------------ Code output -----------------------
rawcmms0 <- {-# SCC "cmmToRawCmm" #-}
@@ -1904,25 +1903,23 @@ This reduces residency towards the end of the CodeGen phase significantly
doCodeGen :: HscEnv -> Module -> InfoTableProvMap -> [TyCon]
-> CollectedCCs
-> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs
+ -> StgCgInfos
-> HpcInfo
-> IO (Stream IO CmmGroupSRTs CgInfos)
-- Note we produce a 'Stream' of CmmGroups, so that the
-- backend can be run incrementally. Otherwise it generates all
-- the C-- up front, which has a significant space cost.
doCodeGen hsc_env this_mod denv data_tycons
- cost_centre_info stg_binds_w_fvs hpc_info = do
+ cost_centre_info stg_binds_w_fvs stg_cg_info hpc_info = do
let dflags = hsc_dflags hsc_env
logger = hsc_logger hsc_env
hooks = hsc_hooks hsc_env
tmpfs = hsc_tmpfs hsc_env
platform = targetPlatform dflags
stg_ppr_opts = (initStgPprOpts dflags)
- -- Do tag inference on optimized STG
- (!stg_post_infer,export_tag_info) <-
- {-# SCC "StgTagFields" #-} inferTags stg_ppr_opts logger this_mod stg_binds_w_fvs
putDumpFileMaybe logger Opt_D_dump_stg_final "Final STG:" FormatSTG
- (pprGenStgTopBindings stg_ppr_opts stg_post_infer)
+ (pprGenStgTopBindings stg_ppr_opts stg_binds_w_fvs)
let stg_to_cmm dflags mod = case stgToCmmHook hooks of
Nothing -> StgToCmm.codeGen logger tmpfs (initStgToCmmConfig dflags mod)
@@ -1930,8 +1927,8 @@ doCodeGen hsc_env this_mod denv data_tycons
let cmm_stream :: Stream IO CmmGroup ModuleLFInfos
-- See Note [Forcing of stg_binds]
- cmm_stream = stg_post_infer `seqList` {-# SCC "StgToCmm" #-}
- stg_to_cmm dflags this_mod denv data_tycons cost_centre_info stg_post_infer hpc_info
+ 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
-- codegen consumes a stream of CmmGroup, and produces a new
-- stream of CmmGroup (not necessarily synchronised: one
@@ -1962,7 +1959,7 @@ doCodeGen hsc_env this_mod denv data_tycons
putDumpFileMaybe logger Opt_D_dump_cmm "Output Cmm" FormatCMM (pdoc platform a)
return a
- return $ Stream.mapM dump2 $ generateCgIPEStub hsc_env this_mod denv export_tag_info pipeline_stream
+ return $ Stream.mapM dump2 $ generateCgIPEStub hsc_env this_mod denv stg_cg_info pipeline_stream
myCoreToStgExpr :: Logger -> DynFlags -> InteractiveContext
-> Bool
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8ac0f2d98136c4aa2f4f88eb1d783ff9d84c17dc
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8ac0f2d98136c4aa2f4f88eb1d783ff9d84c17dc
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20220816/f3120290/attachment-0001.html>
More information about the ghc-commits
mailing list