[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
Tue Mar 4 11:52:45 UTC 2025
Matthew Pickering pushed to branch wip/22188 at Glasgow Haskell Compiler / GHC
Commits:
7bc4f9e7 by Matthew Pickering at 2025-03-04T11:51:15+00:00
Add flag to control whether self-recompilation information is written to interface
This patch adds the flag -fwrite-self-recomp-info 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.
- - - - -
29c3d23e by Matthew Pickering at 2025-03-04T11:52:23+00:00
Disable self recomp in release flavour
- - - - -
27 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/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-self-recomp-info" 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
=====================================
@@ -50,7 +50,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
@@ -115,7 +114,7 @@ readBinIfaceHeader
-> CheckHiWay
-> TraceBinIFace
-> FilePath
- -> IO (Fingerprint, ReadBinHandle)
+ -> IO ReadBinHandle
readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do
let platform = profilePlatform profile
@@ -157,8 +156,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.
--
@@ -171,12 +169,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
@@ -260,7 +257,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,50 @@ 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
+
+{-
+Note [Self recompilation information in interface files]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+The flag -fwrite-self-recomp-info 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.
+
+-}
+
+
-- | 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 +286,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
@@ -352,13 +383,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
@@ -404,6 +437,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
@@ -461,9 +512,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
@@ -471,7 +519,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,
@@ -493,13 +540,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,
@@ -508,16 +552,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
@@ -543,16 +583,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
@@ -577,15 +613,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,
@@ -607,13 +640,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,
@@ -632,10 +662,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_ = [],
@@ -655,21 +683,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,
@@ -699,18 +725,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_
@@ -731,20 +756,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
@@ -810,27 +829,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 and 'mi_top_env'.
---
--- 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 }
@@ -840,8 +838,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 }
@@ -849,9 +847,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 }
@@ -976,7 +971,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 #-}
@@ -996,25 +990,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
@@ -1035,14 +1027,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
@@ -1063,6 +1054,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,70 @@
+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
+
+-- | The information for a module which is only used when deciding whether to recompile
+-- itself. In particular the external interface of a module is recorded by the ABI
+-- hash
+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
+ -- MP: Note 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-self-recomp-info
+ :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/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-self-recomp-info"
+ ]
+
-- | 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-self-recomp-info -v0
+ "$(TEST_HC)" --show-iface SelfRecomp01.hi > iface1
+ rm SelfRecomp01.hi
+ "$(TEST_HC)" $(TEST_HC_OPTS) SelfRecomp01.hs -fno-write-self-recomp-info -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-self-recomp-info -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-self-recomp-info -v0
+ "$(TEST_HC)" --show-iface SelfRecomp03.hi > iface1
+ rm SelfRecomp03.hi
+ echo "" >> SelfRecomp03.hs
+ "$(TEST_HC)" $(TEST_HC_OPTS) SelfRecomp03.hs -fno-write-self-recomp-info -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-self-recomp-info -fhide-source-paths
+ "$(TEST_HC)" $(TEST_HC_OPTS) SelfRecomp04.hs -fno-write-self-recomp-info -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/7161670210e28dc554b3da6313aafe4d777901b8...29c3d23ebbd9ff562d94e9a82e6aa5203b01681c
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7161670210e28dc554b3da6313aafe4d777901b8...29c3d23ebbd9ff562d94e9a82e6aa5203b01681c
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/20250304/1f51b52e/attachment-0001.html>
More information about the ghc-commits
mailing list