[Git][ghc/ghc][wip/22188] 2 commits: Add flag to control whether self-recompilation information is written to interface
Matthew Pickering (@mpickering)
gitlab at gitlab.haskell.org
Wed Mar 5 09:26:56 UTC 2025
Matthew Pickering pushed to branch wip/22188 at Glasgow Haskell Compiler / GHC
Commits:
aa1ded09 by Matthew Pickering at 2025-03-05T09:26:00+00:00
Add flag to control whether self-recompilation information is written to interface
This patch adds the flag -fwrite-if-self-recomp which controls whether
interface files contain the information necessary to answer the
question:
Do I need to recompile myself or is this current interface file
suitable?
Why? Most packages are only built once either by a distribution or cabal
and then placed into an immutable store, after which we will never ask
this question. Therefore we can derive two benefits from omitting this
information.
* Primary motivation: It vastly reduces the surface area for creating
non-deterministic interface files. See issue #10424 which motivated a
proper fix to that issue. Distributions have long contained versions
of GHC which just have broken self-recompilation checking (in order to
get deterministic interface files).
* Secondary motivation: This reduces the size of interface files
slightly.. the `mi_usages` field can be quite big but probably this
isn't such a great benefit.
* Third motivation: Conceptually clarity about which parts of an
interface file are used in order to **communicate** with subsequent
packages about the **interface** for a module. And which parts are
used to self-communicate during recompilation checking.
The main tracking issue is #22188 but fixes issues such as #10424 in a
proper way.
- - - - -
cf497243 by Matthew Pickering at 2025-03-05T09:26:20+00:00
Disable self recomp in release flavour
The interface files that we distribute should not contain any
information which is used by the recompilation checking logic since
source file will never be compiled again.
I am not 100% sure this won't cause unexpected issues, there many be
downstream consumers which are incorrectly using the information from
interfaces, but this commit can be reverted if we detect issues.
- - - - -
28 changed files:
- compiler/GHC.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/Iface/Binary.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Iface/Make.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Unit/Module/ModGuts.hs
- compiler/GHC/Unit/Module/ModIface.hs
- + compiler/GHC/Unit/Module/ModIface/SelfRecomp.hs
- compiler/ghc.cabal.in
- docs/users_guide/phases.rst
- hadrian/doc/flavours.md
- hadrian/src/Flavour.hs
- hadrian/src/Settings/Flavours/Release.hs
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- + testsuite/tests/driver/self-recomp/Makefile
- + testsuite/tests/driver/self-recomp/SelfRecomp01.hs
- + testsuite/tests/driver/self-recomp/SelfRecomp02.hs
- + testsuite/tests/driver/self-recomp/SelfRecomp03.hs
- + testsuite/tests/driver/self-recomp/SelfRecomp04.hs
- + testsuite/tests/driver/self-recomp/SelfRecomp04.stdout
- + testsuite/tests/driver/self-recomp/all.T
Changes:
=====================================
compiler/GHC.hs
=====================================
@@ -104,10 +104,8 @@ module GHC (
mi_module,
mi_sig_of,
mi_hsc_src,
- mi_src_hash,
mi_hi_bytes,
mi_deps,
- mi_usages,
mi_exports,
mi_used_th,
mi_fixities,
=====================================
compiler/GHC/Driver/DynFlags.hs
=====================================
@@ -1178,7 +1178,8 @@ defaultFlags settings
Opt_ShowErrorContext,
Opt_SuppressStgReps,
Opt_UnoptimizedCoreForInterpreter,
- Opt_SpecialiseIncoherents
+ Opt_SpecialiseIncoherents,
+ Opt_WriteSelfRecompInfo
]
++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -692,6 +692,7 @@ data GeneralFlag
| Opt_ExposeOverloadedUnfoldings
| Opt_KeepAutoRules -- ^Keep auto-generated rules even if they seem to have become useless
| Opt_WriteInterface -- forces .hi files to be written even with -fno-code
+ | Opt_WriteSelfRecompInfo
| Opt_WriteHie -- generate .hie files
-- JavaScript opts
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -1243,11 +1243,11 @@ hscDesugarAndSimplify summary (FrontendTypecheck tc_result) tc_warnings mb_old_h
(cg_guts, details) <-
liftIO $ hscTidy hsc_env simplified_guts
- let !partial_iface =
+ !partial_iface <- liftIO $
{-# SCC "GHC.Driver.Main.mkPartialIface" #-}
-- This `force` saves 2M residency in test T10370
-- See Note [Avoiding space leaks in toIface*] for details.
- force (mkPartialIface hsc_env (cg_binds cg_guts) details summary (tcg_import_decls tc_result) simplified_guts)
+ fmap force (mkPartialIface hsc_env (cg_binds cg_guts) details summary (tcg_import_decls tc_result) simplified_guts)
return HscRecomp { hscs_guts = cg_guts,
hscs_mod_location = ms_location summary,
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -875,10 +875,10 @@ pruneCache hpt summ
modl = miKey iface
linkable'
| Just ms <- M.lookup modl ms_map
- , mi_src_hash iface /= ms_hs_hash ms
- = emptyHomeModInfoLinkable
- | otherwise
+ , mi_src_hash iface == Just (ms_hs_hash ms)
= linkable
+ | otherwise
+ = emptyHomeModInfoLinkable
-- Using UFM Module is safe for determinism because the map is just used for a transient lookup. The cache should be unique and a key clash is an error.
ms_map = M.fromListWith
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -2528,6 +2528,7 @@ fFlagsDeps = [
flagSpec "use-rpaths" Opt_RPath,
flagSpec "write-interface" Opt_WriteInterface,
flagSpec "write-if-simplified-core" Opt_WriteIfSimplifiedCore,
+ flagSpec "write-if-self-recomp" Opt_WriteSelfRecompInfo,
flagSpec "write-ide-info" Opt_WriteHie,
flagSpec "unbox-small-strict-fields" Opt_UnboxSmallStrictFields,
flagSpec "unbox-strict-fields" Opt_UnboxStrictFields,
=====================================
compiler/GHC/HsToCore.hs
=====================================
@@ -22,14 +22,12 @@ import GHC.Driver.DynFlags
import GHC.Driver.Config
import GHC.Driver.Config.Core.Lint ( endPassHscEnvIO )
import GHC.Driver.Config.HsToCore.Ticks
-import GHC.Driver.Config.HsToCore.Usage
import GHC.Driver.Env
import GHC.Driver.Backend
import GHC.Driver.Plugins
import GHC.Hs
-import GHC.HsToCore.Usage
import GHC.HsToCore.Monad
import GHC.HsToCore.Errors.Types
import GHC.HsToCore.Expr
@@ -42,7 +40,7 @@ import GHC.HsToCore.Docs
import GHC.Tc.Types
import GHC.Tc.Types.Origin ( Position(..) )
-import GHC.Tc.Utils.Monad ( finalSafeMode, fixSafeInstances, initIfaceLoad )
+import GHC.Tc.Utils.Monad ( finalSafeMode, fixSafeInstances )
import GHC.Tc.Module ( runTcInteractive )
import GHC.Core.Type
@@ -100,6 +98,7 @@ import GHC.Unit.Module.Deps
import Data.List (partition)
import Data.IORef
import Data.Traversable (for)
+import GHC.Iface.Make (mkRecompUsageInfo)
{-
************************************************************************
@@ -127,12 +126,10 @@ deSugar hsc_env
tcg_fix_env = fix_env,
tcg_inst_env = inst_env,
tcg_fam_inst_env = fam_inst_env,
- tcg_merged = merged,
tcg_warns = warns,
tcg_anns = anns,
tcg_binds = binds,
tcg_imp_specs = imp_specs,
- tcg_dependent_files = dependent_files,
tcg_ev_binds = ev_binds,
tcg_th_foreign_files = th_foreign_files_var,
tcg_fords = fords,
@@ -228,8 +225,7 @@ deSugar hsc_env
; endPassHscEnvIO hsc_env name_ppr_ctx CoreDesugarOpt ds_binds ds_rules_for_imps
- ; let used_names = mkUsedNames tcg_env
- pluginModules = map lpModule (loadedPlugins (hsc_plugins hsc_env))
+ ; let pluginModules = map lpModule (loadedPlugins (hsc_plugins hsc_env))
home_unit = hsc_home_unit hsc_env
; let deps = mkDependencies home_unit
(tcg_mod tcg_env)
@@ -237,17 +233,10 @@ deSugar hsc_env
(map mi_module pluginModules)
; used_th <- readIORef tc_splice_used
- ; dep_files <- readIORef dependent_files
; safe_mode <- finalSafeMode dflags tcg_env
- ; (needed_mods, needed_pkgs) <- readIORef (tcg_th_needed_deps tcg_env)
-
- ; let uc = initUsageConfig hsc_env
- ; let plugins = hsc_plugins hsc_env
- ; let fc = hsc_FC hsc_env
- ; let unit_env = hsc_unit_env hsc_env
- ; usages <- initIfaceLoad hsc_env $
- mkUsageInfo uc plugins fc unit_env mod (imp_mods imports) used_names
- dep_files merged needed_mods needed_pkgs
+
+ ; usages <- mkRecompUsageInfo hsc_env tcg_env
+
-- id_mod /= mod when we are processing an hsig, but hsigs
-- never desugared and compiled (there's no code!)
-- Consequently, this should hold for any ModGuts that make
=====================================
compiler/GHC/Iface/Binary.hs
=====================================
@@ -49,7 +49,6 @@ import GHC.Types.Name.Cache
import GHC.Types.SrcLoc
import GHC.Platform
import GHC.Settings.Constants
-import GHC.Utils.Fingerprint
import GHC.Iface.Type (IfaceType(..), getIfaceType, putIfaceType, ifaceTypeSharedByte)
import Control.Monad
@@ -114,7 +113,7 @@ readBinIfaceHeader
-> CheckHiWay
-> TraceBinIFace
-> FilePath
- -> IO (Fingerprint, ReadBinHandle)
+ -> IO ReadBinHandle
readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do
let platform = profilePlatform profile
@@ -156,8 +155,7 @@ readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do
when (checkHiWay == CheckHiWay) $
errorOnMismatch "mismatched interface file profile tag" tag check_tag
- src_hash <- get bh
- pure (src_hash, bh)
+ pure bh
-- | Read an interface file.
--
@@ -170,12 +168,11 @@ readBinIface
-> FilePath
-> IO ModIface
readBinIface profile name_cache checkHiWay traceBinIface hi_path = do
- (src_hash, bh) <- readBinIfaceHeader profile name_cache checkHiWay traceBinIface hi_path
+ bh <- readBinIfaceHeader profile name_cache checkHiWay traceBinIface hi_path
mod_iface <- getIfaceWithExtFields name_cache bh
return $ mod_iface
- & addSourceFingerprint src_hash
getIfaceWithExtFields :: NameCache -> ReadBinHandle -> IO ModIface
@@ -259,7 +256,6 @@ writeBinIface profile traceBinIface compressionLevel hi_path mod_iface = do
put_ bh (show hiVersion)
let tag = profileBuildTag profile
put_ bh tag
- put_ bh (mi_src_hash mod_iface)
putIfaceWithExtFields traceBinIface compressionLevel bh mod_iface
=====================================
compiler/GHC/Iface/Load.hs
=====================================
@@ -1259,21 +1259,25 @@ pprModIfaceSimple unit_state iface =
-- The UnitState is used to pretty-print units
pprModIface :: UnitState -> ModIface -> SDoc
pprModIface unit_state iface
- = vcat [ text "interface"
+ = vcat $ [ text "interface"
<+> ppr (mi_module iface) <+> pp_hsc_src (mi_hsc_src 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 "interface hash:" <+> ppr (mi_iface_hash exts))
, nest 2 (text "ABI hash:" <+> ppr (mi_mod_hash exts))
+ , nest 2 (text "interface hash:" <+> ppr (mi_iface_hash (mi_final_exts iface)))
, nest 2 (text "export-list hash:" <+> ppr (mi_exp_hash exts))
+ , withSelfRecomp iface empty $ \(ModIfaceSelfRecomp src usages flag_hash opt_hash hpc_hash plugin_hash) -> vcat
+ [ nest 2 (text "src_hash:" <+> ppr src)
+ , nest 2 (text "flag hash:" <+> ppr flag_hash)
+ , nest 2 (text "opt_hash:" <+> ppr opt_hash)
+ , nest 2 (text "hpc_hash:" <+> ppr hpc_hash)
+ , nest 2 (text "plugin_hash:" <+> ppr plugin_hash)
+ , vcat (map pprUsage usages)
+ ]
, nest 2 (text "orphan hash:" <+> ppr (mi_orphan_hash exts))
- , nest 2 (text "flag hash:" <+> ppr (mi_flag_hash exts))
- , nest 2 (text "opt_hash:" <+> ppr (mi_opt_hash exts))
- , nest 2 (text "hpc_hash:" <+> ppr (mi_hpc_hash exts))
- , nest 2 (text "plugin_hash:" <+> ppr (mi_plugin_hash exts))
- , nest 2 (text "src_hash:" <+> ppr (mi_src_hash iface))
, nest 2 (text "sig of:" <+> ppr (mi_sig_of iface))
, nest 2 (text "used TH splices:" <+> ppr (mi_used_th iface))
, nest 2 (text "where")
@@ -1282,7 +1286,6 @@ pprModIface unit_state iface
, text "defaults:"
, nest 2 (vcat (map ppr (mi_defaults iface)))
, pprDeps unit_state (mi_deps iface)
- , vcat (map pprUsage (mi_usages iface))
, vcat (map pprIfaceAnnotation (mi_anns iface))
, pprFixities (mi_fixities iface)
, vcat [ppr ver $$ nest 2 (ppr decl) | (ver,decl) <- mi_decls iface]
@@ -1302,6 +1305,7 @@ pprModIface unit_state iface
]
where
exts = mi_final_exts iface
+
pp_hsc_src HsBootFile = text "[boot]"
pp_hsc_src HsigFile = text "[hsig]"
pp_hsc_src HsSrcFile = Outputable.empty
=====================================
compiler/GHC/Iface/Make.hs
=====================================
@@ -13,6 +13,7 @@ module GHC.Iface.Make
( mkPartialIface
, mkFullIface
, mkIfaceTc
+ , mkRecompUsageInfo
, mkIfaceExports
)
where
@@ -110,7 +111,7 @@ mkPartialIface :: HscEnv
-> ModSummary
-> [ImportUserSpec]
-> ModGuts
- -> PartialModIface
+ -> IO PartialModIface
mkPartialIface hsc_env core_prog mod_details mod_summary import_decls
ModGuts{ mg_module = this_mod
, mg_hsc_src = hsc_src
@@ -125,8 +126,10 @@ mkPartialIface hsc_env core_prog mod_details mod_summary import_decls
, mg_trust_pkg = self_trust
, mg_docs = docs
}
- = mkIface_ hsc_env this_mod core_prog hsc_src used_th deps rdr_env import_decls fix_env warns hpc_info self_trust
- safe_mode usages docs mod_summary mod_details
+ = 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 used_th deps rdr_env import_decls fix_env warns hpc_info self_trust
+ safe_mode self_recomp docs mod_details
-- | Fully instantiate an interface. Adds fingerprints and potentially code
-- generator produced information.
@@ -181,9 +184,8 @@ shareIface nc compressionLevel mi = do
rbh <- shrinkBinBuffer bh
seekBinReader rbh start
res <- getIfaceWithExtFields nc rbh
- let resiface = restoreFromOldModIface mi res
- forceModIface resiface
- return resiface
+ forceModIface res
+ return res
-- | Initial ram buffer to allocate for writing interface files.
initBinMemSize :: Int
@@ -236,14 +238,11 @@ 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_merged = merged,
tcg_warns = warns,
tcg_hpc = other_hpc_info,
- tcg_th_splice_used = tc_splice_used,
- tcg_dependent_files = dependent_files
+ tcg_th_splice_used = tc_splice_used
}
= do
- let used_names = mkUsedNames tc_result
let pluginModules = map lpModule (loadedPlugins (hsc_plugins hsc_env))
let home_unit = hsc_home_unit hsc_env
let deps = mkDependencies home_unit
@@ -252,48 +251,59 @@ mkIfaceTc hsc_env safe_mode mod_details mod_summary mb_program
(map mi_module pluginModules)
let hpc_info = emptyHpcInfo other_hpc_info
used_th <- readIORef tc_splice_used
- dep_files <- (readIORef dependent_files)
- (needed_links, needed_pkgs) <- readIORef (tcg_th_needed_deps tc_result)
- let uc = initUsageConfig hsc_env
- plugins = hsc_plugins hsc_env
- fc = hsc_FC hsc_env
- unit_env = hsc_unit_env hsc_env
- -- Do NOT use semantic module here; this_mod in mkUsageInfo
- -- is used solely to decide if we should record a dependency
- -- or not. When we instantiate a signature, the semantic
- -- module is something we want to record dependencies for,
- -- but if you pass that in here, we'll decide it's the local
- -- module and does not need to be recorded as a dependency.
- -- See Note [Identity versus semantic module]
- usages <- initIfaceLoad hsc_env $ mkUsageInfo uc plugins fc unit_env this_mod (imp_mods imports) used_names
- dep_files merged needed_links needed_pkgs
+ usage <- mkRecompUsageInfo hsc_env tc_result
docs <- extractDocs (ms_hspp_opts mod_summary) tc_result
+ self_recomp <- traverse (mkSelfRecomp hsc_env this_mod (ms_hs_hash mod_summary)) usage
let partial_iface = mkIface_ hsc_env
this_mod (fromMaybe [] mb_program) hsc_src
used_th deps rdr_env import_decls
fix_env warns hpc_info
- (imp_trust_own_pkg imports) safe_mode usages
- docs mod_summary
+ (imp_trust_own_pkg imports) safe_mode self_recomp
+ docs
mod_details
mkFullIface hsc_env partial_iface Nothing Nothing NoStubs []
+mkRecompUsageInfo :: HscEnv -> TcGblEnv -> IO (Maybe [Usage])
+mkRecompUsageInfo hsc_env tc_result = do
+ let dflags = hsc_dflags hsc_env
+ if not (gopt Opt_WriteSelfRecompInfo dflags)
+ then return Nothing
+ else do
+ let used_names = mkUsedNames tc_result
+ dep_files <- (readIORef (tcg_dependent_files tc_result))
+ (needed_links, needed_pkgs) <- readIORef (tcg_th_needed_deps tc_result)
+ let uc = initUsageConfig hsc_env
+ plugins = hsc_plugins hsc_env
+ fc = hsc_FC hsc_env
+ unit_env = hsc_unit_env hsc_env
+
+ -- Do NOT use semantic module here; this_mod in mkUsageInfo
+ -- is used solely to decide if we should record a dependency
+ -- or not. When we instantiate a signature, the semantic
+ -- module is something we want to record dependencies for,
+ -- but if you pass that in here, we'll decide it's the local
+ -- module and does not need to be recorded as a dependency.
+ -- See Note [Identity versus semantic module]
+ usages <- initIfaceLoad hsc_env $ mkUsageInfo uc plugins fc unit_env (tcg_mod tc_result) (imp_mods (tcg_imports tc_result)) used_names
+ dep_files (tcg_merged tc_result) needed_links needed_pkgs
+ return (Just usages)
+
mkIface_ :: HscEnv -> Module -> CoreProgram -> HscSource
-> Bool -> Dependencies -> GlobalRdrEnv -> [ImportUserSpec]
-> NameEnv FixItem -> Warnings GhcRn -> HpcInfo
-> Bool
-> SafeHaskellMode
- -> [Usage]
+ -> Maybe ModIfaceSelfRecomp
-> Maybe Docs
- -> ModSummary
-> ModDetails
-> PartialModIface
mkIface_ hsc_env
this_mod core_prog hsc_src used_th deps rdr_env import_decls fix_env src_warns
- hpc_info pkg_trust_req safe_mode usages
- docs mod_summary
+ hpc_info pkg_trust_req safe_mode self_recomp
+ docs
ModDetails{ md_defaults = defaults,
md_insts = insts,
md_fam_insts = fam_insts,
@@ -350,8 +360,8 @@ mkIface_ hsc_env
then Nothing
else Just semantic_mod)
& set_mi_hsc_src hsc_src
+ & set_mi_self_recomp self_recomp
& set_mi_deps deps
- & set_mi_usages usages
& set_mi_exports (mkIfaceExports exports)
& set_mi_defaults (defaultsToIfaceDefaults defaults)
@@ -376,7 +386,6 @@ mkIface_ hsc_env
& set_mi_docs docs
& set_mi_final_exts ()
& set_mi_ext_fields emptyExtensibleFields
- & set_mi_src_hash (ms_hs_hash mod_summary)
& set_mi_hi_bytes PartialIfaceBinHandle
where
=====================================
compiler/GHC/Iface/Recomp.hs
=====================================
@@ -15,6 +15,7 @@ module GHC.Iface.Recomp
, CompileReason(..)
, recompileRequired
, addFingerprints
+ , mkSelfRecomp
)
where
@@ -171,6 +172,7 @@ data RecompReason
= UnitDepRemoved UnitId
| ModulePackageChanged FastString
| SourceFileChanged
+ | NoSelfRecompInfo
| ThisUnitIdChanged
| ImpurePlugin
| PluginsChanged
@@ -204,6 +206,7 @@ instance Outputable RecompReason where
UnitDepRemoved uid -> ppr uid <+> text "removed"
ModulePackageChanged s -> ftext s <+> text "package changed"
SourceFileChanged -> text "Source file changed"
+ NoSelfRecompInfo -> text "Old interface lacks recompilation info"
ThisUnitIdChanged -> text "-this-unit-id changed"
ImpurePlugin -> text "Impure plugin forced recompilation"
PluginsChanged -> text "Plugins changed"
@@ -283,7 +286,7 @@ check_old_iface hsc_env mod_summary maybe_iface
logger = hsc_logger hsc_env
getIface =
case maybe_iface of
- Just _ -> do
+ Just {} -> do
trace_if logger (text "We already have the old interface for" <+>
ppr (ms_mod mod_summary))
return maybe_iface
@@ -354,7 +357,9 @@ check_old_iface hsc_env mod_summary maybe_iface
-- should check versions because some packages
-- might have changed or gone away.
Just iface ->
- check_dyn_hi iface $ checkVersions hsc_env mod_summary iface
+ case mi_self_recomp_info iface of
+ Nothing -> return $ outOfDateItemBecause NoSelfRecompInfo Nothing
+ Just sr_info -> check_dyn_hi iface $ checkVersions hsc_env mod_summary iface sr_info
-- | Check if a module is still the same 'version'.
--
@@ -370,8 +375,9 @@ check_old_iface hsc_env mod_summary maybe_iface
checkVersions :: HscEnv
-> ModSummary
-> ModIface -- Old interface
+ -> ModIfaceSelfRecomp
-> IfG (MaybeValidated ModIface)
-checkVersions hsc_env mod_summary iface
+checkVersions hsc_env mod_summary iface self_recomp
= do { liftIO $ trace_hi_diffs logger
(text "Considering whether compilation is required for" <+>
ppr (mi_module iface) <> colon)
@@ -380,23 +386,22 @@ checkVersions hsc_env mod_summary iface
-- but we ALSO must make sure the instantiation matches up. See
-- test case bkpcabal04!
; hsc_env <- getTopEnv
- ; if mi_src_hash iface /= ms_hs_hash mod_summary
+ ; if mi_sr_src_hash self_recomp /= ms_hs_hash mod_summary
then return $ outOfDateItemBecause SourceFileChanged Nothing else do {
; if not (isHomeModule home_unit (mi_module iface))
then return $ outOfDateItemBecause ThisUnitIdChanged Nothing else do {
- ; recomp <- liftIO $ checkFlagHash hsc_env iface
- `recompThen` checkOptimHash hsc_env iface
- `recompThen` checkHpcHash hsc_env iface
- `recompThen` checkMergedSignatures hsc_env mod_summary iface
+ ; recomp <- liftIO $ checkFlagHash hsc_env (mi_module iface) self_recomp
+ `recompThen` checkOptimHash hsc_env self_recomp
+ `recompThen` checkHpcHash hsc_env self_recomp
+ `recompThen` checkMergedSignatures hsc_env mod_summary self_recomp
`recompThen` checkHsig logger home_unit mod_summary iface
`recompThen` pure (checkHie dflags mod_summary)
; case recomp of (NeedsRecompile reason) -> return $ OutOfDateItem reason Nothing ; _ -> do {
; recomp <- checkDependencies hsc_env mod_summary iface
; case recomp of (NeedsRecompile reason) -> return $ OutOfDateItem reason (Just iface) ; _ -> do {
- ; recomp <- checkPlugins (hsc_plugins hsc_env) iface
+ ; recomp <- checkPlugins (hsc_plugins hsc_env) self_recomp
; case recomp of (NeedsRecompile reason) -> return $ OutOfDateItem reason Nothing ; _ -> do {
-
-- Source code unchanged and no errors yet... carry on
--
-- First put the dependent-module info, read from the old
@@ -411,7 +416,7 @@ checkVersions hsc_env mod_summary iface
; updateEps_ $ \eps -> eps { eps_is_boot = mkModDeps $ dep_boot_mods (mi_deps iface) }
}
; recomp <- checkList [checkModUsage (hsc_FC hsc_env) u
- | u <- mi_usages iface]
+ | u <- mi_sr_usages self_recomp]
; case recomp of (NeedsRecompile reason) -> return $ OutOfDateItem reason (Just iface) ; _ -> do {
; return $ UpToDateItem iface
}}}}}}}
@@ -423,11 +428,11 @@ checkVersions hsc_env mod_summary iface
-- | Check if any plugins are requesting recompilation
-checkPlugins :: Plugins -> ModIface -> IfG RecompileRequired
-checkPlugins plugins iface = liftIO $ do
+checkPlugins :: Plugins -> ModIfaceSelfRecomp -> IfG RecompileRequired
+checkPlugins plugins self_recomp = liftIO $ do
recomp <- recompPlugins plugins
let new_fingerprint = fingerprintPluginRecompile recomp
- let old_fingerprint = mi_plugin_hash (mi_final_exts iface)
+ let old_fingerprint = mi_sr_plugin_hash self_recomp
return $ pluginRecompileToRecompileRequired old_fingerprint new_fingerprint recomp
recompPlugins :: Plugins -> IO PluginRecompile
@@ -516,11 +521,11 @@ checkHie dflags mod_summary =
_ -> UpToDate
-- | Check the flags haven't changed
-checkFlagHash :: HscEnv -> ModIface -> IO RecompileRequired
-checkFlagHash hsc_env iface = do
+checkFlagHash :: HscEnv -> Module -> ModIfaceSelfRecomp -> IO RecompileRequired
+checkFlagHash hsc_env iface_mod self_recomp = do
let logger = hsc_logger hsc_env
- let old_hash = mi_flag_hash (mi_final_exts iface)
- new_hash <- fingerprintDynFlags hsc_env (mi_module iface) putNameLiterally
+ let old_hash = mi_sr_flag_hash self_recomp
+ new_hash <- fingerprintDynFlags hsc_env iface_mod putNameLiterally
case old_hash == new_hash of
True -> up_to_date logger (text "Module flags unchanged")
False -> out_of_date_hash logger FlagsChanged
@@ -528,10 +533,10 @@ checkFlagHash hsc_env iface = do
old_hash new_hash
-- | Check the optimisation flags haven't changed
-checkOptimHash :: HscEnv -> ModIface -> IO RecompileRequired
+checkOptimHash :: HscEnv -> ModIfaceSelfRecomp -> IO RecompileRequired
checkOptimHash hsc_env iface = do
let logger = hsc_logger hsc_env
- let old_hash = mi_opt_hash (mi_final_exts iface)
+ let old_hash = mi_sr_opt_hash iface
new_hash <- fingerprintOptFlags (hsc_dflags hsc_env)
putNameLiterally
if | old_hash == new_hash
@@ -544,10 +549,10 @@ checkOptimHash hsc_env iface = do
old_hash new_hash
-- | Check the HPC flags haven't changed
-checkHpcHash :: HscEnv -> ModIface -> IO RecompileRequired
-checkHpcHash hsc_env iface = do
+checkHpcHash :: HscEnv -> ModIfaceSelfRecomp -> IO RecompileRequired
+checkHpcHash hsc_env self_recomp = do
let logger = hsc_logger hsc_env
- let old_hash = mi_hpc_hash (mi_final_exts iface)
+ let old_hash = mi_sr_hpc_hash self_recomp
new_hash <- fingerprintHpcFlags (hsc_dflags hsc_env)
putNameLiterally
if | old_hash == new_hash
@@ -561,11 +566,11 @@ checkHpcHash hsc_env iface = do
-- Check that the set of signatures we are merging in match.
-- If the -unit-id flags change, this can change too.
-checkMergedSignatures :: HscEnv -> ModSummary -> ModIface -> IO RecompileRequired
-checkMergedSignatures hsc_env mod_summary iface = do
+checkMergedSignatures :: HscEnv -> ModSummary -> ModIfaceSelfRecomp -> IO RecompileRequired
+checkMergedSignatures hsc_env mod_summary self_recomp = do
let logger = hsc_logger hsc_env
let unit_state = hsc_units hsc_env
- let old_merged = sort [ mod | UsageMergedRequirement{ usg_mod = mod } <- mi_usages iface ]
+ let old_merged = sort [ mod | UsageMergedRequirement{ usg_mod = mod } <- mi_sr_usages self_recomp ]
new_merged = case lookupUniqMap (requirementContext unit_state)
(ms_mod_name mod_summary) of
Nothing -> []
@@ -939,6 +944,28 @@ we use is:
-}
+-- | Compute the information needed for self-recompilation checking. This
+-- information can be computed before the backend phase.
+mkSelfRecomp :: HscEnv -> Module -> Fingerprint -> [Usage] -> IO ModIfaceSelfRecomp
+mkSelfRecomp hsc_env this_mod src_hash usages = do
+ let dflags = hsc_dflags hsc_env
+
+ flag_hash <- fingerprintDynFlags hsc_env this_mod putNameLiterally
+
+ opt_hash <- fingerprintOptFlags dflags putNameLiterally
+
+ hpc_hash <- fingerprintHpcFlags dflags putNameLiterally
+
+ plugin_hash <- fingerprintPlugins (hsc_plugins hsc_env)
+
+ return (ModIfaceSelfRecomp
+ { mi_sr_flag_hash = flag_hash
+ , mi_sr_hpc_hash = hpc_hash
+ , mi_sr_opt_hash = opt_hash
+ , mi_sr_plugin_hash = plugin_hash
+ , mi_sr_src_hash = src_hash
+ , mi_sr_usages = usages })
+
-- | Add fingerprints for top-level declarations to a 'ModIface'.
--
-- See Note [Fingerprinting IfaceDecls]
@@ -1213,18 +1240,6 @@ addFingerprints hsc_env iface0
sorted_extra_decls :: Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
sorted_extra_decls = sortOn binding_key <$> mi_extra_decls iface0
- -- the flag hash depends on:
- -- - (some of) dflags
- -- it returns two hashes, one that shouldn't change
- -- the abi hash and one that should
- flag_hash <- fingerprintDynFlags hsc_env this_mod putNameLiterally
-
- opt_hash <- fingerprintOptFlags dflags putNameLiterally
-
- hpc_hash <- fingerprintHpcFlags dflags putNameLiterally
-
- plugin_hash <- fingerprintPlugins (hsc_plugins hsc_env)
-
-- the ABI hash depends on:
-- - decls
-- - export list
@@ -1238,6 +1253,7 @@ addFingerprints hsc_env iface0
mi_warns iface0,
mi_foreign iface0)
+
-- The interface hash depends on:
-- - the ABI hash, plus
-- - the source file hash,
@@ -1246,21 +1262,17 @@ addFingerprints hsc_env iface0
-- - 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)
+ (mod_hash,
+ mi_src_hash iface0,
+ ann_fn (mkVarOccFS (fsLit "module")), -- See mkIfaceAnnCache
+ mi_usages iface0,
+ sorted_deps,
+ mi_hpc iface0)
let
final_iface_exts = ModIfaceBackend
- { mi_iface_hash = iface_hash
- , mi_mod_hash = mod_hash
- , mi_flag_hash = flag_hash
- , mi_opt_hash = opt_hash
- , mi_hpc_hash = hpc_hash
- , mi_plugin_hash = plugin_hash
+ { mi_mod_hash = mod_hash
+ , mi_iface_hash = iface_hash
, mi_orphan = not ( all ifRuleAuto orph_rules
-- See Note [Orphans and auto-generated rules]
&& null orph_insts
@@ -1281,12 +1293,12 @@ addFingerprints hsc_env iface0
where
this_mod = mi_module iface0
semantic_mod = mi_semantic_module iface0
- dflags = hsc_dflags hsc_env
(non_orph_insts, orph_insts) = mkOrphMap ifInstOrph (mi_insts iface0)
(non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0)
(non_orph_fis, orph_fis) = mkOrphMap ifFamInstOrph (mi_fam_insts iface0)
ann_fn = mkIfaceAnnCache (mi_anns iface0)
+
-- | Retrieve the orphan hashes 'mi_orphan_hash' for a list of modules
-- (in particular, the orphan modules which are transitively imported by the
-- current module).
=====================================
compiler/GHC/Unit/Module/ModGuts.hs
=====================================
@@ -53,7 +53,7 @@ data ModGuts
mg_exports :: ![AvailInfo], -- ^ What it exports
mg_deps :: !Dependencies, -- ^ What it depends on, directly or
-- otherwise
- mg_usages :: ![Usage], -- ^ What was used? Used for interfaces.
+ mg_usages :: !(Maybe [Usage]), -- ^ What was used? Used for interfaces.
mg_used_th :: !Bool, -- ^ Did we run a TH splice?
mg_rdr_env :: !GlobalRdrEnv, -- ^ Top-level lexical environment
=====================================
compiler/GHC/Unit/Module/ModIface.hs
=====================================
@@ -15,7 +15,6 @@ module GHC.Unit.Module.ModIface
, mi_sig_of
, mi_hsc_src
, mi_deps
- , mi_usages
, mi_exports
, mi_used_th
, mi_fixities
@@ -36,19 +35,16 @@ module GHC.Unit.Module.ModIface
, mi_docs
, mi_final_exts
, mi_ext_fields
- , mi_src_hash
, mi_hi_bytes
+ , mi_self_recomp_info
)
, pattern ModIface
- , restoreFromOldModIface
- , addSourceFingerprint
, set_mi_module
, set_mi_sig_of
, set_mi_hsc_src
- , set_mi_src_hash
+ , set_mi_self_recomp
, set_mi_hi_bytes
, set_mi_deps
- , set_mi_usages
, set_mi_exports
, set_mi_used_th
, set_mi_fixities
@@ -73,6 +69,8 @@ module GHC.Unit.Module.ModIface
, IfaceBinHandle(..)
, PartialModIface
, ModIfaceBackend (..)
+ , ModIfaceSelfRecomp (..)
+ , withSelfRecomp
, IfaceDeclExts
, IfaceBackendExts
, IfaceExport
@@ -85,6 +83,12 @@ module GHC.Unit.Module.ModIface
, mi_semantic_module
, mi_free_holes
, mi_mnwib
+ , mi_flag_hash
+ , mi_opt_hash
+ , mi_hpc_hash
+ , mi_plugin_hash
+ , mi_src_hash
+ , mi_usages
, renameFreeHoles
, emptyPartialModIface
, emptyFullModIface
@@ -106,6 +110,8 @@ import GHC.Unit.Module.Deps
import GHC.Unit.Module.Warnings
import GHC.Unit.Module.WholeCoreBindings (IfaceForeign (..), emptyIfaceForeign)
+import GHC.Unit.Module.ModIface.SelfRecomp
+
import GHC.Types.Avail
import GHC.Types.Fixity
import GHC.Types.Fixity.Env
@@ -150,19 +156,10 @@ type ModIface = ModIface_ 'ModIfaceFinal
-- * Or computed just before writing the iface to disk. (Hashes)
-- In order to fully instantiate it.
data ModIfaceBackend = ModIfaceBackend
- { mi_iface_hash :: !Fingerprint
- -- ^ Hash of the whole interface
- , mi_mod_hash :: !Fingerprint
+ { mi_mod_hash :: !Fingerprint
-- ^ Hash of the ABI only
- , mi_flag_hash :: !Fingerprint
- -- ^ Hash of the important flags used when compiling the module, excluding
- -- optimisation flags
- , mi_opt_hash :: !Fingerprint
- -- ^ Hash of optimisation flags
- , mi_hpc_hash :: !Fingerprint
- -- ^ Hash of hpc flags
- , mi_plugin_hash :: !Fingerprint
- -- ^ Hash of plugins
+ , mi_iface_hash :: !Fingerprint
+ -- ^ Hash of the whole interface
, mi_orphan :: !WhetherHasOrphans
-- ^ Whether this module has orphans
, mi_finsts :: !WhetherHasFamInst
@@ -218,6 +215,15 @@ data IfaceBinHandle (phase :: ModIfacePhase) where
-- (e.g., set to 'Nothing').
FullIfaceBinHandle :: !(Strict.Maybe FullBinData) -> IfaceBinHandle 'ModIfaceFinal
+
+withSelfRecomp :: ModIface_ phase -> r -> (ModIfaceSelfRecomp -> r) -> r
+withSelfRecomp iface nk jk =
+ case mi_self_recomp_info iface of
+ Nothing -> nk
+ Just x -> jk x
+
+
+
-- | A 'ModIface' plus a 'ModDetails' summarises everything we know
-- about a compiled module. The 'ModIface' is the stuff *before* linking,
-- and can be written out to an interface file. The 'ModDetails is after
@@ -245,16 +251,6 @@ data ModIface_ (phase :: ModIfacePhase)
-- consulted for directly-imported modules, but not
-- for anything else (hence lazy)
- mi_usages_ :: [Usage],
- -- ^ Usages; kept sorted so that it's easy to decide
- -- whether to write a new iface file (changing usages
- -- doesn't affect the hash of this module)
- -- NOT STRICT! we read this field lazily from the interface file
- -- It is *only* consulted by the recompilation checker
- --
- -- The elements must be *deterministically* sorted to guarantee
- -- deterministic interface files
-
mi_exports_ :: ![IfaceExport],
-- ^ Exports
-- Kept sorted by (mod,occ), to make version comparisons easier
@@ -345,13 +341,15 @@ data ModIface_ (phase :: ModIfacePhase)
-- chosen over `ByteString`s.
--
- mi_src_hash_ :: !Fingerprint,
- -- ^ Hash of the .hs source, used for recompilation checking.
- mi_hi_bytes_ :: !(IfaceBinHandle phase)
+ mi_hi_bytes_ :: !(IfaceBinHandle phase),
-- ^ A serialised in-memory buffer of this 'ModIface'.
-- If this handle is given, we can avoid serialising the 'ModIface'
-- when writing this 'ModIface' to disk, and write this buffer to disk instead.
-- See Note [Sharing of ModIface].
+
+ mi_self_recomp_info_ :: !(Maybe ModIfaceSelfRecomp)
+ -- ^ Information needed for checking self-recompilation.
+ -- See Note [Self recompilation information in interface files]
}
-- Enough information to reconstruct the top level environment for a module
@@ -397,6 +395,24 @@ That's why in GHC.Driver.Main.hscMaybeWriteIface there is the call to
forceModIface.
-}
+mi_flag_hash :: ModIface_ phase -> Maybe Fingerprint
+mi_flag_hash = fmap mi_sr_flag_hash . mi_self_recomp_info_
+
+mi_opt_hash :: ModIface_ phase -> Maybe Fingerprint
+mi_opt_hash = fmap mi_sr_opt_hash . mi_self_recomp_info_
+
+mi_hpc_hash :: ModIface_ phase -> Maybe Fingerprint
+mi_hpc_hash = fmap mi_sr_hpc_hash . mi_self_recomp_info_
+
+mi_src_hash :: ModIface_ phase -> Maybe Fingerprint
+mi_src_hash = fmap mi_sr_src_hash . mi_self_recomp_info_
+
+mi_usages :: ModIface_ phase -> Maybe [Usage]
+mi_usages = fmap mi_sr_usages . mi_self_recomp_info_
+
+mi_plugin_hash :: ModIface_ phase -> Maybe Fingerprint
+mi_plugin_hash = fmap mi_sr_plugin_hash . mi_self_recomp_info_
+
-- | Old-style accessor for whether or not the ModIface came from an hs-boot
-- file.
mi_boot :: ModIface -> IsBootInterface
@@ -454,9 +470,6 @@ instance Binary ModIface where
mi_module_ = mod,
mi_sig_of_ = sig_of,
mi_hsc_src_ = hsc_src,
- mi_src_hash_ = _src_hash, -- Don't `put_` this in the instance
- -- because we are going to write it
- -- out separately in the actual file
mi_hi_bytes_ = _hi_bytes, -- We don't serialise the 'mi_hi_bytes_', as it itself
-- may contain an in-memory byte array buffer for this
-- 'ModIface'. If we used 'put_' on this 'ModIface', then
@@ -464,7 +477,6 @@ instance Binary ModIface where
-- the byte array.
-- See Note [Private fields in ModIface]
mi_deps_ = deps,
- mi_usages_ = usages,
mi_exports_ = exports,
mi_used_th_ = used_th,
mi_fixities_ = fixities,
@@ -486,13 +498,10 @@ instance Binary ModIface where
mi_ext_fields_ = _ext_fields, -- Don't `put_` this in the instance so we
-- can deal with it's pointer in the header
-- when we write the actual file
+ mi_self_recomp_info_ = self_recomp,
mi_final_exts_ = ModIfaceBackend {
- mi_iface_hash = iface_hash,
mi_mod_hash = mod_hash,
- mi_flag_hash = flag_hash,
- mi_opt_hash = opt_hash,
- mi_hpc_hash = hpc_hash,
- mi_plugin_hash = plugin_hash,
+ mi_iface_hash = iface_hash,
mi_orphan = orphan,
mi_finsts = hasFamInsts,
mi_exp_hash = exp_hash,
@@ -501,16 +510,12 @@ instance Binary ModIface where
put_ bh mod
put_ bh sig_of
put_ bh hsc_src
- put_ bh iface_hash
+ put_ bh self_recomp
put_ bh mod_hash
- put_ bh flag_hash
- put_ bh opt_hash
- put_ bh hpc_hash
- put_ bh plugin_hash
+ put_ bh iface_hash
put_ bh orphan
put_ bh hasFamInsts
lazyPut bh deps
- lazyPut bh usages
put_ bh exports
put_ bh exp_hash
put_ bh used_th
@@ -536,16 +541,12 @@ instance Binary ModIface where
mod <- get bh
sig_of <- get bh
hsc_src <- get bh
- iface_hash <- get bh
+ self_recomp_info <- get bh
mod_hash <- get bh
- flag_hash <- get bh
- opt_hash <- get bh
- hpc_hash <- get bh
- plugin_hash <- get bh
+ iface_hash <- get bh
orphan <- get bh
hasFamInsts <- get bh
deps <- lazyGet bh
- usages <- {-# SCC "bin_usages" #-} lazyGet bh
exports <- {-# SCC "bin_exports" #-} get bh
exp_hash <- get bh
used_th <- get bh
@@ -570,15 +571,12 @@ instance Binary ModIface where
mi_module_ = mod,
mi_sig_of_ = sig_of,
mi_hsc_src_ = hsc_src,
- mi_src_hash_ = fingerprint0, -- placeholder because this is dealt
- -- with specially when the file is read
mi_hi_bytes_ =
-- We can't populate this field here, as we are
-- missing the 'mi_ext_fields_' field, which is
-- handled in 'getIfaceWithExtFields'.
FullIfaceBinHandle Strict.Nothing,
mi_deps_ = deps,
- mi_usages_ = usages,
mi_exports_ = exports,
mi_used_th_ = used_th,
mi_anns_ = anns,
@@ -600,13 +598,10 @@ instance Binary ModIface where
mi_top_env_ = top_env,
mi_ext_fields_ = emptyExtensibleFields, -- placeholder because this is dealt
-- with specially when the file is read
+ mi_self_recomp_info_ = self_recomp_info,
mi_final_exts_ = ModIfaceBackend {
- mi_iface_hash = iface_hash,
mi_mod_hash = mod_hash,
- mi_flag_hash = flag_hash,
- mi_opt_hash = opt_hash,
- mi_hpc_hash = hpc_hash,
- mi_plugin_hash = plugin_hash,
+ mi_iface_hash = iface_hash,
mi_orphan = orphan,
mi_finsts = hasFamInsts,
mi_exp_hash = exp_hash,
@@ -625,10 +620,8 @@ emptyPartialModIface mod
{ mi_module_ = mod,
mi_sig_of_ = Nothing,
mi_hsc_src_ = HsSrcFile,
- mi_src_hash_ = fingerprint0,
mi_hi_bytes_ = PartialIfaceBinHandle,
mi_deps_ = noDependencies,
- mi_usages_ = [],
mi_exports_ = [],
mi_used_th_ = False,
mi_fixities_ = [],
@@ -648,21 +641,19 @@ emptyPartialModIface mod
mi_complete_matches_ = [],
mi_docs_ = Nothing,
mi_final_exts_ = (),
- mi_ext_fields_ = emptyExtensibleFields
+ mi_ext_fields_ = emptyExtensibleFields,
+ mi_self_recomp_info_ = Nothing
}
emptyFullModIface :: Module -> ModIface
emptyFullModIface mod =
(emptyPartialModIface mod)
{ mi_decls_ = []
+ , mi_self_recomp_info_ = Nothing
, mi_hi_bytes_ = FullIfaceBinHandle Strict.Nothing
, mi_final_exts_ = ModIfaceBackend
- { mi_iface_hash = fingerprint0,
- mi_mod_hash = fingerprint0,
- mi_flag_hash = fingerprint0,
- mi_opt_hash = fingerprint0,
- mi_hpc_hash = fingerprint0,
- mi_plugin_hash = fingerprint0,
+ { mi_mod_hash = fingerprint0,
+ mi_iface_hash = fingerprint0,
mi_orphan = False,
mi_finsts = False,
mi_exp_hash = fingerprint0,
@@ -692,18 +683,17 @@ instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase))
, NFData (IfaceDeclExts (phase :: ModIfacePhase))
) => NFData (ModIface_ phase) where
rnf (PrivateModIface
- { mi_module_, mi_sig_of_, mi_hsc_src_, mi_hi_bytes_, mi_deps_, mi_usages_
+ { mi_module_, mi_sig_of_, mi_hsc_src_, mi_hi_bytes_, mi_deps_
, mi_exports_, mi_used_th_, 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_complete_matches_, mi_docs_, mi_final_exts_
- , mi_ext_fields_, mi_src_hash_ })
+ , mi_ext_fields_ })
= rnf mi_module_
`seq` rnf mi_sig_of_
`seq` mi_hsc_src_
`seq` mi_hi_bytes_
`seq` mi_deps_
- `seq` mi_usages_
`seq` mi_exports_
`seq` rnf mi_used_th_
`seq` mi_fixities_
@@ -724,20 +714,14 @@ instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase))
`seq` rnf mi_docs_
`seq` mi_final_exts_
`seq` mi_ext_fields_
- `seq` rnf mi_src_hash_
`seq` ()
instance NFData (ModIfaceBackend) where
- rnf (ModIfaceBackend{ mi_iface_hash, mi_mod_hash, mi_flag_hash, mi_opt_hash
- , mi_hpc_hash, mi_plugin_hash, mi_orphan, mi_finsts, mi_exp_hash
+ rnf (ModIfaceBackend{ mi_mod_hash
+ , mi_orphan, mi_finsts, mi_exp_hash
, mi_orphan_hash, mi_decl_warn_fn, mi_export_warn_fn, mi_fix_fn
, mi_hash_fn})
- = rnf mi_iface_hash
- `seq` rnf mi_mod_hash
- `seq` rnf mi_flag_hash
- `seq` rnf mi_opt_hash
- `seq` rnf mi_hpc_hash
- `seq` rnf mi_plugin_hash
+ = rnf mi_mod_hash
`seq` rnf mi_orphan
`seq` rnf mi_finsts
`seq` rnf mi_exp_hash
@@ -803,27 +787,6 @@ completePartialModIface partial decls extra_decls final_exts = partial
, mi_hi_bytes_ = FullIfaceBinHandle Strict.Nothing
}
--- | Add a source fingerprint to a 'ModIface_' without invalidating the byte array
--- buffer 'mi_hi_bytes'.
--- This is a variant of 'set_mi_src_hash' which does invalidate the buffer.
---
--- The 'mi_src_hash' is computed outside of 'ModIface_' based on the 'ModSummary'.
-addSourceFingerprint :: Fingerprint -> ModIface_ phase -> ModIface_ phase
-addSourceFingerprint val iface = iface { mi_src_hash_ = val }
-
--- | Copy fields that aren't serialised to disk to the new 'ModIface_'.
--- This includes especially hashes that are usually stored in the interface
--- file header.
---
--- We need this function after calling 'shareIface', to make sure the
--- 'ModIface_' doesn't lose any information. This function does not discard
--- the in-memory byte array buffer 'mi_hi_bytes'.
-restoreFromOldModIface :: ModIface_ phase -> ModIface_ phase -> ModIface_ phase
-restoreFromOldModIface old new = new
- { mi_hsc_src_ = mi_hsc_src_ old
- , mi_src_hash_ = mi_src_hash_ old
- }
-
set_mi_module :: Module -> ModIface_ phase -> ModIface_ phase
set_mi_module val iface = clear_mi_hi_bytes $ iface { mi_module_ = val }
@@ -833,8 +796,8 @@ set_mi_sig_of val iface = clear_mi_hi_bytes $ iface { mi_sig_of_ = val }
set_mi_hsc_src :: HscSource -> ModIface_ phase -> ModIface_ phase
set_mi_hsc_src val iface = clear_mi_hi_bytes $ iface { mi_hsc_src_ = val }
-set_mi_src_hash :: Fingerprint -> ModIface_ phase -> ModIface_ phase
-set_mi_src_hash val iface = clear_mi_hi_bytes $ iface { mi_src_hash_ = val }
+set_mi_self_recomp :: Maybe ModIfaceSelfRecomp-> ModIface_ phase -> ModIface_ phase
+set_mi_self_recomp val iface = clear_mi_hi_bytes $ iface { mi_self_recomp_info_ = val }
set_mi_hi_bytes :: IfaceBinHandle phase -> ModIface_ phase -> ModIface_ phase
set_mi_hi_bytes val iface = iface { mi_hi_bytes_ = val }
@@ -842,9 +805,6 @@ set_mi_hi_bytes val iface = iface { mi_hi_bytes_ = val }
set_mi_deps :: Dependencies -> ModIface_ phase -> ModIface_ phase
set_mi_deps val iface = clear_mi_hi_bytes $ iface { mi_deps_ = val }
-set_mi_usages :: [Usage] -> ModIface_ phase -> ModIface_ phase
-set_mi_usages val iface = clear_mi_hi_bytes $ iface { mi_usages_ = val }
-
set_mi_exports :: [IfaceExport] -> ModIface_ phase -> ModIface_ phase
set_mi_exports val iface = clear_mi_hi_bytes $ iface { mi_exports_ = val }
@@ -969,7 +929,6 @@ However, with the pragma, the correct core is generated:
{-# INLINE mi_sig_of #-}
{-# INLINE mi_hsc_src #-}
{-# INLINE mi_deps #-}
-{-# INLINE mi_usages #-}
{-# INLINE mi_exports #-}
{-# INLINE mi_used_th #-}
{-# INLINE mi_fixities #-}
@@ -989,25 +948,23 @@ However, with the pragma, the correct core is generated:
{-# INLINE mi_docs #-}
{-# INLINE mi_final_exts #-}
{-# INLINE mi_ext_fields #-}
-{-# INLINE mi_src_hash #-}
{-# INLINE mi_hi_bytes #-}
{-# COMPLETE ModIface #-}
pattern ModIface ::
- Module -> Maybe Module -> HscSource -> Dependencies -> [Usage] ->
+ Module -> Maybe Module -> HscSource -> Dependencies ->
[IfaceExport] -> Bool -> [(OccName, Fixity)] -> IfaceWarnings ->
[IfaceAnnotation] -> [IfaceDeclExts phase] ->
Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] -> IfaceForeign ->
[IfaceDefault] -> IfaceTopEnv -> [IfaceClsInst] -> [IfaceFamInst] -> [IfaceRule] ->
AnyHpcUsage -> IfaceTrustInfo -> Bool -> [IfaceCompleteMatch] -> Maybe Docs ->
- IfaceBackendExts phase -> ExtensibleFields -> Fingerprint -> IfaceBinHandle phase ->
+ IfaceBackendExts phase -> ExtensibleFields -> IfaceBinHandle phase -> Maybe ModIfaceSelfRecomp ->
ModIface_ phase
pattern ModIface
{ mi_module
, mi_sig_of
, mi_hsc_src
, mi_deps
- , mi_usages
, mi_exports
, mi_used_th
, mi_fixities
@@ -1028,14 +985,13 @@ pattern ModIface
, mi_docs
, mi_final_exts
, mi_ext_fields
- , mi_src_hash
, mi_hi_bytes
+ , mi_self_recomp_info
} <- PrivateModIface
{ mi_module_ = mi_module
, mi_sig_of_ = mi_sig_of
, mi_hsc_src_ = mi_hsc_src
, mi_deps_ = mi_deps
- , mi_usages_ = mi_usages
, mi_exports_ = mi_exports
, mi_used_th_ = mi_used_th
, mi_fixities_ = mi_fixities
@@ -1056,6 +1012,6 @@ pattern ModIface
, mi_docs_ = mi_docs
, mi_final_exts_ = mi_final_exts
, mi_ext_fields_ = mi_ext_fields
- , mi_src_hash_ = mi_src_hash
, mi_hi_bytes_ = mi_hi_bytes
+ , mi_self_recomp_info_ = mi_self_recomp_info
}
=====================================
compiler/GHC/Unit/Module/ModIface/SelfRecomp.hs
=====================================
@@ -0,0 +1,111 @@
+module GHC.Unit.Module.ModIface.SelfRecomp where
+
+import GHC.Prelude
+import GHC.Fingerprint
+import GHC.Utils.Outputable
+import GHC.Unit.Module.Deps
+
+import GHC.Utils.Binary
+
+import Control.DeepSeq
+
+{-
+Note [Self recompilation information in interface files]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The flag -fwrite-if-self-recomp controls whether
+interface files contain the information necessary to answer the
+question:
+
+ Is the interface file up-to-date, relative to:
+ * the source file it corresponds to,
+ * the flags passed to the GHC invocation to compile it,
+ * its dependencies (e.g. imported items, watched files added by addDependentFile, ...)
+
+If there is no self-recompilation information stored, then we always re-generate
+the interface file from scratch.
+
+Why? Most packages are only built once either by a distribution or cabal
+and then placed into an immutable store, after which we will never ask
+this question. Therefore we can derive two benefits from omitting this
+information.
+
+* Primary motivation: It vastly reduces the surface area for creating
+ non-deterministic interface files. See issue #10424 which motivated a
+ proper fix to that issue. Distributions have long contained versions
+ of GHC which just have broken self-recompilation checking (in order to
+ get deterministic interface files).
+
+* Secondary motivation: This reduces the size of interface files
+ slightly.. the `mi_usages` field can be quite big but probably this
+ isn't such a great benefit.
+
+* Third motivation: Conceptually clarity about which parts of an
+ interface file are used in order to **communicate** with subsequent
+ packages about the **interface** for a module. And which parts are
+ used to self-communicate during recompilation checking.
+
+The main tracking issue is #22188 but fixes issues such as #10424 in a
+proper way.
+
+-}
+
+-- | The information for a module which is only used when deciding whether to recompile
+-- itself.
+--
+-- See Note [Self recompilation information in interface files]
+data ModIfaceSelfRecomp =
+ ModIfaceSelfRecomp { mi_sr_src_hash :: !Fingerprint
+ -- ^ Hash of the .hs source, used for recompilation checking.
+ , mi_sr_usages :: [Usage]
+ -- ^ Usages; kept sorted so that it's easy to decide
+ -- whether to write a new iface file (changing usages
+ -- doesn't affect the hash of this module)
+ -- NOT STRICT! we read this field lazily from the interface file
+ -- It is *only* consulted by the recompilation checker
+
+ , mi_sr_flag_hash :: !Fingerprint
+ -- ^ Hash of the important flags used when compiling the module, excluding
+ -- optimisation flags
+ , mi_sr_opt_hash :: !Fingerprint
+ -- ^ Hash of optimisation flags
+ , mi_sr_hpc_hash :: !Fingerprint
+ -- ^ Hash of hpc flags
+ , mi_sr_plugin_hash :: !Fingerprint
+ -- ^ Hash of plugins
+ }
+
+
+instance Binary ModIfaceSelfRecomp where
+ put_ bh (ModIfaceSelfRecomp{mi_sr_src_hash, mi_sr_usages, mi_sr_flag_hash, mi_sr_opt_hash, mi_sr_hpc_hash, mi_sr_plugin_hash}) = do
+ put_ bh mi_sr_src_hash
+ lazyPut bh mi_sr_usages
+ put_ bh mi_sr_flag_hash
+ put_ bh mi_sr_opt_hash
+ put_ bh mi_sr_hpc_hash
+ put_ bh mi_sr_plugin_hash
+
+ get bh = do
+ src_hash <- get bh
+ usages <- lazyGet bh
+ flag_hash <- get bh
+ opt_hash <- get bh
+ hpc_hash <- get bh
+ plugin_hash <- get bh
+ return $ ModIfaceSelfRecomp { mi_sr_src_hash = src_hash, mi_sr_usages = usages, mi_sr_flag_hash = flag_hash, mi_sr_opt_hash = opt_hash, mi_sr_hpc_hash = hpc_hash, mi_sr_plugin_hash = plugin_hash }
+
+instance Outputable ModIfaceSelfRecomp where
+ ppr (ModIfaceSelfRecomp{mi_sr_src_hash, mi_sr_usages, mi_sr_flag_hash, mi_sr_opt_hash, mi_sr_hpc_hash, mi_sr_plugin_hash})
+ = vcat [text "Self-Recomp"
+ , nest 2 (vcat [ text "src hash:" <+> ppr mi_sr_src_hash
+ , text "usages:" <+> ppr (length mi_sr_usages)
+ , text "flag hash:" <+> ppr mi_sr_flag_hash
+ , text "opt hash:" <+> ppr mi_sr_opt_hash
+ , text "hpc hash:" <+> ppr mi_sr_hpc_hash
+ , text "plugin hash:" <+> ppr mi_sr_plugin_hash
+ ])]
+
+instance NFData ModIfaceSelfRecomp where
+ -- Note (MP): does not deeply force Usages but the old ModIface logic didn't either, so
+ -- I left it as a shallow force.
+ rnf (ModIfaceSelfRecomp src_hash usages flag_hash opt_hash hpc_hash plugin_hash)
+ = src_hash `seq` usages `seq` flag_hash `seq` opt_hash `seq` hpc_hash `seq` plugin_hash `seq` ()
\ No newline at end of file
=====================================
compiler/ghc.cabal.in
=====================================
@@ -955,6 +955,7 @@ Library
GHC.Unit.Module.ModDetails
GHC.Unit.Module.ModGuts
GHC.Unit.Module.ModIface
+ GHC.Unit.Module.ModIface.SelfRecomp
GHC.Unit.Module.WholeCoreBindings
GHC.Unit.Module.ModSummary
GHC.Unit.Module.Status
=====================================
docs/users_guide/phases.rst
=====================================
@@ -702,6 +702,24 @@ Options affecting code generation
depend on the optimisation level. Any definitions which are already included in
an interface file (via an unfolding for an exported identifier) are reused.
+.. ghc-flag:: -fwrite-if-self-recomp
+ :shortdesc: Write information for self-recompilation checking in an interface file
+ :type: dynamic
+ :category: codegen
+
+ :default: on
+
+ Include information in an interface file which can be used in future to determine
+ whether we need to recompile a module or can reuse the existing interface.
+
+ This is intended to be turned off in situations where you know you will never try
+ to recompile a module, such as when compiling a package for distribution.
+ The advantage is that by omitting unecessary information to do with dependencies
+ there is less chance of build paths leaking into the interface file and affecting
+ determinism.
+
+
+
.. ghc-flag:: -fobject-code
:shortdesc: Generate object code
=====================================
hadrian/doc/flavours.md
=====================================
@@ -107,7 +107,7 @@ when compiling the `compiler` library, and `hsGhc` when compiling/linking the GH
<td>-O2</td>
</tr>
<tr>
- <th>release (same as perf with -haddock)</td>
+ <th>release (same as perf with -haddock and +no_self_recomp)</td>
<td></td>
<td>-O<br>-H64m</td>
<td>-O<br>-H64m</td>
@@ -329,6 +329,10 @@ The supported transformers are listed below:
<td><code>dump_stg</code></td>
<td>Dump STG of all modules compiled by a stage1 compiler to a file</td>
</tr>
+ <tr>
+ <td><code>no_self_recomp</code></td>
+ <td>Disable including self-recompilation information in interface files via <code>-fno-write-if-self-recomp</code>. If you are building a distribution you can enable this flag to produce more deterministic interface files.</td>
+ </tr>
</table>
### Static
=====================================
hadrian/src/Flavour.hs
=====================================
@@ -16,6 +16,7 @@ module Flavour
, disableProfiledLibs
, enableLinting
, enableHaddock
+ , disableSelfRecompInfo
, enableHiCore
, useNativeBignum
, enableTextWithSIMDUTF
@@ -67,6 +68,7 @@ flavourTransformers = M.fromList
, "debug_stage1_ghc" =: debugGhc Stage1
, "lint" =: enableLinting
, "haddock" =: enableHaddock
+ , "no_self_recomp" =: disableSelfRecompInfo
, "hi_core" =: enableHiCore
, "late_ccs" =: enableLateCCS
, "boot_nonmoving_gc" =: enableBootNonmovingGc
@@ -208,6 +210,17 @@ enableHaddock =
[ arg "-haddock"
]
+-- | Disable self recompilation information in interface files
+disableSelfRecompInfo :: Flavour -> Flavour
+disableSelfRecompInfo =
+ addArgs $ stage1 ? mconcat
+ [ builder (Ghc CompileHs) ? selfRecomp
+ ]
+ where
+ selfRecomp = mconcat
+ [ arg "-fno-write-if-self-recomp"
+ ]
+
-- | Build stage2 dependencies with options to emit Core into
-- interface files which is sufficient to restart code generation.
enableHiCore :: Flavour -> Flavour
=====================================
hadrian/src/Settings/Flavours/Release.hs
=====================================
@@ -4,4 +4,8 @@ import Settings.Flavours.Performance
import Flavour
releaseFlavour :: Flavour
-releaseFlavour = enableHaddock performanceFlavour { name = "release" }
+releaseFlavour =
+ -- 1. These interface files will be distributed and the source files never recompiled.
+ disableSelfRecompInfo
+ -- 2. Include documentation in the interface for tools such as haddock and HLS to use
+ $ enableHaddock performanceFlavour { name = "release" }
=====================================
testsuite/tests/count-deps/CountDepsAst.stdout
=====================================
@@ -201,6 +201,7 @@ GHC.Unit.Module.Env
GHC.Unit.Module.Imported
GHC.Unit.Module.Location
GHC.Unit.Module.ModIface
+GHC.Unit.Module.ModIface.SelfRecomp
GHC.Unit.Module.Warnings
GHC.Unit.Module.WholeCoreBindings
GHC.Unit.Parser
=====================================
testsuite/tests/count-deps/CountDepsParser.stdout
=====================================
@@ -227,6 +227,7 @@ GHC.Unit.Module.Graph
GHC.Unit.Module.Imported
GHC.Unit.Module.Location
GHC.Unit.Module.ModIface
+GHC.Unit.Module.ModIface.SelfRecomp
GHC.Unit.Module.ModNodeKey
GHC.Unit.Module.ModSummary
GHC.Unit.Module.Warnings
=====================================
testsuite/tests/driver/self-recomp/Makefile
=====================================
@@ -0,0 +1,38 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+TEST_HC_OPTS_NO_RTSOPTS = $(filter-out -rtsopts,$(TEST_HC_OPTS))
+
+# -----------------------------------------------------------------------------
+# One-shot compilations, non-hierarchical modules
+
+# Check that modifying flags doesn't affect interface
+SelfRecomp01:
+ "$(TEST_HC)" $(TEST_HC_OPTS) SelfRecomp01.hs -fno-write-if-self-recomp -v0
+ "$(TEST_HC)" --show-iface SelfRecomp01.hi > iface1
+ rm SelfRecomp01.hi
+ "$(TEST_HC)" $(TEST_HC_OPTS) SelfRecomp01.hs -fno-write-if-self-recomp -Iidir -v0
+ "$(TEST_HC)" --show-iface SelfRecomp01.hi > iface2
+ diff iface1 iface2
+
+# Check that the result of addDependentFile doesn't end up in interface
+SelfRecomp02:
+ "$(TEST_HC)" $(TEST_HC_OPTS) SelfRecomp02.hs -fno-write-if-self-recomp -v0
+ "$(TEST_HC)" --show-iface SelfRecomp02.hi > iface
+ [ -z $(grep iface SelfRecomp02.hs) ]
+
+# Check that modifying source doesn't affect interface
+SelfRecomp03:
+ "$(TEST_HC)" $(TEST_HC_OPTS) SelfRecomp03.hs -fno-write-if-self-recomp -v0
+ "$(TEST_HC)" --show-iface SelfRecomp03.hi > iface1
+ rm SelfRecomp03.hi
+ echo "" >> SelfRecomp03.hs
+ "$(TEST_HC)" $(TEST_HC_OPTS) SelfRecomp03.hs -fno-write-if-self-recomp -v0
+ "$(TEST_HC)" --show-iface SelfRecomp03.hi > iface2
+ diff iface1 iface2
+
+# Check that if you don't have recompilation info then you always recompile.
+SelfRecomp04:
+ "$(TEST_HC)" $(TEST_HC_OPTS) SelfRecomp04.hs -fno-write-if-self-recomp -fhide-source-paths
+ "$(TEST_HC)" $(TEST_HC_OPTS) SelfRecomp04.hs -fno-write-if-self-recomp -fhide-source-paths
=====================================
testsuite/tests/driver/self-recomp/SelfRecomp01.hs
=====================================
@@ -0,0 +1,2 @@
+module SelfRecomp01 where
+
=====================================
testsuite/tests/driver/self-recomp/SelfRecomp02.hs
=====================================
@@ -0,0 +1,6 @@
+{-# LANGUAGE TemplateHaskell #-}
+module SelfRecomp02 where
+
+import Language.Haskell.TH.Syntax
+
+main = $(addDependentFile "SelfRecomp02.hs" >> [| print () |])
=====================================
testsuite/tests/driver/self-recomp/SelfRecomp03.hs
=====================================
@@ -0,0 +1,2 @@
+module SelfRecomp03 where
+
=====================================
testsuite/tests/driver/self-recomp/SelfRecomp04.hs
=====================================
@@ -0,0 +1 @@
+module SelfRecomp04 where
=====================================
testsuite/tests/driver/self-recomp/SelfRecomp04.stdout
=====================================
@@ -0,0 +1,2 @@
+[1 of 1] Compiling SelfRecomp04
+[1 of 1] Compiling SelfRecomp04 [Old interface lacks recompilation info]
=====================================
testsuite/tests/driver/self-recomp/all.T
=====================================
@@ -0,0 +1,4 @@
+test('SelfRecomp01', normal, makefile_test, ['SelfRecomp01'])
+test('SelfRecomp02', normal, makefile_test, ['SelfRecomp02'])
+test('SelfRecomp03', [copy_files], makefile_test, ['SelfRecomp03'])
+test('SelfRecomp04', normal, makefile_test, ['SelfRecomp04'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/782f46032853d42952d1c041bd66048efa8d6f65...cf4972430f38429b07ca978faef21d3d4a17d12c
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/782f46032853d42952d1c041bd66048efa8d6f65...cf4972430f38429b07ca978faef21d3d4a17d12c
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/20250305/e6dc47ae/attachment-0001.html>
More information about the ghc-commits
mailing list