[Git][ghc/ghc][wip/remove-unused-fields] Remove mi_hpc field from interface files
Matthew Pickering (@mpickering)
gitlab at gitlab.haskell.org
Fri Mar 7 17:17:15 UTC 2025
Matthew Pickering pushed to branch wip/remove-unused-fields at Glasgow Haskell Compiler / GHC
Commits:
6ad1f029 by Matthew Pickering at 2025-03-07T17:15:35+00:00
Remove mi_hpc field from interface files
The `mi_hpc` field is not used for anything as far as I can discern so
there is no reason to record in the private interface of a module that
there are modules in the transitive closure which use `hpc`.
You can freely mix modules which use `-fhpc` and ones which don't.
Whether to recompile a module due to `-fhpc` being passed to the module
itself is determined in `fingerprintDynFlags`.
- - - - -
13 changed files:
- compiler/GHC.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Iface/Make.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Types/HpcInfo.hs
- compiler/GHC/Unit/Module/ModIface.hs
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
Changes:
=====================================
compiler/GHC.hs
=====================================
@@ -116,7 +116,6 @@ module GHC (
mi_decls,
mi_extra_decls,
mi_top_env,
- mi_hpc,
mi_trust,
mi_trust_pkg,
mi_complete_matches,
=====================================
compiler/GHC/HsToCore.hs
=====================================
@@ -138,7 +138,6 @@ deSugar hsc_env
tcg_default_exports = defaults,
tcg_insts = insts,
tcg_fam_insts = fam_insts,
- tcg_hpc = other_hpc_info,
tcg_complete_matches = complete_matches,
tcg_self_boot = self_boot
})
@@ -179,7 +178,7 @@ deSugar hsc_env
then writeMixEntries (hpcDir dflags) mod ticks orig_file2
else return 0 -- dummy hash when none are written
pure $ HpcInfo (fromIntegral $ sizeSS ticks) hashNo
- _ -> pure $ emptyHpcInfo other_hpc_info
+ _ -> pure $ emptyHpcInfo
; (msgs, mb_res) <- initDs hsc_env tcg_env $
do { dsEvBinds ev_binds $ \ ds_ev_binds -> do
=====================================
compiler/GHC/Iface/Load.hs
=====================================
@@ -1264,7 +1264,6 @@ pprModIface unit_state iface
<+> (withSelfRecomp iface empty $ \_ -> text "[self-recomp]")
<+> (if mi_orphan exts then text "[orphan module]" else Outputable.empty)
<+> (if mi_finsts exts then text "[family instance module]" else Outputable.empty)
- <+> (if mi_hpc iface then text "[hpc]" else Outputable.empty)
<+> integer hiVersion
, nest 2 (text "ABI hash:" <+> ppr (mi_mod_hash exts))
, nest 2 (text "interface hash:" <+> ppr (mi_iface_hash (mi_final_exts iface)))
=====================================
compiler/GHC/Iface/Make.hs
=====================================
@@ -66,7 +66,6 @@ import GHC.Types.Unique.DSet
import GHC.Types.TypeEnv
import GHC.Types.SourceFile
import GHC.Types.TyThing
-import GHC.Types.HpcInfo
import GHC.Types.CompleteMatch
import GHC.Types.Name.Cache
@@ -120,14 +119,13 @@ mkPartialIface hsc_env core_prog mod_details mod_summary import_decls
, mg_rdr_env = rdr_env
, mg_fix_env = fix_env
, mg_warns = warns
- , mg_hpc_info = hpc_info
, mg_safe_haskell = safe_mode
, mg_trust_pkg = self_trust
, mg_docs = docs
}
= do
self_recomp <- traverse (mkSelfRecomp hsc_env this_mod (ms_hs_hash mod_summary)) usages
- return $ mkIface_ hsc_env this_mod core_prog hsc_src deps rdr_env import_decls fix_env warns hpc_info self_trust
+ return $ mkIface_ hsc_env this_mod core_prog hsc_src deps rdr_env import_decls fix_env warns self_trust
safe_mode self_recomp docs mod_details
-- | Fully instantiate an interface. Adds fingerprints and potentially code
@@ -237,8 +235,7 @@ mkIfaceTc hsc_env safe_mode mod_details mod_summary mb_program
tcg_import_decls = import_decls,
tcg_rdr_env = rdr_env,
tcg_fix_env = fix_env,
- tcg_warns = warns,
- tcg_hpc = other_hpc_info
+ tcg_warns = warns
}
= do
let pluginModules = map lpModule (loadedPlugins (hsc_plugins hsc_env))
@@ -247,7 +244,6 @@ mkIfaceTc hsc_env safe_mode mod_details mod_summary mb_program
(tcg_mod tc_result)
(tcg_imports tc_result)
(map mi_module pluginModules)
- let hpc_info = emptyHpcInfo other_hpc_info
usage <- mkRecompUsageInfo hsc_env tc_result
docs <- extractDocs (ms_hspp_opts mod_summary) tc_result
@@ -256,7 +252,7 @@ mkIfaceTc hsc_env safe_mode mod_details mod_summary mb_program
let partial_iface = mkIface_ hsc_env
this_mod (fromMaybe [] mb_program) hsc_src
deps rdr_env import_decls
- fix_env warns hpc_info
+ fix_env warns
(imp_trust_own_pkg imports) safe_mode self_recomp
docs
mod_details
@@ -290,7 +286,7 @@ mkRecompUsageInfo hsc_env tc_result = do
mkIface_ :: HscEnv -> Module -> CoreProgram -> HscSource
-> Dependencies -> GlobalRdrEnv -> [ImportUserSpec]
- -> NameEnv FixItem -> Warnings GhcRn -> HpcInfo
+ -> NameEnv FixItem -> Warnings GhcRn
-> Bool
-> SafeHaskellMode
-> Maybe ModIfaceSelfRecomp
@@ -299,7 +295,7 @@ mkIface_ :: HscEnv -> Module -> CoreProgram -> HscSource
-> PartialModIface
mkIface_ hsc_env
this_mod core_prog hsc_src deps rdr_env import_decls fix_env src_warns
- hpc_info pkg_trust_req safe_mode self_recomp
+ pkg_trust_req safe_mode self_recomp
docs
ModDetails{ md_defaults = defaults,
md_insts = insts,
@@ -375,7 +371,6 @@ mkIface_ hsc_env
& set_mi_top_env rdrs
& set_mi_decls decls
& set_mi_extra_decls extra_decls
- & set_mi_hpc (isHpcUsed hpc_info)
& set_mi_trust trust_info
& set_mi_trust_pkg pkg_trust_req
& set_mi_complete_matches (icomplete_matches)
=====================================
compiler/GHC/Iface/Recomp.hs
=====================================
@@ -1256,18 +1256,14 @@ addFingerprints hsc_env iface0
-- The interface hash depends on:
-- - the ABI hash, plus
- -- - the source file hash,
+ -- - the things which can affect whether a module is recompiled
-- - the module level annotations,
- -- - usages
-- - deps (home and external packages, dependent files)
- -- - hpc
iface_hash <- computeFingerprint putNameLiterally
(mod_hash,
- mi_src_hash iface0,
ann_fn (mkVarOccFS (fsLit "module")), -- See mkIfaceAnnCache
- mi_usages iface0,
- sorted_deps,
- mi_hpc iface0)
+ mi_self_recomp_info iface0,
+ sorted_deps )
let
final_iface_exts = ModIfaceBackend
=====================================
compiler/GHC/Rename/Names.hs
=====================================
@@ -77,7 +77,6 @@ import GHC.Types.SrcLoc as SrcLoc
import GHC.Types.Basic ( TopLevelFlag(..) )
import GHC.Types.SourceText
import GHC.Types.Id
-import GHC.Types.HpcInfo
import GHC.Types.PkgQual
import GHC.Types.GREInfo (ConInfo(..), ConFieldInfo (..), ConLikeInfo (ConIsData))
@@ -201,7 +200,7 @@ with yes we have gone with no for now.
-- Note: Do the non SOURCE ones first, so that we get a helpful warning
-- for SOURCE ones that are unnecessary
rnImports :: [(LImportDecl GhcPs, SDoc)]
- -> RnM ([LImportDecl GhcRn], [ImportUserSpec], GlobalRdrEnv, ImportAvails, [(Module, IfaceDefault)], AnyHpcUsage)
+ -> RnM ([LImportDecl GhcRn], [ImportUserSpec], GlobalRdrEnv, ImportAvails, [(Module, IfaceDefault)])
rnImports imports = do
tcg_env <- getGblEnv
-- NB: want an identity module here, because it's OK for a signature
@@ -212,10 +211,10 @@ rnImports imports = do
stuff1 <- mapAndReportM (rnImportDecl this_mod) ordinary
stuff2 <- mapAndReportM (rnImportDecl this_mod) source
-- Safe Haskell: See Note [Tracking Trust Transitively]
- let (decls, imp_user_spec, rdr_env, imp_avails, defaults, hpc_usage) = combine (stuff1 ++ stuff2)
+ let (decls, imp_user_spec, rdr_env, imp_avails, defaults) = combine (stuff1 ++ stuff2)
-- Update imp_boot_mods if imp_direct_mods mentions any of them
let merged_import_avail = clobberSourceImports imp_avails
- return (decls, imp_user_spec, rdr_env, merged_import_avail, defaults, hpc_usage)
+ return (decls, imp_user_spec, rdr_env, merged_import_avail, defaults)
where
clobberSourceImports imp_avails =
@@ -228,24 +227,23 @@ rnImports imports = do
combJ (GWIB _ IsBoot) x = Just x
combJ r _ = Just r
-- See Note [Combining ImportAvails]
- combine :: [(LImportDecl GhcRn, ImportUserSpec, GlobalRdrEnv, ImportAvails, [(Module, IfaceDefault)], AnyHpcUsage)]
- -> ([LImportDecl GhcRn], [ImportUserSpec], GlobalRdrEnv, ImportAvails, [(Module, IfaceDefault)], AnyHpcUsage)
+ combine :: [(LImportDecl GhcRn, ImportUserSpec, GlobalRdrEnv, ImportAvails, [(Module, IfaceDefault)])]
+ -> ([LImportDecl GhcRn], [ImportUserSpec], GlobalRdrEnv, ImportAvails, [(Module, IfaceDefault)])
combine ss =
- let (decls, imp_user_spec, rdr_env, imp_avails, defaults, hpc_usage, finsts) = foldr
+ let (decls, imp_user_spec, rdr_env, imp_avails, defaults, finsts) = foldr
plus
- ([], [], emptyGlobalRdrEnv, emptyImportAvails, [], False, emptyModuleSet)
+ ([], [], emptyGlobalRdrEnv, emptyImportAvails, [], emptyModuleSet)
ss
in (decls, imp_user_spec, rdr_env, imp_avails { imp_finsts = moduleSetElts finsts },
- defaults, hpc_usage)
+ defaults)
- plus (decl, us, gbl_env1, imp_avails1, defaults1, hpc_usage1)
- (decls, uss, gbl_env2, imp_avails2, defaults2, hpc_usage2, finsts_set)
+ plus (decl, us, gbl_env1, imp_avails1, defaults1)
+ (decls, uss, gbl_env2, imp_avails2, defaults2, finsts_set)
= ( decl:decls,
us:uss,
gbl_env1 `plusGlobalRdrEnv` gbl_env2,
imp_avails1' `plusImportAvails` imp_avails2,
defaults1 ++ defaults2,
- hpc_usage1 || hpc_usage2,
extendModuleSetList finsts_set new_finsts )
where
imp_avails1' = imp_avails1 { imp_finsts = [] }
@@ -309,7 +307,7 @@ Running generateModules from #14693 with DEPTH=16, WIDTH=30 finishes in
-- 4. A boolean 'AnyHpcUsage' which is true if the imported module
-- used HPC.
rnImportDecl :: Module -> (LImportDecl GhcPs, SDoc)
- -> RnM (LImportDecl GhcRn, ImportUserSpec , GlobalRdrEnv, ImportAvails, [(Module, IfaceDefault)], AnyHpcUsage)
+ -> RnM (LImportDecl GhcRn, ImportUserSpec , GlobalRdrEnv, ImportAvails, [(Module, IfaceDefault)])
rnImportDecl this_mod
(L loc decl@(ImportDecl { ideclName = loc_imp_mod_name
, ideclPkgQual = raw_pkg_qual
@@ -438,7 +436,7 @@ rnImportDecl this_mod
}
return (L loc new_imp_decl, ImpUserSpec imp_spec imp_user_list, gbl_env,
- imports, (,) (mi_module iface) <$> mi_defaults iface, mi_hpc iface)
+ imports, (,) (mi_module iface) <$> mi_defaults iface)
-- | Rename raw package imports
=====================================
compiler/GHC/Tc/Module.hs
=====================================
@@ -459,7 +459,7 @@ isTypeSubsequenceOf (t1:t1s) (t2:t2s)
tcRnImports :: HscEnv -> [(LImportDecl GhcPs, SDoc)] -> TcM ([NonEmpty ClassDefaults], TcGblEnv)
tcRnImports hsc_env import_decls
- = do { (rn_imports, imp_user_spec, rdr_env, imports, defaults, hpc_info) <- rnImports import_decls ;
+ = do { (rn_imports, imp_user_spec, rdr_env, imports, defaults) <- rnImports import_decls ;
; this_mod <- getModule
; gbl_env <- getGblEnv
@@ -494,8 +494,7 @@ tcRnImports hsc_env import_decls
tcg_default = foldMap subsume tc_defaults,
tcg_inst_env = tcg_inst_env gbl `unionInstEnv` home_insts,
tcg_fam_inst_env = extendFamInstEnvList (tcg_fam_inst_env gbl)
- home_fam_insts,
- tcg_hpc = hpc_info
+ home_fam_insts
}) $ do {
; traceRn "rn1" (ppr (imp_direct_dep_mods imports))
=====================================
compiler/GHC/Tc/Types.hs
=====================================
@@ -154,7 +154,6 @@ import GHC.Types.SrcLoc
import GHC.Types.Unique.FM
import GHC.Types.Basic
import GHC.Types.CostCentre.State
-import GHC.Types.HpcInfo
import GHC.Data.IOEnv
import GHC.Data.Bag
@@ -641,10 +640,6 @@ data TcGblEnv
tcg_hdr_info :: (Maybe (LHsDoc GhcRn), Maybe (XRec GhcRn ModuleName)),
-- ^ Maybe Haddock header docs and Maybe located module name
- tcg_hpc :: !AnyHpcUsage, -- ^ @True@ if any part of the
- -- prog uses hpc instrumentation.
- -- NB. BangPattern is to fix a leak, see #15111
-
tcg_self_boot :: SelfBootInfo, -- ^ Whether this module has a
-- corresponding hi-boot file
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -358,7 +358,6 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
tcg_zany_n = zany_n_var,
tcg_keep = keep_var,
tcg_hdr_info = (Nothing,Nothing),
- tcg_hpc = False,
tcg_main = Nothing,
tcg_self_boot = NoSelfBoot,
tcg_safe_infer = infer_var,
=====================================
compiler/GHC/Types/HpcInfo.hs
=====================================
@@ -1,9 +1,7 @@
-- | Haskell Program Coverage (HPC) support
module GHC.Types.HpcInfo
( HpcInfo (..)
- , AnyHpcUsage
, emptyHpcInfo
- , isHpcUsed
)
where
@@ -16,19 +14,8 @@ data HpcInfo
, hpcInfoHash :: Int
}
| NoHpcInfo
- { hpcUsed :: AnyHpcUsage -- ^ Is hpc used anywhere on the module \*tree\*?
- }
--- | This is used to signal if one of my imports used HPC instrumentation
--- even if there is no module-local HPC usage
-type AnyHpcUsage = Bool
-emptyHpcInfo :: AnyHpcUsage -> HpcInfo
+emptyHpcInfo :: HpcInfo
emptyHpcInfo = NoHpcInfo
--- | Find out if HPC is used by this module or any of the modules
--- it depends upon
-isHpcUsed :: HpcInfo -> AnyHpcUsage
-isHpcUsed (HpcInfo {}) = True
-isHpcUsed (NoHpcInfo { hpcUsed = used }) = used
-
=====================================
compiler/GHC/Unit/Module/ModIface.hs
=====================================
@@ -27,7 +27,6 @@ module GHC.Unit.Module.ModIface
, mi_insts
, mi_fam_insts
, mi_rules
- , mi_hpc
, mi_trust
, mi_trust_pkg
, mi_complete_matches
@@ -56,7 +55,6 @@ module GHC.Unit.Module.ModIface
, set_mi_extra_decls
, set_mi_foreign
, set_mi_top_env
- , set_mi_hpc
, set_mi_trust
, set_mi_trust_pkg
, set_mi_complete_matches
@@ -113,7 +111,6 @@ import GHC.Unit.Module.WholeCoreBindings (IfaceForeign (..), emptyIfaceForeign)
import GHC.Types.Avail
import GHC.Types.Fixity
import GHC.Types.Fixity.Env
-import GHC.Types.HpcInfo
import GHC.Types.Name
import GHC.Types.SafeHaskell
import GHC.Types.SourceFile
@@ -300,8 +297,6 @@ data ModIface_ (phase :: ModIfacePhase)
mi_fam_insts_ :: [IfaceFamInst], -- ^ Sorted family instances
mi_rules_ :: [IfaceRule], -- ^ Sorted rules
- mi_hpc_ :: !AnyHpcUsage,
- -- ^ True if this program uses Hpc at any point in the program.
mi_trust_ :: !IfaceTrustInfo,
-- ^ Safe Haskell Trust information for this module.
@@ -481,7 +476,6 @@ instance Binary ModIface where
mi_insts_ = insts,
mi_fam_insts_ = fam_insts,
mi_rules_ = rules,
- mi_hpc_ = hpc_info,
mi_trust_ = trust,
mi_trust_pkg_ = trust_pkg,
mi_complete_matches_ = complete_matches,
@@ -521,7 +515,6 @@ instance Binary ModIface where
put_ bh fam_insts
lazyPut bh rules
put_ bh orphan_hash
- put_ bh hpc_info
put_ bh trust
put_ bh trust_pkg
put_ bh complete_matches
@@ -551,7 +544,6 @@ instance Binary ModIface where
fam_insts <- {-# SCC "bin_fam_insts" #-} get bh
rules <- {-# SCC "bin_rules" #-} lazyGet bh
orphan_hash <- get bh
- hpc_info <- get bh
trust <- get bh
trust_pkg <- get bh
complete_matches <- get bh
@@ -578,7 +570,6 @@ instance Binary ModIface where
mi_insts_ = insts,
mi_fam_insts_ = fam_insts,
mi_rules_ = rules,
- mi_hpc_ = hpc_info,
mi_trust_ = trust,
mi_trust_pkg_ = trust_pkg,
-- And build the cached values
@@ -623,7 +614,6 @@ emptyPartialModIface mod
mi_extra_decls_ = Nothing,
mi_foreign_ = emptyIfaceForeign,
mi_top_env_ = IfaceTopEnv emptyDetOrdAvails [] ,
- mi_hpc_ = False,
mi_trust_ = noIfaceTrustInfo,
mi_trust_pkg_ = False,
mi_complete_matches_ = [],
@@ -674,7 +664,7 @@ instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase))
{ mi_module_, mi_sig_of_, mi_hsc_src_, mi_hi_bytes_, mi_deps_
, mi_exports_, mi_fixities_, mi_warns_, mi_anns_
, mi_decls_, mi_defaults_, mi_extra_decls_, mi_foreign_, mi_top_env_, mi_insts_
- , mi_fam_insts_, mi_rules_, mi_hpc_, mi_trust_, mi_trust_pkg_
+ , mi_fam_insts_, mi_rules_, mi_trust_, mi_trust_pkg_
, mi_complete_matches_, mi_docs_, mi_final_exts_
, mi_ext_fields_ })
= rnf mi_module_
@@ -694,7 +684,6 @@ instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase))
`seq` rnf mi_insts_
`seq` rnf mi_fam_insts_
`seq` rnf mi_rules_
- `seq` rnf mi_hpc_
`seq` mi_trust_
`seq` rnf mi_trust_pkg_
`seq` rnf mi_complete_matches_
@@ -828,9 +817,6 @@ set_mi_foreign foreign_ iface = clear_mi_hi_bytes $ iface { mi_foreign_ = foreig
set_mi_top_env :: IfaceTopEnv -> ModIface_ phase -> ModIface_ phase
set_mi_top_env val iface = clear_mi_hi_bytes $ iface { mi_top_env_ = val }
-set_mi_hpc :: AnyHpcUsage -> ModIface_ phase -> ModIface_ phase
-set_mi_hpc val iface = clear_mi_hi_bytes $ iface { mi_hpc_ = val }
-
set_mi_trust :: IfaceTrustInfo -> ModIface_ phase -> ModIface_ phase
set_mi_trust val iface = clear_mi_hi_bytes $ iface { mi_trust_ = val }
@@ -924,7 +910,6 @@ However, with the pragma, the correct core is generated:
{-# INLINE mi_insts #-}
{-# INLINE mi_fam_insts #-}
{-# INLINE mi_rules #-}
-{-# INLINE mi_hpc #-}
{-# INLINE mi_trust #-}
{-# INLINE mi_trust_pkg #-}
{-# INLINE mi_complete_matches #-}
@@ -940,7 +925,7 @@ pattern ModIface ::
[IfaceAnnotation] -> [IfaceDeclExts phase] ->
Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] -> IfaceForeign ->
[IfaceDefault] -> IfaceTopEnv -> [IfaceClsInst] -> [IfaceFamInst] -> [IfaceRule] ->
- AnyHpcUsage -> IfaceTrustInfo -> Bool -> [IfaceCompleteMatch] -> Maybe Docs ->
+ IfaceTrustInfo -> Bool -> [IfaceCompleteMatch] -> Maybe Docs ->
IfaceBackendExts phase -> ExtensibleFields -> IfaceBinHandle phase -> Maybe ModIfaceSelfRecomp ->
ModIface_ phase
pattern ModIface
@@ -960,7 +945,6 @@ pattern ModIface
, mi_insts
, mi_fam_insts
, mi_rules
- , mi_hpc
, mi_trust
, mi_trust_pkg
, mi_complete_matches
@@ -986,7 +970,6 @@ pattern ModIface
, mi_insts_ = mi_insts
, mi_fam_insts_ = mi_fam_insts
, mi_rules_ = mi_rules
- , mi_hpc_ = mi_hpc
, mi_trust_ = mi_trust
, mi_trust_pkg_ = mi_trust_pkg
, mi_complete_matches_ = mi_complete_matches
=====================================
testsuite/tests/count-deps/CountDepsAst.stdout
=====================================
@@ -162,7 +162,6 @@ GHC.Types.ForeignStubs
GHC.Types.GREInfo
GHC.Types.Hint
GHC.Types.Hint.Ppr
-GHC.Types.HpcInfo
GHC.Types.Id
GHC.Types.Id.Info
GHC.Types.Id.Make
=====================================
testsuite/tests/count-deps/CountDepsParser.stdout
=====================================
@@ -185,7 +185,6 @@ GHC.Types.ForeignStubs
GHC.Types.GREInfo
GHC.Types.Hint
GHC.Types.Hint.Ppr
-GHC.Types.HpcInfo
GHC.Types.Id
GHC.Types.Id.Info
GHC.Types.Id.Make
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6ad1f029e3fcc7c5a493cbb5273d86d3b1d1c362
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6ad1f029e3fcc7c5a493cbb5273d86d3b1d1c362
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/20250307/229e52a8/attachment-0001.html>
More information about the ghc-commits
mailing list