[Git][ghc/ghc][wip/andreask/ghci-tag-nullary] Refact CgInfo into a Stg and Cmm part
Andreas Klebinger (@AndreasK)
gitlab at gitlab.haskell.org
Thu Aug 18 10:14:07 UTC 2022
Andreas Klebinger pushed to branch wip/andreask/ghci-tag-nullary at Glasgow Haskell Compiler / GHC
Commits:
933f7a8c by Andreas Klebinger at 2022-08-18T12:12:44+02:00
Refact CgInfo into a Stg and Cmm part
- - - - -
8 changed files:
- compiler/GHC/Driver/GenerateCgIPEStub.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Iface/Make.hs
- compiler/GHC/Stg/InferTags.hs
- compiler/GHC/Stg/InferTags/Rewrite.hs
- compiler/GHC/StgToCmm/Types.hs
- compiler/GHC/Types/Name/Set.hs
Changes:
=====================================
compiler/GHC/Driver/GenerateCgIPEStub.hs
=====================================
@@ -24,10 +24,9 @@ import GHC.Driver.Config.Cmm
import GHC.Prelude
import GHC.Runtime.Heap.Layout (isStackRep)
import GHC.Settings (Platform, platformUnregisterised)
-import GHC.Stg.Pipeline (StgCgInfos)
import GHC.StgToCmm.Monad (getCmm, initC, runC, initFCodeState)
import GHC.StgToCmm.Prof (initInfoTableProv)
-import GHC.StgToCmm.Types (CgInfos (..), ModuleLFInfos)
+import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos)
import GHC.Types.IPE (InfoTableProvMap (provInfoTables), IpeSourceLocation)
import GHC.Types.Name.Set (NonCaffySet)
import GHC.Types.Tickish (GenTickish (SourceNote))
@@ -179,8 +178,8 @@ The find the tick:
remembered in a `Maybe`.
-}
-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
+generateCgIPEStub :: HscEnv -> Module -> InfoTableProvMap -> Stream IO CmmGroupSRTs (NonCaffySet, ModuleLFInfos) -> Stream IO CmmGroupSRTs CmmCgInfos
+generateCgIPEStub hsc_env this_mod denv s = do
let dflags = hsc_dflags hsc_env
platform = targetPlatform dflags
logger = hsc_logger hsc_env
@@ -199,7 +198,7 @@ generateCgIPEStub hsc_env this_mod denv stg_cg_infos s = do
(_, ipeCmmGroupSRTs) <- liftIO $ cmmPipeline logger cmm_cfg (emptySRT this_mod) ipeCmmGroup
Stream.yield ipeCmmGroupSRTs
- return CgInfos {cgNonCafs = nonCaffySet, cgLFInfos = moduleLFInfos, cgIPEStub = ipeStub, cgTagSigs = stg_cg_infos}
+ return CmmCgInfos {cgNonCafs = nonCaffySet, cgLFInfos = moduleLFInfos, cgIPEStub = ipeStub}
where
collect :: Platform -> [(Label, CmmInfoTable, Maybe IpeSourceLocation)] -> CmmGroupSRTs -> IO ([(Label, CmmInfoTable, Maybe IpeSourceLocation)], CmmGroupSRTs)
collect platform acc cmmGroupSRTs = do
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -193,7 +193,7 @@ import GHC.Builtin.Names
import GHC.Builtin.Uniques ( mkPseudoUniqueE )
import qualified GHC.StgToCmm as StgToCmm ( codeGen )
-import GHC.StgToCmm.Types (CgInfos (..), ModuleLFInfos)
+import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos)
import GHC.Cmm
import GHC.Cmm.Info.Build
@@ -1670,7 +1670,7 @@ hscSimpleIface' tc_result summary = do
-- | Compile to hard-code.
hscGenHardCode :: HscEnv -> CgGuts -> ModLocation -> FilePath
- -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], Maybe CgInfos)
+ -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], Maybe StgCgInfos, Maybe CmmCgInfos )
-- ^ @Just f@ <=> _stub.c is f
hscGenHardCode hsc_env cgguts location output_filename = do
let CgGuts{ -- This is the last use of the ModGuts in a compilation.
@@ -1751,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 stg_cg_infos hpc_info
+ stg_binds hpc_info
------------------ Code output -----------------------
rawcmms0 <- {-# SCC "cmmToRawCmm" #-}
@@ -1768,12 +1768,12 @@ hscGenHardCode hsc_env cgguts location output_filename = do
let foreign_stubs st = foreign_stubs0 `appendStubC` prof_init
`appendStubC` cgIPEStub st
- (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, cg_infos)
+ (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, cmm_cg_infos)
<- {-# SCC "codeOutput" #-}
codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) this_mod output_filename location
foreign_stubs foreign_files dependencies rawcmms1
return ( output_filename, stub_c_exists, foreign_fps
- , Just cg_infos{ cgTagSigs = stg_cg_infos})
+ , Just stg_cg_infos, Just cmm_cg_infos)
hscInteractive :: HscEnv
@@ -1903,14 +1903,13 @@ 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)
+ -> IO (Stream IO CmmGroupSRTs CmmCgInfos)
-- 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 stg_cg_info hpc_info = do
+ cost_centre_info stg_binds_w_fvs hpc_info = do
let dflags = hsc_dflags hsc_env
logger = hsc_logger hsc_env
hooks = hsc_hooks hsc_env
@@ -1959,7 +1958,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 stg_cg_info pipeline_stream
+ return $ Stream.mapM dump2 $ generateCgIPEStub hsc_env this_mod denv pipeline_stream
myCoreToStgExpr :: Logger -> DynFlags -> InteractiveContext
-> Bool
=====================================
compiler/GHC/Driver/Pipeline/Execute.hs
=====================================
@@ -537,9 +537,9 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do
else if backendWritesFiles (backend dflags) then
do
output_fn <- phaseOutputFilenameNew next_phase pipe_env hsc_env (Just location)
- (outputFilename, mStub, foreign_files, mb_cg_infos) <-
+ (outputFilename, mStub, foreign_files, mb_stg_infos, mb_cg_infos) <-
hscGenHardCode hsc_env cgguts mod_location output_fn
- final_iface <- mkFullIface hsc_env partial_iface mb_cg_infos
+ final_iface <- mkFullIface hsc_env partial_iface mb_stg_infos mb_cg_infos
-- See Note [Writing interface files]
hscMaybeWriteIface logger dflags False final_iface mb_old_iface_hash mod_location
@@ -559,7 +559,7 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do
-- In interpreted mode the regular codeGen backend is not run so we
-- generate a interface without codeGen info.
do
- final_iface <- mkFullIface hsc_env partial_iface Nothing
+ final_iface <- mkFullIface hsc_env partial_iface Nothing Nothing
hscMaybeWriteIface logger dflags True final_iface mb_old_iface_hash location
(hasStub, comp_bc, spt_entries) <- hscInteractive hsc_env cgguts mod_location
=====================================
compiler/GHC/Iface/Make.hs
=====================================
@@ -23,7 +23,7 @@ import GHC.Prelude
import GHC.Hs
-import GHC.StgToCmm.Types (CgInfos (..))
+import GHC.StgToCmm.Types (CmmCgInfos (..))
import GHC.Tc.Utils.TcType
import GHC.Tc.Utils.Monad
@@ -99,6 +99,7 @@ import Data.Function
import Data.List ( findIndex, mapAccumL, sortBy )
import Data.Ord
import Data.IORef
+import GHC.Stg.Pipeline (StgCgInfos)
{-
@@ -134,16 +135,16 @@ mkPartialIface hsc_env mod_details mod_summary
-- | Fully instantiate an interface. Adds fingerprints and potentially code
-- generator produced information.
--
--- CgInfos is not available when not generating code (-fno-code), or when not
+-- CmmCgInfos is not available when not generating code (-fno-code), or when not
-- generating interface pragmas (-fomit-interface-pragmas). See also
-- Note [Conveying CAF-info and LFInfo between modules] in GHC.StgToCmm.Types.
-mkFullIface :: HscEnv -> PartialModIface -> Maybe CgInfos -> IO ModIface
-mkFullIface hsc_env partial_iface mb_cg_infos = do
+mkFullIface :: HscEnv -> PartialModIface -> Maybe StgCgInfos -> Maybe CmmCgInfos -> IO ModIface
+mkFullIface hsc_env partial_iface mb_stg_infos mb_cmm_infos = do
let decls
| gopt Opt_OmitInterfacePragmas (hsc_dflags hsc_env)
= mi_decls partial_iface
| otherwise
- = updateDecl (mi_decls partial_iface) mb_cg_infos
+ = updateDecl (mi_decls partial_iface) mb_stg_infos mb_cmm_infos
full_iface <-
{-# SCC "addFingerprints" #-}
@@ -156,11 +157,16 @@ mkFullIface hsc_env partial_iface mb_cg_infos = do
return full_iface
-updateDecl :: [IfaceDecl] -> Maybe CgInfos -> [IfaceDecl]
-updateDecl decls Nothing = decls
-updateDecl decls (Just CgInfos{ cgNonCafs = NonCaffySet non_cafs, cgLFInfos = lf_infos, cgTagSigs = tag_sigs })
+updateDecl :: [IfaceDecl] -> Maybe StgCgInfos -> Maybe CmmCgInfos -> [IfaceDecl]
+updateDecl decls Nothing Nothing = decls
+updateDecl decls m_stg_infos m_cmm_infos
= map update_decl decls
where
+ (non_cafs,lf_infos) = maybe (mempty, mempty)
+ (\cmm_info -> (ncs_nameSet (cgNonCafs cmm_info), cgLFInfos cmm_info))
+ m_cmm_infos
+ tag_sigs = fromMaybe mempty m_stg_infos
+
update_decl (IfaceId nm ty details infos)
| let not_caffy = elemNameSet nm non_cafs
, let mb_lf_info = lookupNameEnv lf_infos nm
@@ -178,6 +184,9 @@ updateDecl decls (Just CgInfos{ cgNonCafs = NonCaffySet non_cafs, cgLFInfos = lf
update_decl decl
= decl
+
+
+
-- | Make an interface from the results of typechecking only. Useful
-- for non-optimising compilation, or where we aren't generating any
-- object code at all ('NoBackend').
@@ -235,7 +244,7 @@ mkIfaceTc hsc_env safe_mode mod_details mod_summary
docs mod_summary
mod_details
- mkFullIface hsc_env partial_iface Nothing
+ mkFullIface hsc_env partial_iface Nothing Nothing
mkIface_ :: HscEnv -> Module -> HscSource
-> Bool -> Dependencies -> GlobalRdrEnv
=====================================
compiler/GHC/Stg/InferTags.hs
=====================================
@@ -216,7 +216,7 @@ the output of itself.
-- -> CollectedCCs
-- -> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs
-- -> HpcInfo
--- -> IO (Stream IO CmmGroupSRTs CgInfos)
+-- -> IO (Stream IO CmmGroupSRTs CmmCgInfos)
-- -- 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.
=====================================
compiler/GHC/Stg/InferTags/Rewrite.hs
=====================================
@@ -214,9 +214,13 @@ withLcl fv act = do
{- Note [Tag inference for interactive contexts]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-When running code in GHCi we perform tag inference/rewrites
-for individual expressions as part of stg2stg in order to uphold
-Note [Strict Field Invariant]. See also #21083 and #22042.
+When compiling bytecode for GHCi or otherwise we call myCoreToStg which
+then calls out to stg2stg which in turn calls inferTags for tag inference.
+/rewrites
+for individual expressions as part of the stg2stg which does so by
+calling inferTags in order to uphold Note [Strict Field Invariant].
+See also #21083 and #22042.
+
This means in GHCi for a sequence of:
> let x = True
=====================================
compiler/GHC/StgToCmm/Types.hs
=====================================
@@ -1,7 +1,7 @@
module GHC.StgToCmm.Types
- ( CgInfos (..)
+ ( CmmCgInfos (..)
, LambdaFormInfo (..)
, ModuleLFInfos
, StandardFormInfo (..)
@@ -13,8 +13,6 @@ import GHC.Prelude
import GHC.Core.DataCon
-import GHC.Stg.InferTags.TagSig
-
import GHC.Runtime.Heap.Layout
import GHC.Types.Basic
@@ -85,7 +83,7 @@ moving parts are:
--
-- See also Note [Conveying CAF-info and LFInfo between modules] above.
--
-data CgInfos = CgInfos
+data CmmCgInfos = CmmCgInfos
{ cgNonCafs :: !NonCaffySet
-- ^ Exported Non-CAFFY closures in the current module. Everything else is
-- either not exported of CAFFY.
@@ -93,8 +91,6 @@ data CgInfos = CgInfos
-- ^ LambdaFormInfos of exported closures in the current module.
, cgIPEStub :: !CStub
-- ^ The C stub which is used for IPE information
- , cgTagSigs :: !(NameEnv TagSig)
- -- ^ Tag sigs. These are produced by stg2stg hence why they end up in CgInfos.
}
--------------------------------------------------------------------------------
=====================================
compiler/GHC/Types/Name/Set.hs
=====================================
@@ -220,5 +220,5 @@ findUses dus uses
-- | 'Id's which have no CAF references. This is a result of analysis of C--.
-- It is always safe to use an empty 'NonCaffySet'. TODO Refer to Note.
-newtype NonCaffySet = NonCaffySet NameSet
+newtype NonCaffySet = NonCaffySet { ncs_nameSet :: NameSet }
deriving (Semigroup, Monoid)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/933f7a8cb73bf600abbe602d378f3571d8b91814
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/933f7a8cb73bf600abbe602d378f3571d8b91814
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/20220818/dbb9a0be/attachment-0001.html>
More information about the ghc-commits
mailing list