[Git][ghc/ghc][wip/refactor-iface] iface: Store logical parts of ModIface together
Matthew Pickering (@mpickering)
gitlab at gitlab.haskell.org
Fri Mar 14 11:46:29 UTC 2025
Matthew Pickering pushed to branch wip/refactor-iface at Glasgow Haskell Compiler / GHC
Commits:
9d84972f by Matthew Pickering at 2025-03-14T11:06:06+00:00
iface: Store logical parts of ModIface together
The ModIface structure is divided into several logical parts:
1. mi_mod_info: Basic module metadata (name, version, etc.)
2. mi_public: The public interface of the module (the ABI), which includes:
- Exports, declarations, fixities, warnings, annotations
- Class and type family instances
- Rewrite rules and COMPLETE pragmas
- Safe Haskell and package trust information
- ABI hashes for recompilation checking
4. mi_self_recomp: Information needed for self-recompilation checking
(see Note [Self recompilation information in interface files])
5. mi_simplified_core: Optional simplified Core for bytecode generation
(only present when -fwrite-if-simplified-core is enabled)
6. mi_docs: Optional documentation (only present when -haddock is enabled)
7. mi_top_env: Information about the top-level environment of the original source
8. mi_ext_fields: Additional fields for extensibility
This structure helps organize the interface data according to its purpose and usage
patterns. Different parts of the compiler use different fields. By separating them
logically in the interface we can arrange to only deserialize the fields that are needed.
This patch also enforces the invariant that the fields of ModIface are
lazy. If you are keeping a ModIface on disk, then force it using
`forceModIface`. Otherwise, when the `ModIface` is read from disk, only
the parts which are needed from the interface will be deserialised.
In a follow-up patch I will tackle follow-up issues:
* Recompilation checking doesn't take into account exported named defaults (#25855)
* Recompilation checking does not take into account COMPLETE pragmas (#25854)
* mi_deps_ field in an interface is confused about whether the
information is for self-recompilation checking or part of the ABI
(#25844)
Fixes #25845
-------------------------
Metric Decrease:
MultiLayerModulesDefsGhciWithCore
-------------------------
- - - - -
17 changed files:
- compiler/GHC.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/HsToCore/Usage.hs
- compiler/GHC/Iface/Flags.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Iface/Make.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Iface/Recomp/Types.hs
- compiler/GHC/Rename/Fixity.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Tc/Instance/Family.hs
- compiler/GHC/Tc/Utils/Backpack.hs
- compiler/GHC/Unit/Module/Deps.hs
- compiler/GHC/Unit/Module/ModIface.hs
- compiler/GHC/Utils/Binary.hs
- ghc/Main.hs
Changes:
=====================================
compiler/GHC.hs
=====================================
@@ -100,29 +100,37 @@ module GHC (
findGlobalAnns,
mkNamePprCtxForModule,
ModIface,
- ModIface_(
- mi_module,
- mi_sig_of,
- mi_hsc_src,
- mi_hi_bytes,
- mi_deps,
- mi_exports,
- mi_fixities,
- mi_warns,
- mi_anns,
- mi_insts,
- mi_fam_insts,
- mi_rules,
- mi_decls,
- mi_extra_decls,
- mi_top_env,
- mi_trust,
- mi_trust_pkg,
- mi_complete_matches,
- mi_docs,
- mi_final_exts,
- mi_ext_fields
- ),
+ ModIface_( mi_mod_info
+ , mi_module
+ , mi_sig_of
+ , mi_hsc_src
+ , mi_iface_hash
+ , mi_deps
+ , mi_public
+ , mi_exports
+ , mi_fixities
+ , mi_warns
+ , mi_anns
+ , mi_decls
+ , mi_defaults
+ , mi_simplified_core
+ , mi_top_env
+ , mi_insts
+ , mi_fam_insts
+ , mi_rules
+ , mi_trust
+ , mi_trust_pkg
+ , mi_complete_matches
+ , mi_docs
+ , mi_abi_hashes
+ , mi_ext_fields
+ , mi_hi_bytes
+ , mi_self_recomp_info
+ , mi_fix_fn
+ , mi_decl_warn_fn
+ , mi_export_warn_fn
+ , mi_hash_fn
+ ),
pattern ModIface,
SafeHaskellMode(..),
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -844,7 +844,7 @@ hscRecompStatus
case recomp_if_result of
OutOfDateItem reason mb_checked_iface -> do
msg $ NeedsRecompile reason
- return $ HscRecompNeeded $ fmap (mi_iface_hash . mi_final_exts) mb_checked_iface
+ return $ HscRecompNeeded $ fmap mi_iface_hash mb_checked_iface
UpToDateItem checked_iface -> do
let lcl_dflags = ms_hspp_opts mod_summary
if | not (backendGeneratesCode (backend lcl_dflags)) -> do
@@ -862,7 +862,7 @@ hscRecompStatus
, xopt LangExt.TemplateHaskell lcl_dflags
-> do
msg $ needsRecompileBecause THWithJS
- return $ HscRecompNeeded $ Just $ mi_iface_hash $ mi_final_exts $ checked_iface
+ return $ HscRecompNeeded $ Just $ mi_iface_hash $ checked_iface
| otherwise -> do
-- Do need linkable
@@ -918,7 +918,7 @@ hscRecompStatus
return $ HscUpToDate checked_iface $ linkable
OutOfDateItem reason _ -> do
msg $ NeedsRecompile reason
- return $ HscRecompNeeded $ Just $ mi_iface_hash $ mi_final_exts $ checked_iface
+ return $ HscRecompNeeded $ Just $ mi_iface_hash $ checked_iface
-- | Check that the .o files produced by compilation are already up-to-date
-- or not.
@@ -968,10 +968,8 @@ loadByteCode iface mod_sum = do
let
this_mod = ms_mod mod_sum
if_date = fromJust $ ms_iface_date mod_sum
- case mi_extra_decls iface of
- Just extra_decls -> do
- let fi = WholeCoreBindings extra_decls this_mod (ms_location mod_sum)
- (mi_foreign iface)
+ case iface_core_bindings iface (ms_location mod_sum) of
+ Just fi -> do
return (UpToDateItem (Linkable if_date this_mod (NE.singleton (CoreBindings fi))))
_ -> return $ outOfDateItemBecause MissingBytecode Nothing
@@ -1019,15 +1017,15 @@ compile_for_interpreter hsc_env use =
-- | Assemble 'WholeCoreBindings' if the interface contains Core bindings.
iface_core_bindings :: ModIface -> ModLocation -> Maybe WholeCoreBindings
iface_core_bindings iface wcb_mod_location =
- mi_extra_decls <&> \ wcb_bindings ->
+ mi_simplified_core <&> \(IfaceSimplifiedCore bindings foreign') ->
WholeCoreBindings {
- wcb_bindings,
+ wcb_bindings = bindings,
wcb_module = mi_module,
wcb_mod_location,
- wcb_foreign = mi_foreign
+ wcb_foreign = foreign'
}
where
- ModIface {mi_module, mi_extra_decls, mi_foreign} = iface
+ ModIface {mi_module, mi_simplified_core} = iface
-- | Return an 'IO' that hydrates Core bindings and compiles them to bytecode if
-- the interface contains any, using the supplied type env for typechecking.
@@ -1376,7 +1374,7 @@ hscMaybeWriteIface logger dflags is_simple iface old_iface mod_location = do
-- dynamic interfaces. Hopefully both the dynamic and the non-dynamic
-- interfaces stay in sync...
--
- let change = old_iface /= Just (mi_iface_hash (mi_final_exts iface))
+ let change = old_iface /= Just (mi_iface_hash iface)
let dt = dynamicTooState dflags
=====================================
compiler/GHC/HsToCore/Usage.hs
=====================================
@@ -185,7 +185,7 @@ mkObjectUsage pit plugins fc hug th_links_needed th_pkgs_needed = do
case miface of
Nothing -> pprPanic "mkObjectUsage" (ppr m)
Just iface ->
- return $ UsageHomeModuleInterface (moduleName m) (toUnitId $ moduleUnit m) (mi_iface_hash (mi_final_exts iface))
+ return $ UsageHomeModuleInterface (moduleName m) (toUnitId $ moduleUnit m) (mi_iface_hash iface)
librarySpecToUsage :: LibrarySpec -> IO [Usage]
librarySpecToUsage (Objects os) = traverse (fing Nothing) os
@@ -278,10 +278,10 @@ mk_mod_usage_info uc home_unit home_unit_ids this_mod direct_imports used_names
usg_entities = Map.toList ent_hashs,
usg_safe = imp_safe }
where
- finsts_mod = mi_finsts (mi_final_exts iface)
- hash_env = mi_hash_fn (mi_final_exts iface)
- mod_hash = mi_mod_hash (mi_final_exts iface)
- export_hash | depend_on_exports = Just (mi_exp_hash (mi_final_exts iface))
+ finsts_mod = mi_finsts iface
+ hash_env = mi_hash_fn iface
+ mod_hash = mi_mod_hash iface
+ export_hash | depend_on_exports = Just (mi_exp_hash iface)
| otherwise = Nothing
by_is_safe (ImportedByUser imv) = imv_is_safe imv
=====================================
compiler/GHC/Iface/Flags.hs
=====================================
@@ -41,34 +41,28 @@ data IfaceDynFlags = IfaceDynFlags
, ifaceCallerCCFilters :: [CallerCcFilter]
}
-pprIfaceDynFlags :: (Fingerprint, Maybe IfaceDynFlags) -> SDoc
-pprIfaceDynFlags (f, mflags) =
- vcat $
- [ text "fingerprint:" <+> (ppr f)
- ]
- ++ case mflags of
- Nothing -> [missingExtraFlagInfo]
- Just (IfaceDynFlags a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14) ->
- [ text "main-is:" <+> (ppr $ fmap (fmap (text @SDoc)) a1)
- , text "safe-mode:" <+> ppr a2
- , text "lang:" <+> ppr a3
- , text "exts:" <+> ppr a4
- , text "cpp-options:"
- , nest 2 $ ppr a5
- , text "js-options:"
- , nest 2 $ ppr a6
- , text "cmm-options:"
- , nest 2 $ ppr a7
- , text "paths:" <+> hcat (map text a8)
- , text "prof:" <+> ppr a9
- , text "ticky:"
- , nest 2 $ vcat (map ppr a10)
- , text "codegen:"
- , nest 2 $ vcat (map ppr a11)
- , text "fat-iface:" <+> ppr a12
- , text "debug-level:" <+> ppr a13
- , text "caller-cc-filters:" <+> ppr a14
- ]
+pprIfaceDynFlags :: IfaceDynFlags -> SDoc
+pprIfaceDynFlags (IfaceDynFlags a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14) =
+ vcat [ text "main-is:" <+> (ppr $ fmap (fmap (text @SDoc)) a1)
+ , text "safe-mode:" <+> ppr a2
+ , text "lang:" <+> ppr a3
+ , text "exts:" <+> ppr a4
+ , text "cpp-options:"
+ , nest 2 $ ppr a5
+ , text "js-options:"
+ , nest 2 $ ppr a6
+ , text "cmm-options:"
+ , nest 2 $ ppr a7
+ , text "paths:" <+> hcat (map text a8)
+ , text "prof:" <+> ppr a9
+ , text "ticky:"
+ , nest 2 $ vcat (map ppr a10)
+ , text "codegen:"
+ , nest 2 $ vcat (map ppr a11)
+ , text "fat-iface:" <+> ppr a12
+ , text "debug-level:" <+> ppr a13
+ , text "caller-cc-filters:" <+> ppr a14
+ ]
missingExtraFlagInfo :: SDoc
missingExtraFlagInfo = text "flags: no detailed info, recompile with -fwrite-if-self-recomp-flags"
=====================================
compiler/GHC/Iface/Load.hs
=====================================
@@ -59,7 +59,6 @@ import GHC.Driver.Plugins
import GHC.Iface.Warnings
import GHC.Iface.Syntax
import GHC.Iface.Ext.Fields
-import GHC.Iface.Flags
import GHC.Iface.Binary
import GHC.Iface.Rename
import GHC.Iface.Env
@@ -74,7 +73,6 @@ import GHC.Utils.Outputable as Outputable
import GHC.Utils.Panic
import GHC.Utils.Constants (debugIsOn)
import GHC.Utils.Logger
-import GHC.Utils.Fingerprint( Fingerprint )
import GHC.Settings.Constants
@@ -644,7 +642,7 @@ loadInterface doc_str mod from
& set_mi_fam_insts (panic "No mi_fam_insts in PIT")
& set_mi_rules (panic "No mi_rules in PIT")
& set_mi_anns (panic "No mi_anns in PIT")
- & set_mi_extra_decls (panic "No mi_extra_decls in PIT")
+ & set_mi_simplified_core (panic "No mi_simplified_core in PIT")
bad_boot = mi_boot iface == IsBoot
&& isJust (lookupKnotVars (if_rec_types gbl_env) mod)
@@ -1083,7 +1081,7 @@ load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags
load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc = do
read_file logger name_cache unit_state dflags wanted_mod (ml_dyn_hi_file loc) >>= \case
Succeeded (dynIface, _)
- | mi_mod_hash (mi_final_exts iface) == mi_mod_hash (mi_final_exts dynIface)
+ | mi_mod_hash iface == mi_mod_hash dynIface
-> return (Succeeded ())
| otherwise ->
do return $ (Failed $ DynamicHashMismatchError wanted_mod loc)
@@ -1174,11 +1172,10 @@ ghcPrimIface
& set_mi_exports ghcPrimExports
& set_mi_decls []
& set_mi_fixities ghcPrimFixities
- & set_mi_final_exts ((mi_final_exts empty_iface)
- { mi_fix_fn = mkIfaceFixCache ghcPrimFixities
- , mi_decl_warn_fn = mkIfaceDeclWarnCache ghcPrimWarns
- , mi_export_warn_fn = mkIfaceExportWarnCache ghcPrimWarns
- })
+ & set_mi_fix_fn (mkIfaceFixCache ghcPrimFixities)
+ & set_mi_decl_warn_fn (mkIfaceDeclWarnCache ghcPrimWarns)
+ & set_mi_export_warn_fn (mkIfaceExportWarnCache ghcPrimWarns)
+ & set_mi_fix_fn (mkIfaceFixCache ghcPrimFixities)
& set_mi_docs (Just ghcPrimDeclDocs) -- See Note [GHC.Prim Docs] in GHC.Builtin.Utils
& set_mi_warns (toIfaceWarnings ghcPrimWarns) -- See Note [GHC.Prim Deprecations] in GHC.Builtin.Utils
@@ -1263,21 +1260,14 @@ pprModIface unit_state iface
= 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_orphan iface then text "[orphan module]" else Outputable.empty)
+ <+> (if mi_finsts iface then text "[family instance module]" else Outputable.empty)
<+> integer hiVersion
- , nest 2 (text "ABI hash:" <+> ppr (mi_mod_hash exts))
- , nest 2 (text "interface hash:" <+> ppr (mi_iface_hash (mi_final_exts iface)))
- , 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 "flags:" <+> pprIfaceDynFlags 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 "ABI hash:" <+> ppr (mi_mod_hash iface))
+ , nest 2 (text "interface hash:" <+> ppr (mi_iface_hash iface))
+ , nest 2 (text "export-list hash:" <+> ppr (mi_exp_hash iface))
+ , withSelfRecomp iface empty ppr
+ , nest 2 (text "orphan hash:" <+> ppr (mi_orphan_hash iface))
, nest 2 (text "sig of:" <+> ppr (mi_sig_of iface))
, nest 2 (text "where")
, text "exports:"
@@ -1288,10 +1278,14 @@ pprModIface unit_state iface
, vcat (map pprIfaceAnnotation (mi_anns iface))
, pprFixities (mi_fixities iface)
, vcat [ppr ver $$ nest 2 (ppr decl) | (ver,decl) <- mi_decls iface]
- , case mi_extra_decls iface of
+ , case mi_simplified_core iface of
Nothing -> empty
- Just eds -> text "extra decls:"
- $$ nest 2 (vcat ([ppr bs | bs <- eds]))
+ Just (IfaceSimplifiedCore eds fs) ->
+ vcat [ text "extra decls:"
+ $$ nest 2 (vcat ([ppr bs | bs <- eds]))
+ , text "foreign stubs:"
+ $$ nest 2 (ppr fs)
+ ]
, vcat (map ppr (mi_insts iface))
, vcat (map ppr (mi_fam_insts iface))
, vcat (map ppr (mi_rules iface))
@@ -1303,7 +1297,6 @@ pprModIface unit_state iface
, text "extensible fields:" $$ nest 2 (pprExtensibleFields (mi_ext_fields iface))
]
where
- exts = mi_final_exts iface
pp_hsc_src HsBootFile = text "[boot]"
pp_hsc_src HsigFile = text "[hsig]"
@@ -1329,35 +1322,6 @@ pprExport avail@(AvailTC n _) =
pp_export [] = Outputable.empty
pp_export names = braces (hsep (map ppr names))
-pprUsage :: Usage -> SDoc
-pprUsage UsagePackageModule{ usg_mod = mod, usg_mod_hash = hash, usg_safe = safe }
- = pprUsageImport mod hash safe
-pprUsage UsageHomeModule{ usg_unit_id = unit_id, usg_mod_name = mod_name
- , usg_mod_hash = hash, usg_safe = safe
- , usg_exports = exports, usg_entities = entities }
- = pprUsageImport (mkModule unit_id mod_name) hash safe $$
- nest 2 (
- maybe Outputable.empty (\v -> text "exports: " <> ppr v) exports $$
- vcat [ ppr n <+> ppr v | (n,v) <- entities ]
- )
-pprUsage usage at UsageFile{}
- = hsep [text "addDependentFile",
- doubleQuotes (ftext (usg_file_path usage)),
- ppr (usg_file_hash usage)]
-pprUsage usage at UsageMergedRequirement{}
- = hsep [text "merged", ppr (usg_mod usage), ppr (usg_mod_hash usage)]
-pprUsage usage at UsageHomeModuleInterface{}
- = hsep [text "implementation", ppr (usg_mod_name usage)
- , ppr (usg_unit_id usage)
- , ppr (usg_iface_hash usage)]
-
-pprUsageImport :: Outputable mod => mod -> Fingerprint -> IsSafeImport -> SDoc
-pprUsageImport mod hash safe
- = hsep [ text "import", pp_safe, ppr mod
- , ppr hash ]
- where
- pp_safe | safe = text "safe"
- | otherwise = text " -/ "
pprFixities :: [(OccName, Fixity)] -> SDoc
pprFixities [] = Outputable.empty
=====================================
compiler/GHC/Iface/Make.hs
=====================================
@@ -88,13 +88,13 @@ import GHC.Unit.Module.ModDetails
import GHC.Unit.Module.ModGuts
import GHC.Unit.Module.ModSummary
import GHC.Unit.Module.Deps
-import GHC.Unit.Module.WholeCoreBindings (encodeIfaceForeign)
+import GHC.Unit.Module.WholeCoreBindings (encodeIfaceForeign, emptyIfaceForeign)
import Data.Function
import Data.List ( sortBy )
import Data.Ord
import Data.IORef
-
+import Data.Traversable
{-
************************************************************************
@@ -143,11 +143,13 @@ mkFullIface hsc_env partial_iface mb_stg_infos mb_cmm_infos stubs foreign_files
= updateDecl (mi_decls partial_iface) mb_stg_infos mb_cmm_infos
-- See Note [Foreign stubs and TH bytecode linking]
- foreign_ <- encodeIfaceForeign (hsc_logger hsc_env) (hsc_dflags hsc_env) stubs foreign_files
+ mi_simplified_core <- for (mi_simplified_core partial_iface) $ \simpl_core -> do
+ fs <- encodeIfaceForeign (hsc_logger hsc_env) (hsc_dflags hsc_env) stubs foreign_files
+ return $ (simpl_core { mi_sc_foreign = fs })
full_iface <-
{-# SCC "addFingerprints" #-}
- addFingerprints hsc_env $ set_mi_foreign foreign_ $ set_mi_decls decls partial_iface
+ addFingerprints hsc_env $ set_mi_simplified_core mi_simplified_core $ set_mi_decls decls partial_iface
-- Debug printing
let unit_state = hsc_units hsc_env
@@ -289,7 +291,7 @@ mkIface_ :: HscEnv -> Module -> CoreProgram -> HscSource
-> NameEnv FixItem -> Warnings GhcRn
-> Bool
-> SafeHaskellMode
- -> Maybe ModIfaceSelfRecomp
+ -> Maybe IfaceSelfRecomp
-> Maybe Docs
-> ModDetails
-> PartialModIface
@@ -316,8 +318,8 @@ mkIface_ hsc_env
entities = typeEnvElts type_env
show_linear_types = xopt LangExt.LinearTypes (hsc_dflags hsc_env)
- extra_decls = if gopt Opt_WriteIfSimplifiedCore dflags then Just [ toIfaceTopBind b | b <- core_prog ]
- else Nothing
+ simplified_core = if gopt Opt_WriteIfSimplifiedCore dflags then Just (IfaceSimplifiedCore [ toIfaceTopBind b | b <- core_prog ] emptyIfaceForeign)
+ else Nothing
decls = [ tyThingToIfaceDecl show_linear_types entity
| entity <- entities,
let name = getName entity,
@@ -370,12 +372,12 @@ mkIface_ hsc_env
& set_mi_anns annotations
& set_mi_top_env rdrs
& set_mi_decls decls
- & set_mi_extra_decls extra_decls
+ & set_mi_simplified_core simplified_core
& set_mi_trust trust_info
& set_mi_trust_pkg pkg_trust_req
& set_mi_complete_matches (icomplete_matches)
& set_mi_docs docs
- & set_mi_final_exts ()
+ & set_mi_abi_hashes ()
& set_mi_ext_fields emptyExtensibleFields
& set_mi_hi_bytes PartialIfaceBinHandle
=====================================
compiler/GHC/Iface/Recomp.hs
=====================================
@@ -88,6 +88,7 @@ import Data.Ord
import Data.Containers.ListUtils
import Data.Bifunctor
import GHC.Iface.Errors.Ppr
+import Data.Functor
{-
-----------------------------------------------
@@ -325,8 +326,8 @@ check_old_iface hsc_env mod_summary maybe_iface
maybe_dyn_iface <- liftIO $ loadIface (setDynamicNow dflags) (msDynHiFilePath mod_summary)
case maybe_dyn_iface of
Nothing -> return $ outOfDateItemBecause MissingDynHiFile Nothing
- Just dyn_iface | mi_iface_hash (mi_final_exts dyn_iface)
- /= mi_iface_hash (mi_final_exts normal_iface)
+ Just dyn_iface | mi_iface_hash dyn_iface
+ /= mi_iface_hash normal_iface
-> return $ outOfDateItemBecause MismatchedDynHiFile Nothing
Just {} -> return res
_ -> return res
@@ -382,7 +383,7 @@ check_old_iface hsc_env mod_summary maybe_iface
checkVersions :: HscEnv
-> ModSummary
-> ModIface -- Old interface
- -> ModIfaceSelfRecomp
+ -> IfaceSelfRecomp
-> IfG (MaybeValidated ModIface)
checkVersions hsc_env mod_summary iface self_recomp
= do { liftIO $ trace_hi_diffs logger
@@ -435,7 +436,7 @@ checkVersions hsc_env mod_summary iface self_recomp
-- | Check if any plugins are requesting recompilation
-checkPlugins :: Plugins -> ModIfaceSelfRecomp -> IfG RecompileRequired
+checkPlugins :: Plugins -> IfaceSelfRecomp -> IfG RecompileRequired
checkPlugins plugins self_recomp = liftIO $ do
recomp <- recompPlugins plugins
let new_fingerprint = fingerprintPluginRecompile recomp
@@ -528,10 +529,10 @@ checkHie dflags mod_summary =
_ -> UpToDate
-- | Check the flags haven't changed
-checkFlagHash :: HscEnv -> Module -> ModIfaceSelfRecomp -> IO RecompileRequired
+checkFlagHash :: HscEnv -> Module -> IfaceSelfRecomp -> IO RecompileRequired
checkFlagHash hsc_env iface_mod self_recomp = do
let logger = hsc_logger hsc_env
- let (old_fp, old_flags) = mi_sr_flag_hash self_recomp
+ let FingerprintWithValue old_fp old_flags = mi_sr_flag_hash self_recomp
(new_fp, new_flags) <- fingerprintDynFlags hsc_env iface_mod putNameLiterally
if old_fp == new_fp
then up_to_date logger (text "Module flags unchanged")
@@ -573,7 +574,7 @@ checkIfaceFlags (IfaceDynFlags a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14)
if a' == b' then pure () else modify (([ text s <+> text "flags changed"] ++ [diffSimple p a b]) ++)
-- | Check the optimisation flags haven't changed
-checkOptimHash :: HscEnv -> ModIfaceSelfRecomp -> IO RecompileRequired
+checkOptimHash :: HscEnv -> IfaceSelfRecomp -> IO RecompileRequired
checkOptimHash hsc_env iface = do
let logger = hsc_logger hsc_env
let old_hash = mi_sr_opt_hash iface
@@ -589,7 +590,7 @@ checkOptimHash hsc_env iface = do
old_hash new_hash
-- | Check the HPC flags haven't changed
-checkHpcHash :: HscEnv -> ModIfaceSelfRecomp -> IO RecompileRequired
+checkHpcHash :: HscEnv -> IfaceSelfRecomp -> IO RecompileRequired
checkHpcHash hsc_env self_recomp = do
let logger = hsc_logger hsc_env
let old_hash = mi_sr_hpc_hash self_recomp
@@ -606,7 +607,7 @@ checkHpcHash hsc_env self_recomp = 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 -> ModIfaceSelfRecomp -> IO RecompileRequired
+checkMergedSignatures :: HscEnv -> ModSummary -> IfaceSelfRecomp -> IO RecompileRequired
checkMergedSignatures hsc_env mod_summary self_recomp = do
let logger = hsc_logger hsc_env
let unit_state = hsc_units hsc_env
@@ -748,7 +749,7 @@ checkModUsage _ UsagePackageModule{
logger <- getLogger
needInterface mod $ \iface -> do
let reason = ModuleChanged (moduleName mod)
- checkModuleFingerprint logger reason old_mod_hash (mi_mod_hash (mi_final_exts iface))
+ checkModuleFingerprint logger reason old_mod_hash (mi_mod_hash iface)
-- We only track the ABI hash of package modules, rather than
-- individual entity usages, so if the ABI hash changes we must
-- recompile. This is safe but may entail more recompilation when
@@ -758,7 +759,7 @@ checkModUsage _ UsageMergedRequirement{ usg_mod = mod, usg_mod_hash = old_mod_ha
logger <- getLogger
needInterface mod $ \iface -> do
let reason = ModuleChangedRaw (moduleName mod)
- checkModuleFingerprint logger reason old_mod_hash (mi_mod_hash (mi_final_exts iface))
+ checkModuleFingerprint logger reason old_mod_hash (mi_mod_hash iface)
checkModUsage _ UsageHomeModuleInterface{ usg_mod_name = mod_name
, usg_unit_id = uid
, usg_iface_hash = old_mod_hash } = do
@@ -766,7 +767,7 @@ checkModUsage _ UsageHomeModuleInterface{ usg_mod_name = mod_name
logger <- getLogger
needInterface mod $ \iface -> do
let reason = ModuleChangedIface mod_name
- checkIfaceFingerprint logger reason old_mod_hash (mi_iface_hash (mi_final_exts iface))
+ checkIfaceFingerprint logger reason old_mod_hash (mi_iface_hash iface)
checkModUsage _ UsageHomeModule{
usg_mod_name = mod_name,
@@ -779,9 +780,9 @@ checkModUsage _ UsageHomeModule{
logger <- getLogger
needInterface mod $ \iface -> do
let
- new_mod_hash = mi_mod_hash (mi_final_exts iface)
- new_decl_hash = mi_hash_fn (mi_final_exts iface)
- new_export_hash = mi_exp_hash (mi_final_exts iface)
+ new_mod_hash = mi_mod_hash iface
+ new_decl_hash = mi_hash_fn iface
+ new_export_hash = mi_exp_hash iface
reason = ModuleChanged (moduleName mod)
@@ -986,7 +987,7 @@ 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 :: HscEnv -> Module -> Fingerprint -> [Usage] -> IO IfaceSelfRecomp
mkSelfRecomp hsc_env this_mod src_hash usages = do
let dflags = hsc_dflags hsc_env
@@ -1000,10 +1001,10 @@ mkSelfRecomp hsc_env this_mod src_hash usages = do
let include_detailed_flags (flag_hash, flags) =
if gopt Opt_WriteSelfRecompFlags dflags
- then (flag_hash, Just flags)
- else (flag_hash, Nothing)
+ then FingerprintWithValue flag_hash (Just flags)
+ else FingerprintWithValue flag_hash Nothing
- return (ModIfaceSelfRecomp
+ return (IfaceSelfRecomp
{ mi_sr_flag_hash = include_detailed_flags dyn_flags_info
, mi_sr_hpc_hash = hpc_hash
, mi_sr_opt_hash = opt_hash
@@ -1018,28 +1019,92 @@ addFingerprints
:: HscEnv
-> PartialModIface
-> IO ModIface
-addFingerprints hsc_env iface0
- = do
- eps <- hscEPS hsc_env
- let
- decls = mi_decls iface0
- decl_warn_fn = mkIfaceDeclWarnCache (fromIfaceWarnings $ mi_warns iface0)
- export_warn_fn = mkIfaceExportWarnCache (fromIfaceWarnings $ mi_warns iface0)
- fix_fn = mkIfaceFixCache (mi_fixities iface0)
+addFingerprints hsc_env iface0 = do
+ (abiHashes, caches, decls_w_hashes) <- addAbiHashes hsc_env (mi_mod_info iface0) (mi_public iface0) (mi_deps iface0)
+
+ -- put the declarations in a canonical order, sorted by OccName
+ let sorted_decls :: [(Fingerprint, IfaceDecl)]
+ sorted_decls = Map.elems $ Map.fromList $
+ [(getOccName d, e) | e@(_, d) <- decls_w_hashes]
+
+ -- This key is safe because mi_extra_decls contains tidied things.
+ getOcc (IfGblTopBndr b) = getOccName b
+ getOcc (IfLclTopBndr fs _ _ details) =
+ case details of
+ IfRecSelId { ifRecSelFirstCon = first_con }
+ -> mkRecFieldOccFS (getOccFS first_con) (ifLclNameFS fs)
+ _ -> mkVarOccFS (ifLclNameFS fs)
+
+ binding_key (IfaceNonRec b _) = IfaceNonRec (getOcc b) ()
+ binding_key (IfaceRec bs) = IfaceRec (map (\(b, _) -> (getOcc b, ())) bs)
+
+ sorted_extra_decls :: Maybe IfaceSimplifiedCore
+ sorted_extra_decls = mi_simplified_core iface0 <&> \simpl_core ->
+ IfaceSimplifiedCore (sortOn binding_key (mi_sc_extra_decls simpl_core)) (mi_sc_foreign simpl_core)
+
+ -- The interface hash depends on:
+ -- - the ABI hash, plus
+ -- - the things which can affect whether a module is recompiled
+ -- - the module level annotations,
+ -- - deps (home and external packages, dependent files)
+ iface_hash <- computeFingerprint putNameLiterally
+ (mi_abi_mod_hash abiHashes,
+ mi_self_recomp_info iface0,
+ mi_deps iface0)
+
+ let final_iface = completePartialModIface iface0 iface_hash
+ sorted_decls sorted_extra_decls abiHashes caches
+ --
+ return final_iface
+
+
+
+-- The ABI hash should depend on everything in IfacePublic
+-- This is however computed in a very convoluted way, so be careful your
+-- addition ends up in the right place. In essence all this function does is
+-- compute a hash of the arguments.
+--
+-- Why the convoluted way? Hashing individual declarations allows us to do fine-grained
+-- recompilation checking for home package modules, which record precisely what they use
+-- from each module.
+addAbiHashes :: HscEnv -> IfaceModInfo -> PartialIfacePublic -> Dependencies -> IO (IfaceAbiHashes, IfaceCache, [(Fingerprint, IfaceDecl)])
+addAbiHashes hsc_env info iface_public deps = do
+ eps <- hscEPS hsc_env
+ let
+ -- If you have arrived here by accident then congratulations,
+ -- you have discovered the ABI hash. Your reward is to update the ABI hash to
+ -- account for your change to the interface file. Omitting your field using a
+ -- wildcard may lead to some unfortunate consequences.
+
+ -- MP: TODO: Existing bug where defaults, trust_pkg and complete are not taken into account
+ -- when computing the ABI hash.
+ IfacePublic exports fixities warns anns decls _defaults insts fam_insts rules trust _trust_pkg _complete _cache () = iface_public
+ -- And these fields of deps should be in IfacePublic, but in good time.
+ Dependencies _ _ _ sig_mods trusted_pkgs boot_mods orph_mods fis_mods = deps
+ decl_warn_fn = mkIfaceDeclWarnCache (fromIfaceWarnings warns)
+ export_warn_fn = mkIfaceExportWarnCache (fromIfaceWarnings $ warns)
+ fix_fn = mkIfaceFixCache fixities
+
+ this_mod = mi_mod_info_module info
+ semantic_mod = mi_mod_info_semantic_module info
+ (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph insts
+ (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph rules
+ (non_orph_fis, orph_fis) = mkOrphMap ifFamInstOrph fam_insts
+ ann_fn = mkIfaceAnnCache anns
-- The ABI of a declaration represents everything that is made
-- visible about the declaration that a client can depend on.
-- see IfaceDeclABI below.
- declABI :: IfaceDecl -> IfaceDeclABI
+ declABI :: IfaceDecl -> IfaceDeclABI
-- TODO: I'm not sure if this should be semantic_mod or this_mod.
-- See also Note [Identity versus semantic module]
- declABI decl = (this_mod, decl, extras)
+ declABI decl = (this_mod, decl, extras)
where extras = declExtras fix_fn ann_fn non_orph_rules non_orph_insts
non_orph_fis top_lvl_name_env decl
-- This is used for looking up the Name of a default method
-- from its OccName. See Note [default method Name]
- top_lvl_name_env =
+ top_lvl_name_env =
mkOccEnv [ (nameOccName nm, nm)
| IfaceId { ifName = nm } <- decls ]
@@ -1047,15 +1112,15 @@ addFingerprints hsc_env iface0
-- This is computed by finding the free external names of each
-- declaration, including IfaceDeclExtras (things that a
-- declaration implicitly depends on).
- edges :: [ Node OccName IfaceDeclABI ]
- edges = [ DigraphNode abi (getOccName decl) out
+ edges :: [ Node OccName IfaceDeclABI ]
+ edges = [ DigraphNode abi (getOccName decl) out
| decl <- decls
, let abi = declABI decl
, let out = localOccs $ freeNamesDeclABI abi
]
- name_module n = assertPpr (isExternalName n) (ppr n) (nameModule n)
- localOccs =
+ name_module n = assertPpr (isExternalName n) (ppr n) (nameModule n)
+ localOccs =
map (getParent . getOccName)
-- NB: names always use semantic module, so
-- filtering must be on the semantic module!
@@ -1073,17 +1138,17 @@ addFingerprints hsc_env iface0
-- maps OccNames to their parents in the current module.
-- e.g. a reference to a constructor must be turned into a reference
-- to the TyCon for the purposes of calculating dependencies.
- parent_map :: OccEnv OccName
- parent_map = foldl' extend emptyOccEnv decls
+ parent_map :: OccEnv OccName
+ parent_map = foldl' extend emptyOccEnv decls
where extend env d =
extendOccEnvList env [ (b,n) | b <- ifaceDeclImplicitBndrs d ]
where n = getOccName d
-- Strongly-connected groups of declarations, in dependency order
- groups :: [SCC IfaceDeclABI]
- groups = stronglyConnCompFromEdgedVerticesOrd edges
+ groups :: [SCC IfaceDeclABI]
+ groups = stronglyConnCompFromEdgedVerticesOrd edges
- global_hash_fn = mkHashFun hsc_env eps
+ global_hash_fn = mkHashFun hsc_env eps
-- How to output Names when generating the data to fingerprint.
-- Here we want to output the fingerprint for each top-level
@@ -1091,9 +1156,9 @@ addFingerprints hsc_env iface0
-- module. In this way, the fingerprint for a declaration will
-- change if the fingerprint for anything it refers to (transitively)
-- changes.
- mk_put_name :: OccEnv (OccName,Fingerprint)
+ mk_put_name :: OccEnv (OccName,Fingerprint)
-> WriteBinHandle -> Name -> IO ()
- mk_put_name local_env bh name
+ mk_put_name local_env bh name
| isWiredInName name = putNameLiterally bh name
-- wired-in names don't have fingerprints
| otherwise
@@ -1120,21 +1185,21 @@ addFingerprints hsc_env iface0
-- take a strongly-connected group of declarations and compute
-- its fingerprint.
- fingerprint_group :: (OccEnv (OccName,Fingerprint),
+ fingerprint_group :: (OccEnv (OccName,Fingerprint),
[(Fingerprint,IfaceDecl)])
-> SCC IfaceDeclABI
-> IO (OccEnv (OccName,Fingerprint),
[(Fingerprint,IfaceDecl)])
- fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi)
- = do let hash_fn = mk_put_name local_env
- decl = abiDecl abi
+ fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi)
+ = do let hash_fn = mk_put_name local_env
+ decl = abiDecl abi
--pprTrace "fingerprinting" (ppr (ifName decl) ) $ do
- hash <- computeFingerprint hash_fn abi
- env' <- extend_hash_env local_env (hash,decl)
- return (env', (hash,decl) : decls_w_hashes)
+ hash <- computeFingerprint hash_fn abi
+ env' <- extend_hash_env local_env (hash,decl)
+ return (env', (hash,decl) : decls_w_hashes)
- fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis)
+ fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis)
= do let stable_abis = sortBy cmp_abiNames abis
stable_decls = map abiDecl stable_abis
local_env1 <- foldM extend_hash_env local_env
@@ -1150,33 +1215,27 @@ addFingerprints hsc_env iface0
return (local_env2, pairs ++ decls_w_hashes)
-- Make a fingerprint from the ordinal position of a binding in its group.
- mkRecFingerprint :: Word64 -> Fingerprint
- mkRecFingerprint i = Fingerprint 0 i
+ mkRecFingerprint :: Word64 -> Fingerprint
+ mkRecFingerprint i = Fingerprint 0 i
- bumpFingerprint :: Fingerprint -> Word64 -> Fingerprint
- bumpFingerprint fp n = fingerprintFingerprints [ fp, mkRecFingerprint n ]
+ bumpFingerprint :: Fingerprint -> Word64 -> Fingerprint
+ bumpFingerprint fp n = fingerprintFingerprints [ fp, mkRecFingerprint n ]
-- we have fingerprinted the whole declaration, but we now need
-- to assign fingerprints to all the OccNames that it binds, to
-- use when referencing those OccNames in later declarations.
--
- extend_hash_env :: OccEnv (OccName,Fingerprint)
+ extend_hash_env :: OccEnv (OccName,Fingerprint)
-> (Fingerprint,IfaceDecl)
-> IO (OccEnv (OccName,Fingerprint))
- extend_hash_env env0 (hash,d) =
+ extend_hash_env env0 (hash,d) =
return (foldr (\(b,fp) env -> extendOccEnv env b (b,fp)) env0
(ifaceDeclFingerprints hash d))
--
- (local_env, decls_w_hashes) <-
+ (local_env, decls_w_hashes) <-
foldM fingerprint_group (emptyOccEnv, []) groups
- -- when calculating fingerprints, we always need to use canonical ordering
- -- for lists of things. The mi_deps has various lists of modules and
- -- suchlike, which are stored in canonical order:
- let sorted_deps :: Dependencies
- sorted_deps = mi_deps iface0
-
-- The export hash of a module depends on the orphan hashes of the
-- orphan modules below us in the dependency tree. This is the way
-- that changes in orphans get propagated all the way up the
@@ -1202,10 +1261,11 @@ addFingerprints hsc_env iface0
-- External. It's true that Home1 will get rebuilt if the orphans
-- of External, but we also need to make sure Home2 gets rebuilt
-- as well. See #12733 for more details.
- let orph_mods
- = filter (/= this_mod) -- Note [Do not update EPS with your own hi-boot]
- $ dep_orphs sorted_deps
- dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods
+ let orph_mods_no_self
+ = filter (/= this_mod) -- Note [Do not update EPS with your own hi-boot]
+ $ orph_mods
+ dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods_no_self
+
-- Note [Do not update EPS with your own hi-boot]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1216,26 +1276,26 @@ addFingerprints hsc_env iface0
-- instances yourself, no need to consult hs-boot; if you do load the
-- interface into EPS, you will see a duplicate orphan instance.
- orphan_hash <- computeFingerprint (mk_put_name local_env)
+ orphan_hash <- computeFingerprint (mk_put_name local_env)
(map ifDFun orph_insts, orph_rules, orph_fis)
- -- Hash of the transitive things in dependencies
- dep_hash <- computeFingerprint putNameLiterally
- (dep_sig_mods (mi_deps iface0),
- dep_boot_mods (mi_deps iface0),
- -- Trusted packages are like orphans
- dep_trusted_pkgs (mi_deps iface0),
+ -- Hash of the transitive things in dependencies
+ dep_hash <- computeFingerprint putNameLiterally
+ (sig_mods,
+ boot_mods,
+ -- Trusted packages are like orphans
+ trusted_pkgs,
-- See Note [Export hash depends on non-orphan family instances]
- dep_finsts (mi_deps iface0) )
+ fis_mods )
- -- the export list hash doesn't depend on the fingerprints of
- -- the Names it mentions, only the Names themselves, hence putNameLiterally.
- export_hash <- computeFingerprint putNameLiterally
- (mi_exports iface0,
+ -- the export list hash doesn't depend on the fingerprints of
+ -- the Names it mentions, only the Names themselves, hence putNameLiterally.
+ export_hash <- computeFingerprint putNameLiterally
+ (exports,
orphan_hash,
dep_hash,
dep_orphan_hashes,
- mi_trust iface0)
+ trust)
-- Make sure change of Safe Haskell mode causes recomp.
-- Note [Export hash depends on non-orphan family instances]
@@ -1266,79 +1326,44 @@ addFingerprints hsc_env iface0
-- (also we didn't store it anywhere!)
--
- -- put the declarations in a canonical order, sorted by OccName
- let sorted_decls :: [(Fingerprint, IfaceDecl)]
- sorted_decls = Map.elems $ Map.fromList $
- [(getOccName d, e) | e@(_, d) <- decls_w_hashes]
- -- This key is safe because mi_extra_decls contains tidied things.
- getOcc (IfGblTopBndr b) = getOccName b
- getOcc (IfLclTopBndr fs _ _ details) =
- case details of
- IfRecSelId { ifRecSelFirstCon = first_con }
- -> mkRecFieldOccFS (getOccFS first_con) (ifLclNameFS fs)
- _ -> mkVarOccFS (ifLclNameFS fs)
-
- binding_key (IfaceNonRec b _) = IfaceNonRec (getOcc b) ()
- binding_key (IfaceRec bs) = IfaceRec (map (\(b, _) -> (getOcc b, ())) bs)
-
- sorted_extra_decls :: Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
- sorted_extra_decls = sortOn binding_key <$> mi_extra_decls iface0
-
- -- the ABI hash depends on:
- -- - decls
- -- - export list
- -- - orphans
- -- - deprecations
- -- - flag abi hash
- -- - foreign stubs and files
- mod_hash <- computeFingerprint putNameLiterally
- (map fst sorted_decls,
+ -- the ABI hash depends on:
+ -- - decls
+ -- - export list
+ -- - orphans
+ -- - deprecations
+ -- - flag abi hash
+ mod_hash <- computeFingerprint putNameLiterally
+ (sort (map fst decls_w_hashes),
export_hash, -- includes orphan_hash
- mi_warns iface0,
- mi_foreign iface0)
-
-
- -- The interface hash depends on:
- -- - the ABI hash, plus
- -- - the things which can affect whether a module is recompiled
- -- - the module level annotations,
- -- - deps (home and external packages, dependent files)
- iface_hash <- computeFingerprint putNameLiterally
- (mod_hash,
- ann_fn (mkVarOccFS (fsLit "module")), -- See mkIfaceAnnCache
- mi_self_recomp_info iface0,
- sorted_deps )
+ ann_fn AnnModule,
+ warns)
- let
- final_iface_exts = ModIfaceBackend
- { mi_mod_hash = mod_hash
- , mi_iface_hash = iface_hash
- , mi_orphan = not ( all ifRuleAuto orph_rules
+ -- Surely the ABI depends on "module" annotations?
+ -- Also named defaults
+
+
+
+ let
+ final_iface_exts = IfaceAbiHashes
+ { mi_abi_mod_hash = mod_hash
+ , mi_abi_orphan = not ( all ifRuleAuto orph_rules
-- See Note [Orphans and auto-generated rules]
&& null orph_insts
&& null orph_fis)
- , mi_finsts = not (null (mi_fam_insts iface0))
- , mi_exp_hash = export_hash
- , mi_orphan_hash = orphan_hash
- , mi_decl_warn_fn = decl_warn_fn
- , mi_export_warn_fn = export_warn_fn
- , mi_fix_fn = fix_fn
- , mi_hash_fn = lookupOccEnv local_env
+ , mi_abi_finsts = not (null fam_insts)
+ , mi_abi_exp_hash = export_hash
+ , mi_abi_orphan_hash = orphan_hash
}
- final_iface = completePartialModIface iface0
- sorted_decls sorted_extra_decls final_iface_exts
- --
- return final_iface
+ caches = IfaceCache
+ { mi_cache_decl_warn_fn = decl_warn_fn
+ , mi_cache_export_warn_fn = export_warn_fn
+ , mi_cache_fix_fn = fix_fn
+ , mi_cache_hash_fn = lookupOccEnv local_env
+ }
+ return (final_iface_exts, caches, decls_w_hashes)
where
- this_mod = mi_module iface0
- semantic_mod = mi_semantic_module iface0
- (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
@@ -1378,7 +1403,7 @@ getOrphanHashes hsc_env mods = do
get_orph_hash mod = do
iface <- initIfaceLoad hsc_env . withIfaceErr ctx
$ loadInterface (text "getOrphanHashes") mod ImportBySystem
- return (mi_orphan_hash (mi_final_exts iface))
+ return (mi_orphan_hash iface)
mapM get_orph_hash mods
@@ -1531,7 +1556,7 @@ instance Binary IfaceIdExtras where
put_ bh (IdExtras fix rules anns)= do { put_ bh fix; put_ bh rules; put_ bh anns }
declExtras :: (OccName -> Maybe Fixity)
- -> (OccName -> [AnnPayload])
+ -> (AnnCacheKey -> [AnnPayload])
-> OccEnv [IfaceRule]
-> OccEnv [IfaceClsInst]
-> OccEnv [IfaceFamInst]
@@ -1546,10 +1571,10 @@ declExtras fix_fn ann_fn rule_env inst_env fi_env dm_env decl
IfaceDataExtras (fix_fn n)
(map ifFamInstAxiom (lookupOccEnvL fi_env n) ++
map ifDFun (lookupOccEnvL inst_env n))
- (ann_fn n)
+ (ann_fn (AnnOccName n))
(map (id_extras . occName . ifConName) (visibleIfConDecls cons))
IfaceClass{ifBody = IfConcreteClass { ifSigs=sigs, ifATs=ats }} ->
- IfaceClassExtras (fix_fn n) insts (ann_fn n) meths defms
+ IfaceClassExtras (fix_fn n) insts (ann_fn (AnnOccName n)) meths defms
where
insts = (map ifDFun $ (concatMap at_extras ats)
++ lookupOccEnvL inst_env n)
@@ -1562,17 +1587,16 @@ declExtras fix_fn ann_fn rule_env inst_env fi_env dm_env decl
, let dmOcc = mkDefaultMethodOcc (nameOccName bndr)
, Just dmName <- [lookupOccEnv dm_env dmOcc] ]
IfaceSynonym{} -> IfaceSynonymExtras (fix_fn n)
- (ann_fn n)
+ (ann_fn (AnnOccName n))
IfaceFamily{} -> IfaceFamilyExtras (fix_fn n)
(map ifFamInstAxiom (lookupOccEnvL fi_env n))
- (ann_fn n)
+ (ann_fn (AnnOccName n))
_other -> IfaceOtherDeclExtras
where
n = getOccName decl
- id_extras occ = IdExtras (fix_fn occ) (lookupOccEnvL rule_env occ) (ann_fn occ)
+ id_extras occ = IdExtras (fix_fn occ) (lookupOccEnvL rule_env occ) (ann_fn (AnnOccName occ))
at_extras (IfaceAT decl _) = lookupOccEnvL inst_env (getOccName decl)
-
{- Note [default method Name] (see also #15970)
~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1685,20 +1709,25 @@ mkHashFun hsc_env eps name
-- just one of the many horrible hacks in the backpack
-- implementation.
$ loadInterface (text "lookupVers2") mod ImportBySystem
- return $ snd (mi_hash_fn (mi_final_exts iface) occ `orElse`
+ return $ snd (mi_hash_fn iface occ `orElse`
pprPanic "lookupVers1" (ppr mod <+> ppr occ))
+data AnnCacheKey = AnnModule | AnnOccName OccName
+
-- | Creates cached lookup for the 'mi_anns' field of ModIface
-- Hackily, we use "module" as the OccName for any module-level annotations
-mkIfaceAnnCache :: [IfaceAnnotation] -> OccName -> [AnnPayload]
+mkIfaceAnnCache :: [IfaceAnnotation] -> AnnCacheKey -> [AnnPayload]
mkIfaceAnnCache anns
- = \n -> lookupOccEnv env n `orElse` []
+ = \n -> case n of
+ AnnModule -> module_anns
+ AnnOccName occn -> lookupOccEnv env occn `orElse` []
where
- pair (IfaceAnnotation target value) =
- (case target of
- NamedTarget occn -> occn
- ModuleTarget _ -> mkVarOccFS (fsLit "module")
- , [value])
+ (module_anns, occ_anns) = partitionEithers $ map classify anns
+ classify (IfaceAnnotation target value) =
+ case target of
+ NamedTarget occn -> Right (occn, [value])
+ ModuleTarget _ -> Left value
+
-- flipping (++), so the first argument is always short
- env = mkOccEnv_C (flip (++)) (map pair anns)
+ env = mkOccEnv_C (flip (++)) occ_anns
=====================================
compiler/GHC/Iface/Recomp/Types.hs
=====================================
@@ -1,5 +1,5 @@
module GHC.Iface.Recomp.Types (
- ModIfaceSelfRecomp(..),
+ IfaceSelfRecomp(..),
IfaceDynFlags(..),
pprIfaceDynFlags,
missingExtraFlagInfo,
@@ -9,7 +9,9 @@ import GHC.Prelude
import GHC.Fingerprint
import GHC.Utils.Outputable
import GHC.Iface.Flags
+import GHC.Types.SafeHaskell
import GHC.Unit.Module.Deps
+import GHC.Unit.Module
import GHC.Utils.Binary
@@ -59,8 +61,8 @@ proper way.
-- itself.
--
-- See Note [Self recompilation information in interface files]
-data ModIfaceSelfRecomp =
- ModIfaceSelfRecomp { mi_sr_src_hash :: !Fingerprint
+data IfaceSelfRecomp =
+ IfaceSelfRecomp { 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
@@ -69,7 +71,7 @@ data ModIfaceSelfRecomp =
-- NOT STRICT! we read this field lazily from the interface file
-- It is *only* consulted by the recompilation checker
- , mi_sr_flag_hash :: !(Fingerprint, Maybe IfaceDynFlags)
+ , mi_sr_flag_hash :: !(FingerprintWithValue IfaceDynFlags)
-- ^ Hash of the important flags used when compiling the module, excluding
-- optimisation flags
, mi_sr_opt_hash :: !Fingerprint
@@ -81,8 +83,8 @@ data ModIfaceSelfRecomp =
}
-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
+instance Binary IfaceSelfRecomp where
+ put_ bh (IfaceSelfRecomp{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
@@ -97,19 +99,58 @@ instance Binary ModIfaceSelfRecomp where
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 }
+ return $ IfaceSelfRecomp { 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})
+instance Outputable IfaceSelfRecomp where
+ ppr (IfaceSelfRecomp{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 "flags:" <+> pprIfaceDynFlags mi_sr_flag_hash
+ , text "flags:" <+> pprFingerprintWithValue missingExtraFlagInfo (fmap pprIfaceDynFlags 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
+ , text "usages:" <+> ppr (map pprUsage mi_sr_usages)
])]
-instance NFData ModIfaceSelfRecomp where
- rnf (ModIfaceSelfRecomp src_hash usages flag_hash opt_hash hpc_hash plugin_hash)
- = rnf src_hash `seq` rnf usages `seq` rnf flag_hash `seq` rnf opt_hash `seq` rnf hpc_hash `seq` rnf plugin_hash `seq` ()
\ No newline at end of file
+instance NFData IfaceSelfRecomp where
+ rnf (IfaceSelfRecomp src_hash usages flag_hash opt_hash hpc_hash plugin_hash)
+ = rnf src_hash `seq` rnf usages `seq` rnf flag_hash `seq` rnf opt_hash `seq` rnf hpc_hash `seq` rnf plugin_hash `seq` ()
+
+pprFingerprintWithValue :: SDoc -> FingerprintWithValue SDoc -> SDoc
+pprFingerprintWithValue missingInfo (FingerprintWithValue fp mflags)
+ = vcat $
+ [ text "fingerprint:" <+> (ppr fp)
+ ]
+ ++ case mflags of
+ Nothing -> [missingInfo]
+ Just doc -> [doc]
+
+pprUsage :: Usage -> SDoc
+pprUsage UsagePackageModule{ usg_mod = mod, usg_mod_hash = hash, usg_safe = safe }
+ = pprUsageImport mod hash safe
+pprUsage UsageHomeModule{ usg_unit_id = unit_id, usg_mod_name = mod_name
+ , usg_mod_hash = hash, usg_safe = safe
+ , usg_exports = exports, usg_entities = entities }
+ = pprUsageImport (mkModule unit_id mod_name) hash safe $$
+ nest 2 (
+ maybe empty (\v -> text "exports: " <> ppr v) exports $$
+ vcat [ ppr n <+> ppr v | (n,v) <- entities ]
+ )
+pprUsage usage at UsageFile{}
+ = hsep [text "addDependentFile",
+ doubleQuotes (ftext (usg_file_path usage)),
+ ppr (usg_file_hash usage)]
+pprUsage usage at UsageMergedRequirement{}
+ = hsep [text "merged", ppr (usg_mod usage), ppr (usg_mod_hash usage)]
+pprUsage usage at UsageHomeModuleInterface{}
+ = hsep [text "implementation", ppr (usg_mod_name usage)
+ , ppr (usg_unit_id usage)
+ , ppr (usg_iface_hash usage)]
+
+pprUsageImport :: Outputable mod => mod -> Fingerprint -> IsSafeImport -> SDoc
+pprUsageImport mod hash safe
+ = hsep [ text "import", pp_safe, ppr mod
+ , ppr hash ]
+ where
+ pp_safe | safe = text "safe"
+ | otherwise = text " -/ "
\ No newline at end of file
=====================================
compiler/GHC/Rename/Fixity.hs
=====================================
@@ -183,7 +183,7 @@ lookupFixityRn_help name
-- loadInterfaceForName will find B.hi even if B is a hidden module,
-- and that's what we want.
= do { iface <- loadInterfaceForName doc name
- ; let mb_fix = mi_fix_fn (mi_final_exts iface) occ
+ ; let mb_fix = mi_fix_fn iface occ
; let msg = case mb_fix of
Nothing ->
text "looking up name" <+> ppr name
=====================================
compiler/GHC/Rename/Names.hs
=====================================
@@ -485,8 +485,8 @@ calculateAvails :: HomeUnit
calculateAvails home_unit other_home_units iface mod_safe' want_boot imported_by =
let imp_mod = mi_module iface
imp_sem_mod= mi_semantic_module iface
- orph_iface = mi_orphan (mi_final_exts iface)
- has_finsts = mi_finsts (mi_final_exts iface)
+ orph_iface = mi_orphan iface
+ has_finsts = mi_finsts iface
deps = mi_deps iface
trust = getSafeMode $ mi_trust iface
trust_pkg = mi_trust_pkg iface
@@ -1397,7 +1397,7 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
_ -> failLookupWith err
mk_depr_export_warning gre
- = DeprecatedExport name <$> mi_export_warn_fn (mi_final_exts iface) name
+ = DeprecatedExport name <$> mi_export_warn_fn iface name
where
name = greName gre
=====================================
compiler/GHC/Rename/Utils.hs
=====================================
@@ -539,9 +539,9 @@ warnIfDeclDeprecated gre@(GRE { gre_imp = iss })
lookupImpDeclDeprec :: ModIface -> GlobalRdrElt -> Maybe (WarningTxt GhcRn)
lookupImpDeclDeprec iface gre
-- Bleat if the thing, or its parent, is warn'd
- = mi_decl_warn_fn (mi_final_exts iface) (greOccName gre) `mplus`
+ = mi_decl_warn_fn iface (greOccName gre) `mplus`
case greParent gre of
- ParentIs p -> mi_decl_warn_fn (mi_final_exts iface) (nameOccName p)
+ ParentIs p -> mi_decl_warn_fn iface (nameOccName p)
NoParent -> Nothing
warnIfExportDeprecated :: GlobalRdrElt -> RnM ()
@@ -562,7 +562,7 @@ warnIfExportDeprecated gre@(GRE { gre_imp = iss })
process_import_spec is = do
let mod = is_mod $ is_decl is
iface <- loadInterfaceForModule doc mod
- let mb_warn_txt = mi_export_warn_fn (mi_final_exts iface) name
+ let mb_warn_txt = mi_export_warn_fn iface name
return $ (moduleName mod, ) <$> mb_warn_txt
-------------------------
=====================================
compiler/GHC/Tc/Instance/Family.hs
=====================================
@@ -308,7 +308,7 @@ checkFamInstConsistency directlyImpMods
ifc <- modIface mod
deps <- dep_finsts . mi_deps <$> modIface mod
pure $
- if mi_finsts (mi_final_exts ifc)
+ if mi_finsts ifc
then mod:deps
else deps
=====================================
compiler/GHC/Tc/Utils/Backpack.hs
=====================================
@@ -97,7 +97,7 @@ checkHsigDeclM sig_iface sig_thing real_thing = do
-- implementation cases.
checkBootDeclM Hsig sig_thing real_thing
real_fixity <- lookupFixityRn name
- let sig_fixity = case mi_fix_fn (mi_final_exts sig_iface) (occName name) of
+ let sig_fixity = case mi_fix_fn sig_iface (occName name) of
Nothing -> defaultFixity
Just f -> f
when (real_fixity /= sig_fixity) $
@@ -850,7 +850,7 @@ mergeSignatures
if outer_mod == mi_module iface
-- Don't add ourselves!
then tcg_merged tcg_env
- else (mi_module iface, mi_mod_hash (mi_final_exts iface)) : tcg_merged tcg_env
+ else (mi_module iface, mi_mod_hash iface) : tcg_merged tcg_env
}
-- Note [Signature merging DFuns]
=====================================
compiler/GHC/Unit/Module/Deps.hs
=====================================
@@ -1,18 +1,20 @@
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ExplicitNamespaces #-}
-- | Dependencies and Usage of a module
module GHC.Unit.Module.Deps
- ( Dependencies
- , mkDependencies
- , noDependencies
- , dep_direct_mods
- , dep_direct_pkgs
- , dep_sig_mods
- , dep_trusted_pkgs
- , dep_orphs
- , dep_plugin_pkgs
- , dep_finsts
- , dep_boot_mods
+ ( Dependencies(dep_direct_mods
+ , dep_direct_pkgs
+ , dep_sig_mods
+ , dep_trusted_pkgs
+ , dep_orphs
+ , dep_plugin_pkgs
+ , dep_finsts
+ , dep_boot_mods
+ , Dependencies)
, dep_orphs_update
, dep_finsts_update
+ , mkDependencies
+ , noDependencies
, pprDeps
, Usage (..)
, ImportAvails (..)
@@ -52,38 +54,38 @@ import Control.DeepSeq
--
-- See Note [Transitive Information in Dependencies]
data Dependencies = Deps
- { dep_direct_mods :: Set (UnitId, ModuleNameWithIsBoot)
+ { dep_direct_mods_ :: Set (UnitId, ModuleNameWithIsBoot)
-- ^ All home-package modules which are directly imported by this one.
-- This may include modules from other units when using multiple home units
- , dep_direct_pkgs :: Set UnitId
+ , dep_direct_pkgs_ :: Set UnitId
-- ^ All packages directly imported by this module
-- I.e. packages to which this module's direct imports belong.
-- Does not include other home units when using multiple home units.
-- Modules from these units will go in `dep_direct_mods`
- , dep_plugin_pkgs :: Set UnitId
+ , dep_plugin_pkgs_ :: Set UnitId
-- ^ All units needed for plugins
------------------------------------
-- Transitive information below here
- , dep_sig_mods :: ![ModuleName]
+ , dep_sig_mods_ :: ![ModuleName]
-- ^ Transitive closure of hsig files in the home package
- , dep_trusted_pkgs :: Set UnitId
+ , dep_trusted_pkgs_ :: Set UnitId
-- Packages which we are required to trust
-- when the module is imported as a safe import
-- (Safe Haskell). See Note [Tracking Trust Transitively] in GHC.Rename.Names
- , dep_boot_mods :: Set (UnitId, ModuleNameWithIsBoot)
+ , dep_boot_mods_ :: Set (UnitId, ModuleNameWithIsBoot)
-- ^ All modules which have boot files below this one, and whether we
-- should use the boot file or not.
-- This information is only used to populate the eps_is_boot field.
-- See Note [Structure of dep_boot_mods]
- , dep_orphs :: [Module]
+ , dep_orphs_ :: [Module]
-- ^ Transitive closure of orphan modules (whether
-- home or external pkg).
--
@@ -93,7 +95,7 @@ data Dependencies = Deps
-- which relies on dep_orphs having the complete list!)
-- This does NOT include us, unlike 'imp_orphs'.
- , dep_finsts :: [Module]
+ , dep_finsts_ :: [Module]
-- ^ Transitive closure of depended upon modules which
-- contain family instances (whether home or external).
-- This is used by 'checkFamInstConsistency'. This
@@ -105,6 +107,26 @@ data Dependencies = Deps
-- Equality used only for old/new comparison in GHC.Iface.Recomp.addFingerprints
-- See 'GHC.Tc.Utils.ImportAvails' for details on dependencies.
+pattern Dependencies :: Set (UnitId, ModuleNameWithIsBoot)
+ -> Set UnitId
+ -> Set UnitId
+ -> [ModuleName]
+ -> Set UnitId
+ -> Set (UnitId, ModuleNameWithIsBoot)
+ -> [Module]
+ -> [Module]
+ -> Dependencies
+pattern Dependencies {dep_direct_mods, dep_direct_pkgs, dep_plugin_pkgs, dep_sig_mods, dep_trusted_pkgs, dep_boot_mods, dep_orphs, dep_finsts}
+ <- Deps {dep_direct_mods_ = dep_direct_mods
+ , dep_direct_pkgs_ = dep_direct_pkgs
+ , dep_plugin_pkgs_ = dep_plugin_pkgs
+ , dep_sig_mods_ = dep_sig_mods
+ , dep_trusted_pkgs_ = dep_trusted_pkgs
+ , dep_boot_mods_ = dep_boot_mods
+ , dep_orphs_ = dep_orphs
+ , dep_finsts_ = dep_finsts}
+{-# COMPLETE Dependencies #-}
+
instance NFData Dependencies where
rnf (Deps dmods dpkgs ppkgs hsigms tps bmods orphs finsts)
= rnf dmods
@@ -158,14 +180,14 @@ mkDependencies home_unit mod imports plugin_mods =
sig_mods = filter (/= (moduleName mod)) $ imp_sig_mods imports
- in Deps { dep_direct_mods = direct_mods
- , dep_direct_pkgs = direct_pkgs
- , dep_plugin_pkgs = plugin_units
- , dep_sig_mods = sort sig_mods
- , dep_trusted_pkgs = trust_pkgs
- , dep_boot_mods = source_mods
- , dep_orphs = sortBy stableModuleCmp dep_orphs
- , dep_finsts = sortBy stableModuleCmp (imp_finsts imports)
+ in Deps { dep_direct_mods_ = direct_mods
+ , dep_direct_pkgs_ = direct_pkgs
+ , dep_plugin_pkgs_ = plugin_units
+ , dep_sig_mods_ = sort sig_mods
+ , dep_trusted_pkgs_ = trust_pkgs
+ , dep_boot_mods_ = source_mods
+ , dep_orphs_ = sortBy stableModuleCmp dep_orphs
+ , dep_finsts_ = sortBy stableModuleCmp (imp_finsts imports)
-- sort to get into canonical order
-- NB. remember to use lexicographic ordering
}
@@ -174,14 +196,13 @@ mkDependencies home_unit mod imports plugin_mods =
dep_orphs_update :: Monad m => Dependencies -> ([Module] -> m [Module]) -> m Dependencies
dep_orphs_update deps f = do
r <- f (dep_orphs deps)
- pure (deps { dep_orphs = sortBy stableModuleCmp r })
+ pure (deps { dep_orphs_ = sortBy stableModuleCmp r })
-- | Update module dependencies containing family instances (used by Backpack)
dep_finsts_update :: Monad m => Dependencies -> ([Module] -> m [Module]) -> m Dependencies
dep_finsts_update deps f = do
r <- f (dep_finsts deps)
- pure (deps { dep_finsts = sortBy stableModuleCmp r })
-
+ pure (deps { dep_finsts_ = sortBy stableModuleCmp r })
instance Binary Dependencies where
put_ bh deps = do put_ bh (dep_direct_mods deps)
@@ -201,36 +222,36 @@ instance Binary Dependencies where
sms <- get bh
os <- get bh
fis <- get bh
- return (Deps { dep_direct_mods = dms
- , dep_direct_pkgs = dps
- , dep_plugin_pkgs = plugin_pkgs
- , dep_sig_mods = hsigms
- , dep_boot_mods = sms
- , dep_trusted_pkgs = tps
- , dep_orphs = os,
- dep_finsts = fis })
+ return (Deps { dep_direct_mods_ = dms
+ , dep_direct_pkgs_ = dps
+ , dep_plugin_pkgs_ = plugin_pkgs
+ , dep_sig_mods_ = hsigms
+ , dep_boot_mods_ = sms
+ , dep_trusted_pkgs_ = tps
+ , dep_orphs_ = os,
+ dep_finsts_ = fis })
noDependencies :: Dependencies
noDependencies = Deps
- { dep_direct_mods = Set.empty
- , dep_direct_pkgs = Set.empty
- , dep_plugin_pkgs = Set.empty
- , dep_sig_mods = []
- , dep_boot_mods = Set.empty
- , dep_trusted_pkgs = Set.empty
- , dep_orphs = []
- , dep_finsts = []
+ { dep_direct_mods_ = Set.empty
+ , dep_direct_pkgs_ = Set.empty
+ , dep_plugin_pkgs_ = Set.empty
+ , dep_sig_mods_ = []
+ , dep_boot_mods_ = Set.empty
+ , dep_trusted_pkgs_ = Set.empty
+ , dep_orphs_ = []
+ , dep_finsts_ = []
}
-- | Pretty-print unit dependencies
pprDeps :: UnitState -> Dependencies -> SDoc
-pprDeps unit_state (Deps { dep_direct_mods = dmods
- , dep_boot_mods = bmods
- , dep_plugin_pkgs = plgns
- , dep_orphs = orphs
- , dep_direct_pkgs = pkgs
- , dep_trusted_pkgs = tps
- , dep_finsts = finsts
+pprDeps unit_state (Deps { dep_direct_mods_ = dmods
+ , dep_boot_mods_ = bmods
+ , dep_plugin_pkgs_ = plgns
+ , dep_orphs_ = orphs
+ , dep_direct_pkgs_ = pkgs
+ , dep_trusted_pkgs_ = tps
+ , dep_finsts_ = finsts
})
= pprWithUnitState unit_state $
vcat [text "direct module dependencies:" <+> ppr_set ppr_mod dmods,
=====================================
compiler/GHC/Unit/Module/ModIface.hs
=====================================
@@ -11,18 +11,20 @@
module GHC.Unit.Module.ModIface
( ModIface
, ModIface_
- ( mi_module
+ ( mi_mod_info
+ , mi_module
, mi_sig_of
, mi_hsc_src
+ , mi_iface_hash
, mi_deps
+ , mi_public
, mi_exports
, mi_fixities
, mi_warns
, mi_anns
, mi_decls
, mi_defaults
- , mi_extra_decls
- , mi_foreign
+ , mi_simplified_core
, mi_top_env
, mi_insts
, mi_fam_insts
@@ -31,12 +33,17 @@ module GHC.Unit.Module.ModIface
, mi_trust_pkg
, mi_complete_matches
, mi_docs
- , mi_final_exts
+ , mi_abi_hashes
, mi_ext_fields
, mi_hi_bytes
, mi_self_recomp_info
+ , mi_fix_fn
+ , mi_decl_warn_fn
+ , mi_export_warn_fn
+ , mi_hash_fn
)
, pattern ModIface
+ , set_mi_mod_info
, set_mi_module
, set_mi_sig_of
, set_mi_hsc_src
@@ -52,24 +59,34 @@ module GHC.Unit.Module.ModIface
, set_mi_rules
, set_mi_decls
, set_mi_defaults
- , set_mi_extra_decls
- , set_mi_foreign
+ , set_mi_simplified_core
, set_mi_top_env
, set_mi_trust
, set_mi_trust_pkg
, set_mi_complete_matches
, set_mi_docs
- , set_mi_final_exts
+ , set_mi_abi_hashes
, set_mi_ext_fields
+ , set_mi_caches
+ , set_mi_decl_warn_fn
+ , set_mi_export_warn_fn
+ , set_mi_fix_fn
+ , set_mi_hash_fn
, completePartialModIface
, IfaceBinHandle(..)
, PartialModIface
- , ModIfaceBackend (..)
- , ModIfaceSelfRecomp (..)
+ , IfaceAbiHashes (..)
+ , IfaceSelfRecomp (..)
+ , IfaceCache (..)
+ , IfaceSimplifiedCore (..)
, withSelfRecomp
, IfaceDeclExts
- , IfaceBackendExts
+ , IfaceAbiHashesExts
, IfaceExport
+ , IfacePublic_(..)
+ , IfacePublic
+ , PartialIfacePublic
+ , IfaceModInfo(..)
, WhetherHasOrphans
, WhetherHasFamInst
, IfaceTopEnv (..)
@@ -77,6 +94,7 @@ module GHC.Unit.Module.ModIface
, mi_boot
, mi_fix
, mi_semantic_module
+ , mi_mod_info_semantic_module
, mi_free_holes
, mi_mnwib
, mi_flag_hash
@@ -85,6 +103,11 @@ module GHC.Unit.Module.ModIface
, mi_plugin_hash
, mi_src_hash
, mi_usages
+ , mi_mod_hash
+ , mi_orphan
+ , mi_finsts
+ , mi_exp_hash
+ , mi_orphan_hash
, renameFreeHoles
, emptyPartialModIface
, emptyFullModIface
@@ -106,7 +129,7 @@ import GHC.Iface.Recomp.Types
import GHC.Unit
import GHC.Unit.Module.Deps
import GHC.Unit.Module.Warnings
-import GHC.Unit.Module.WholeCoreBindings (IfaceForeign (..), emptyIfaceForeign)
+import GHC.Unit.Module.WholeCoreBindings (IfaceForeign (..))
import GHC.Types.Avail
@@ -147,36 +170,36 @@ We can build a full interface file two ways:
type PartialModIface = ModIface_ 'ModIfaceCore
type ModIface = ModIface_ 'ModIfaceFinal
--- | Extends a PartialModIface with information which is either:
--- * Computed after codegen
--- * Or computed just before writing the iface to disk. (Hashes)
--- In order to fully instantiate it.
-data ModIfaceBackend = ModIfaceBackend
- { mi_mod_hash :: !Fingerprint
+type PartialIfacePublic = IfacePublic_ 'ModIfaceCore
+type IfacePublic = IfacePublic_ 'ModIfaceFinal
+
+-- | Extends a PartialModIface with hashes of the ABI.
+--
+-- * The mi_mod_hash is the hash of the entire ABI
+-- * THe other fields are more specific hashes of parts of the ABI
+data IfaceAbiHashes = IfaceAbiHashes
+ { mi_abi_mod_hash :: !Fingerprint
-- ^ Hash of the ABI only
- , mi_iface_hash :: !Fingerprint
- -- ^ Hash of the whole interface
- , mi_orphan :: !WhetherHasOrphans
+ , mi_abi_orphan :: !WhetherHasOrphans
-- ^ Whether this module has orphans
- , mi_finsts :: !WhetherHasFamInst
+ , mi_abi_finsts :: !WhetherHasFamInst
-- ^ Whether this module has family instances. See Note [The type family
-- instance consistency story].
- , mi_exp_hash :: !Fingerprint
+ , mi_abi_exp_hash :: !Fingerprint
-- ^ Hash of export list
- , mi_orphan_hash :: !Fingerprint
+ , mi_abi_orphan_hash :: !Fingerprint
-- ^ Hash for orphan rules, class and family instances combined
+ -- NOT transitive
+ }
- -- Cached environments for easy lookup. These are computed (lazily) from
- -- other fields and are not put into the interface file.
- -- Not really produced by the backend but there is no need to create them
- -- any earlier.
- , mi_decl_warn_fn :: !(OccName -> Maybe (WarningTxt GhcRn))
+data IfaceCache = IfaceCache
+ { mi_cache_decl_warn_fn :: !(OccName -> Maybe (WarningTxt GhcRn))
-- ^ Cached lookup for 'mi_warns' for declaration deprecations
- , mi_export_warn_fn :: !(Name -> Maybe (WarningTxt GhcRn))
+ , mi_cache_export_warn_fn :: !(Name -> Maybe (WarningTxt GhcRn))
-- ^ Cached lookup for 'mi_warns' for export deprecations
- , mi_fix_fn :: !(OccName -> Maybe Fixity)
+ , mi_cache_fix_fn :: !(OccName -> Maybe Fixity)
-- ^ Cached lookup for 'mi_fixities'
- , mi_hash_fn :: !(OccName -> Maybe (OccName, Fingerprint))
+ , mi_cache_hash_fn :: !(OccName -> Maybe (OccName, Fingerprint))
-- ^ Cached lookup for 'mi_decls'. The @Nothing@ in 'mi_hash_fn' means that
-- the thing isn't in decls. It's useful to know that when seeing if we are
-- up to date wrt. the old interface. The 'OccName' is the parent of the
@@ -195,9 +218,9 @@ type family IfaceDeclExts (phase :: ModIfacePhase) = decl | decl -> phase where
IfaceDeclExts 'ModIfaceCore = IfaceDecl
IfaceDeclExts 'ModIfaceFinal = (Fingerprint, IfaceDecl)
-type family IfaceBackendExts (phase :: ModIfacePhase) = bk | bk -> phase where
- IfaceBackendExts 'ModIfaceCore = ()
- IfaceBackendExts 'ModIfaceFinal = ModIfaceBackend
+type family IfaceAbiHashesExts (phase :: ModIfacePhase) = bk | bk -> phase where
+ IfaceAbiHashesExts 'ModIfaceCore = ()
+ IfaceAbiHashesExts 'ModIfaceFinal = IfaceAbiHashes
-- | In-memory byte array representation of a 'ModIface'.
--
@@ -212,7 +235,7 @@ data IfaceBinHandle (phase :: ModIfacePhase) where
FullIfaceBinHandle :: !(Strict.Maybe FullBinData) -> IfaceBinHandle 'ModIfaceFinal
-withSelfRecomp :: ModIface_ phase -> r -> (ModIfaceSelfRecomp -> r) -> r
+withSelfRecomp :: ModIface_ phase -> r -> (IfaceSelfRecomp -> r) -> r
withSelfRecomp iface nk jk =
case mi_self_recomp_info iface of
Nothing -> nk
@@ -220,34 +243,80 @@ withSelfRecomp iface nk jk =
--- | 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
--- linking and can be completely recovered from just the 'ModIface'.
+-- | A 'ModIface' summarises everything we know
+-- about a compiled module.
--
--- When we read an interface file, we also construct a 'ModIface' from it,
--- except that we explicitly make the 'mi_decls' and a few other fields empty;
--- as when reading we consolidate the declarations etc. into a number of indexed
--- maps and environments in the 'ExternalPackageState'.
+-- See Note [Structure of ModIface] for information about what belongs in each field.
--
--- See Note [Strictness in ModIface] to learn about why some fields are
--- strict and others are not.
+-- See Note [Strictness in ModIface] to learn about why all the fields are lazy.
--
-- See Note [Private fields in ModIface] to learn why we don't export any of the
-- fields.
data ModIface_ (phase :: ModIfacePhase)
= PrivateModIface {
- mi_module_ :: !Module, -- ^ Name of the module we are for
- mi_sig_of_ :: !(Maybe Module), -- ^ Are we a sig of another mod?
+ 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_iface_hash_ :: Fingerprint, -- A hash of the whole interface
- mi_hsc_src_ :: !HscSource, -- ^ Boot? Signature?
+ mi_mod_info_ :: IfaceModInfo,
+ -- ^ Meta information about the module the interface file is for
mi_deps_ :: Dependencies,
-- ^ The dependencies of the module. This is
-- consulted for directly-imported modules, but not
-- for anything else (hence lazy)
+ -- MP: Needs to be refactored (#25844)
+
+ mi_public_ :: IfacePublic_ phase,
+ -- ^ The parts of interface which are used by other modules when
+ -- importing this module. The main, original part of an interface.
- mi_exports_ :: ![IfaceExport],
+
+ mi_self_recomp_ :: Maybe IfaceSelfRecomp,
+ -- ^ Information needed for checking self-recompilation.
+ -- See Note [Self recompilation information in interface files]
+
+ mi_simplified_core_ :: Maybe IfaceSimplifiedCore,
+ -- ^ The part of the interface written when `-fwrite-if-simplified-core` is enabled.
+ -- These parts are used to restart bytecode generation.
+
+ mi_docs_ :: Maybe Docs,
+ -- ^ Docstrings and related data for use by haddock, the ghci
+ -- @:doc@ command, and other tools.
+ --
+ -- @Just _@ @<=>@ the module was built with @-haddock at .
+
+ mi_top_env_ :: IfaceTopEnv,
+ -- ^ Just enough information to reconstruct the top level environment in
+ -- the /original source/ code for this module. which
+ -- is NOT the same as mi_exports, nor mi_decls (which
+ -- may contains declarations for things not actually
+ -- defined by the user). Used for GHCi and for inspecting
+ -- the contents of modules via the GHC API only.
+
+ mi_ext_fields_ :: ExtensibleFields
+ -- ^ Additional optional fields, where the Map key represents
+ -- the field name, resulting in a (size, serialized data) pair.
+ -- Because the data is intended to be serialized through the
+ -- internal `Binary` class (increasing compatibility with types
+ -- using `Name` and `FastString`, such as HIE), this format is
+ -- chosen over `ByteString`s.
+ }
+
+-- | Meta information about the module the interface file is for
+data IfaceModInfo = IfaceModInfo {
+ mi_mod_info_module :: Module, -- ^ Name of the module we are for
+ mi_mod_info_sig_of :: Maybe Module, -- ^ Are we a sig of another mod?
+ mi_mod_info_hsc_src :: HscSource -- ^ Boot? Signature?
+}
+
+-- | The public interface of a module which are used by other modules when importing this module.
+-- The ABI of a module.
+data IfacePublic_ phase = IfacePublic {
+ mi_exports_ :: [IfaceExport],
-- ^ Exports
-- Kept sorted by (mod,occ), to make version comparisons easier
-- Records the modules that are the declaration points for things
@@ -273,25 +342,10 @@ data ModIface_ (phase :: ModIfacePhase)
-- Ditto data constructors, class operations, except that
-- the hash of the parent class/tycon changes
- mi_extra_decls_ :: Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo],
- -- ^ Extra variable definitions which are **NOT** exposed but when
- -- combined with mi_decls allows us to restart code generation.
- -- See Note [Interface Files with Core Definitions] and Note [Interface File with Core: Sharing RHSs]
-
- mi_foreign_ :: !IfaceForeign,
- -- ^ Foreign stubs and files to supplement 'mi_extra_decls_'.
- -- See Note [Foreign stubs and TH bytecode linking]
mi_defaults_ :: [IfaceDefault],
-- ^ default declarations exported by the module
- mi_top_env_ :: IfaceTopEnv,
- -- ^ Just enough information to reconstruct the top level environment in
- -- the /original source/ code for this module. which
- -- is NOT the same as mi_exports, nor mi_decls (which
- -- may contains declarations for things not actually
- -- defined by the user). Used for GHCi and for inspecting
- -- the contents of modules via the GHC API only.
-- Instance declarations and rules
mi_insts_ :: [IfaceClsInst], -- ^ Sorted class instance
@@ -299,53 +353,81 @@ data ModIface_ (phase :: ModIfacePhase)
mi_rules_ :: [IfaceRule], -- ^ Sorted rules
- mi_trust_ :: !IfaceTrustInfo,
+ mi_trust_ :: IfaceTrustInfo,
-- ^ Safe Haskell Trust information for this module.
- mi_trust_pkg_ :: !Bool,
+ mi_trust_pkg_ :: Bool,
-- ^ Do we require the package this module resides in be trusted
-- to trust this module? This is used for the situation where a
-- module is Safe (so doesn't require the package be trusted
-- itself) but imports some trustworthy modules from its own
-- package (which does require its own package be trusted).
-- See Note [Trust Own Package] in GHC.Rename.Names
- mi_complete_matches_ :: ![IfaceCompleteMatch],
+ mi_complete_matches_ :: [IfaceCompleteMatch],
+ -- ^ {-# COMPLETE #-} declarations
- mi_docs_ :: !(Maybe Docs),
- -- ^ Docstrings and related data for use by haddock, the ghci
- -- @:doc@ command, and other tools.
- --
- -- @Just _@ @<=>@ the module was built with @-haddock at .
+ mi_caches_ :: IfaceCache,
+ -- ^ Cached lookups of some parts of mi_public
- mi_final_exts_ :: !(IfaceBackendExts phase),
- -- ^ Either `()` or `ModIfaceBackend` for
+ mi_abi_hashes_ :: (IfaceAbiHashesExts phase)
+ -- ^ Either `()` or `IfaceAbiHashes` for
-- a fully instantiated interface.
-
- mi_ext_fields_ :: !ExtensibleFields,
- -- ^ Additional optional fields, where the Map key represents
- -- the field name, resulting in a (size, serialized data) pair.
- -- Because the data is intended to be serialized through the
- -- internal `Binary` class (increasing compatibility with types
- -- using `Name` and `FastString`, such as HIE), this format is
- -- chosen over `ByteString`s.
- --
-
- 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]
- }
+ -- These fields are hashes of different parts of the public interface.
+}
+
+mkIfacePublic :: [IfaceExport]
+ -> [IfaceDeclExts 'ModIfaceFinal]
+ -> [(OccName, Fixity)]
+ -> IfaceWarnings
+ -> [IfaceAnnotation]
+ -> [IfaceDefault]
+ -> [IfaceClsInst]
+ -> [IfaceFamInst]
+ -> [IfaceRule]
+ -> IfaceTrustInfo
+ -> Bool
+ -> [IfaceCompleteMatch]
+ -> IfaceAbiHashes
+ -> IfacePublic
+mkIfacePublic exports decls fixities warns anns defaults insts fam_insts rules trust trust_pkg complete_matches abi_hashes = IfacePublic {
+ mi_exports_ = exports,
+ mi_decls_ = decls,
+ mi_fixities_ = fixities,
+ mi_warns_ = warns,
+ mi_anns_ = anns,
+ mi_defaults_ = defaults,
+ mi_insts_ = insts,
+ mi_fam_insts_ = fam_insts,
+ mi_rules_ = rules,
+ mi_trust_ = trust,
+ mi_trust_pkg_ = trust_pkg,
+ mi_complete_matches_ = complete_matches,
+ mi_caches_ = IfaceCache {
+ mi_cache_decl_warn_fn = mkIfaceDeclWarnCache $ fromIfaceWarnings warns,
+ mi_cache_export_warn_fn = mkIfaceExportWarnCache $ fromIfaceWarnings warns,
+ mi_cache_fix_fn = mkIfaceFixCache fixities,
+ mi_cache_hash_fn = mkIfaceHashCache decls
+ },
+ mi_abi_hashes_ = abi_hashes
+}
+
+-- | The information needed to restart bytecode generation.
+-- Enabled by `-fwrite-if-simplified-core`.
+data IfaceSimplifiedCore = IfaceSimplifiedCore {
+ mi_sc_extra_decls :: [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
+ -- ^ Extra variable definitions which are **NOT** exposed but when
+ -- combined with mi_decls allows us to restart code generation.
+ -- See Note [Interface Files with Core Definitions] and Note [Interface File with Core: Sharing RHSs]
+ , mi_sc_foreign :: IfaceForeign
+ -- ^ Foreign stubs and files to supplement 'mi_extra_decls_'.
+ -- See Note [Foreign stubs and TH bytecode linking]
+}
-- Enough information to reconstruct the top level environment for a module
data IfaceTopEnv
= IfaceTopEnv
- { ifaceTopExports :: !DetOrdAvails -- ^ all top level things in this module, including unexported stuff
- , ifaceImports :: ![IfaceImport] -- ^ all the imports in this module
+ { ifaceTopExports :: DetOrdAvails -- ^ all top level things in this module, including unexported stuff
+ , ifaceImports :: [IfaceImport] -- ^ all the imports in this module
}
instance NFData IfaceTopEnv where
@@ -362,6 +444,35 @@ instance Binary IfaceTopEnv where
{-
+Note [Structure of ModIface]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The ModIface structure is divided into several logical parts:
+
+1. mi_mod_info: Basic module metadata (name, version, etc.)
+
+2. mi_public: The public interface of the module, which includes:
+ - Exports, declarations, fixities, warnings, annotations
+ - Class and type family instances
+ - Rewrite rules and COMPLETE pragmas
+ - Safe Haskell and package trust information
+ - ABI hashes for recompilation checking
+
+4. mi_self_recomp: Information needed for self-recompilation checking
+ (see Note [Self recompilation information in interface files])
+
+5. mi_simplified_core: Optional simplified Core for bytecode generation
+ (only present when -fwrite-if-simplified-core is enabled)
+
+6. mi_docs: Optional documentation (only present when -haddock is enabled)
+
+7. mi_top_env: Information about the top-level environment of the original source
+
+8. mi_ext_fields: Additional fields for extensibility
+
+This structure helps organize the interface data according to its purpose and usage
+patterns. Different parts of the compiler use different fields. By separating them
+logically in the interface we can arrange to only deserialize the fields that are needed.
+
Note [Strictness in ModIface]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -371,7 +482,7 @@ The ModIface is the Haskell representation of an interface (.hi) file.
that we have just compiled
* For packages that we depend on we load the ModIface from disk.
-Some fields in the ModIface are deliberately lazy because when we read
+All fields in the ModIface are deliberately lazy because when we read
an interface file we don't always need all the parts. For example, an
interface file contains information about documentation which is often
not needed during compilation. This is achieved using the lazyPut/lazyGet pair.
@@ -384,23 +495,43 @@ That's why in GHC.Driver.Main.hscMaybeWriteIface there is the call to
forceModIface.
-}
-mi_flag_hash :: ModIface_ phase -> Maybe (Fingerprint, Maybe IfaceDynFlags)
-mi_flag_hash = fmap mi_sr_flag_hash . mi_self_recomp_info_
+mi_flag_hash :: ModIface_ phase -> Maybe (FingerprintWithValue IfaceDynFlags)
+mi_flag_hash = fmap mi_sr_flag_hash . mi_self_recomp_
mi_opt_hash :: ModIface_ phase -> Maybe Fingerprint
-mi_opt_hash = fmap mi_sr_opt_hash . mi_self_recomp_info_
+mi_opt_hash = fmap mi_sr_opt_hash . mi_self_recomp_
mi_hpc_hash :: ModIface_ phase -> Maybe Fingerprint
-mi_hpc_hash = fmap mi_sr_hpc_hash . mi_self_recomp_info_
+mi_hpc_hash = fmap mi_sr_hpc_hash . mi_self_recomp_
mi_src_hash :: ModIface_ phase -> Maybe Fingerprint
-mi_src_hash = fmap mi_sr_src_hash . mi_self_recomp_info_
+mi_src_hash = fmap mi_sr_src_hash . mi_self_recomp_
mi_usages :: ModIface_ phase -> Maybe [Usage]
-mi_usages = fmap mi_sr_usages . mi_self_recomp_info_
+mi_usages = fmap mi_sr_usages . mi_self_recomp_
mi_plugin_hash :: ModIface_ phase -> Maybe Fingerprint
-mi_plugin_hash = fmap mi_sr_plugin_hash . mi_self_recomp_info_
+mi_plugin_hash = fmap mi_sr_plugin_hash . mi_self_recomp_
+
+-- | Accessor for the module hash of the ABI from a ModIface.
+mi_mod_hash :: ModIface -> Fingerprint
+mi_mod_hash iface = mi_abi_mod_hash (mi_abi_hashes iface)
+
+-- | Accessor for whether this module has orphans from a ModIface.
+mi_orphan :: ModIface -> WhetherHasOrphans
+mi_orphan iface = mi_abi_orphan (mi_abi_hashes iface)
+
+-- | Accessor for whether this module has family instances from a ModIface.
+mi_finsts :: ModIface -> WhetherHasFamInst
+mi_finsts iface = mi_abi_finsts (mi_abi_hashes iface)
+
+-- | Accessor for the hash of the export list from a ModIface.
+mi_exp_hash :: ModIface -> Fingerprint
+mi_exp_hash iface = mi_abi_exp_hash (mi_abi_hashes iface)
+
+-- | Accessor for the hash of orphan rules, class and family instances combined from a ModIface.
+mi_orphan_hash :: ModIface -> Fingerprint
+mi_orphan_hash iface = mi_abi_orphan_hash (mi_abi_hashes iface)
-- | Old-style accessor for whether or not the ModIface came from an hs-boot
-- file.
@@ -415,16 +546,19 @@ mi_mnwib iface = GWIB (moduleName $ mi_module iface) (mi_boot iface)
-- | Lookups up a (possibly cached) fixity from a 'ModIface'. If one cannot be
-- found, 'defaultFixity' is returned instead.
mi_fix :: ModIface -> OccName -> Fixity
-mi_fix iface name = mi_fix_fn (mi_final_exts iface) name `orElse` defaultFixity
+mi_fix iface name = mi_fix_fn iface name `orElse` defaultFixity
-- | The semantic module for this interface; e.g., if it's a interface
-- for a signature, if 'mi_module' is @p[A=<A>]:A@, 'mi_semantic_module'
-- will be @<A>@.
-mi_semantic_module :: ModIface_ a -> Module
-mi_semantic_module iface = case mi_sig_of iface of
- Nothing -> mi_module iface
+mi_mod_info_semantic_module :: IfaceModInfo -> Module
+mi_mod_info_semantic_module iface = case mi_mod_info_sig_of iface of
+ Nothing -> mi_mod_info_module iface
Just mod -> mod
+mi_semantic_module :: ModIface_ a -> Module
+mi_semantic_module iface = mi_mod_info_semantic_module (mi_mod_info iface)
+
-- | The "precise" free holes, e.g., the signatures that this
-- 'ModIface' depends on.
mi_free_holes :: ModIface -> UniqDSet ModuleName
@@ -455,191 +589,229 @@ renameFreeHoles fhs insts =
-- See Note [Strictness in ModIface] about where we use lazyPut vs put
instance Binary ModIface where
- put_ bh (PrivateModIface {
- mi_module_ = mod,
- mi_sig_of_ = sig_of,
- mi_hsc_src_ = hsc_src,
- mi_hi_bytes_ = _hi_bytes, -- We don't serialise the 'mi_hi_bytes_', as it itself
+ put_ bh (PrivateModIface
+ { 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
-- we likely have a good reason, and do not want to reuse
-- the byte array.
-- See Note [Private fields in ModIface]
+ mi_mod_info_ = mod_info,
+ mi_iface_hash_ = iface_hash,
mi_deps_ = deps,
- mi_exports_ = exports,
- mi_fixities_ = fixities,
- mi_warns_ = warns,
- mi_anns_ = anns,
- mi_decls_ = decls,
- mi_extra_decls_ = extra_decls,
- mi_foreign_ = foreign_,
- mi_defaults_ = defaults,
- mi_insts_ = insts,
- mi_fam_insts_ = fam_insts,
- mi_rules_ = rules,
- mi_trust_ = trust,
- mi_trust_pkg_ = trust_pkg,
- mi_complete_matches_ = complete_matches,
+ mi_public_ = public,
mi_top_env_ = top_env,
mi_docs_ = docs,
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_mod_hash = mod_hash,
- mi_iface_hash = iface_hash,
- mi_orphan = orphan,
- mi_finsts = hasFamInsts,
- mi_exp_hash = exp_hash,
- mi_orphan_hash = orphan_hash
- }}) = do
- put_ bh mod
- put_ bh sig_of
- put_ bh hsc_src
- put_ bh self_recomp
- put_ bh mod_hash
+ mi_self_recomp_ = self_recomp,
+ mi_simplified_core_ = simplified_core
+ }) = do
+ put_ bh mod_info
put_ bh iface_hash
- put_ bh orphan
- put_ bh hasFamInsts
lazyPut bh deps
- put_ bh exports
- put_ bh exp_hash
- put_ bh fixities
- lazyPut bh warns
- lazyPut bh anns
- put_ bh decls
- put_ bh extra_decls
- put_ bh defaults
- put_ bh foreign_
- put_ bh insts
- put_ bh fam_insts
- lazyPut bh rules
- put_ bh orphan_hash
- put_ bh trust
- put_ bh trust_pkg
- put_ bh complete_matches
+ lazyPut bh public
lazyPut bh top_env
lazyPutMaybe bh docs
+ lazyPutMaybe bh self_recomp
+ lazyPutMaybe bh simplified_core
get bh = do
- mod <- get bh
- sig_of <- get bh
- hsc_src <- get bh
- self_recomp_info <- get bh
- mod_hash <- get bh
+ mod_info <- get bh
iface_hash <- get bh
- orphan <- get bh
- hasFamInsts <- get bh
deps <- lazyGet bh
- exports <- {-# SCC "bin_exports" #-} get bh
- exp_hash <- get bh
- fixities <- {-# SCC "bin_fixities" #-} get bh
- warns <- {-# SCC "bin_warns" #-} lazyGet bh
- anns <- {-# SCC "bin_anns" #-} lazyGet bh
- decls <- {-# SCC "bin_tycldecls" #-} get bh
- extra_decls <- get bh
- defaults <- get bh
- foreign_ <- get bh
- insts <- {-# SCC "bin_insts" #-} get bh
- fam_insts <- {-# SCC "bin_fam_insts" #-} get bh
- rules <- {-# SCC "bin_rules" #-} lazyGet bh
- orphan_hash <- get bh
- trust <- get bh
- trust_pkg <- get bh
- complete_matches <- get bh
+ public <- lazyGet bh
top_env <- lazyGet bh
docs <- lazyGetMaybe bh
+ self_recomp <- lazyGetMaybe bh
+ simplified_core <- lazyGetMaybe bh
+
return (PrivateModIface {
- mi_module_ = mod,
- mi_sig_of_ = sig_of,
- mi_hsc_src_ = hsc_src,
- 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_mod_info_ = mod_info,
+ mi_iface_hash_ = iface_hash,
mi_deps_ = deps,
- mi_exports_ = exports,
- mi_anns_ = anns,
- mi_fixities_ = fixities,
- mi_warns_ = warns,
- mi_decls_ = decls,
- mi_extra_decls_ = extra_decls,
- mi_foreign_ = foreign_,
- mi_defaults_ = defaults,
- mi_insts_ = insts,
- mi_fam_insts_ = fam_insts,
- mi_rules_ = rules,
- mi_trust_ = trust,
- mi_trust_pkg_ = trust_pkg,
- -- And build the cached values
- mi_complete_matches_ = complete_matches,
+ mi_public_ = public,
+ mi_simplified_core_ = simplified_core,
mi_docs_ = docs,
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_mod_hash = mod_hash,
- mi_iface_hash = iface_hash,
- mi_orphan = orphan,
- mi_finsts = hasFamInsts,
- mi_exp_hash = exp_hash,
- mi_orphan_hash = orphan_hash,
- mi_decl_warn_fn = mkIfaceDeclWarnCache $ fromIfaceWarnings warns,
- mi_export_warn_fn = mkIfaceExportWarnCache $ fromIfaceWarnings warns,
- mi_fix_fn = mkIfaceFixCache fixities,
- mi_hash_fn = mkIfaceHashCache decls
- }})
+ mi_self_recomp_ = self_recomp,
+ -- placeholder because this is dealt
+ -- with specially when the file is read
+ mi_ext_fields_ = emptyExtensibleFields,
+ -- We can't populate this field here, as we are
+ -- missing the 'mi_ext_fields_' field, which is
+ -- handled in 'getIfaceWithExtFields'.
+ mi_hi_bytes_ = FullIfaceBinHandle Strict.Nothing
+ })
+
+instance Binary IfaceModInfo where
+ put_ bh (IfaceModInfo { mi_mod_info_module = mod
+ , mi_mod_info_sig_of = sig_of
+ , mi_mod_info_hsc_src = hsc_src
+ }) = do
+ put_ bh mod
+ put_ bh sig_of
+ put_ bh hsc_src
+ get bh = do
+ mod <- get bh
+ sig_of <- get bh
+ hsc_src <- get bh
+ return (IfaceModInfo { mi_mod_info_module = mod
+ , mi_mod_info_sig_of = sig_of
+ , mi_mod_info_hsc_src = hsc_src
+ })
+
+
+instance Binary (IfacePublic_ 'ModIfaceFinal) where
+ put_ bh (IfacePublic { mi_exports_ = exports
+ , mi_decls_ = decls
+ , mi_fixities_ = fixities
+ , mi_warns_ = warns
+ , mi_anns_ = anns
+ , mi_defaults_ = defaults
+ , mi_insts_ = insts
+ , mi_fam_insts_ = fam_insts
+ , mi_rules_ = rules
+ , mi_trust_ = trust
+ , mi_trust_pkg_ = trust_pkg
+ , mi_complete_matches_ = complete_matches
+ , mi_abi_hashes_ = abi_hashes
+ }) = do
+
+ lazyPut bh exports
+ lazyPut bh decls
+ lazyPut bh fixities
+ lazyPut bh warns
+ lazyPut bh anns
+ lazyPut bh defaults
+ lazyPut bh insts
+ lazyPut bh fam_insts
+ lazyPut bh rules
+ lazyPut bh trust
+ lazyPut bh trust_pkg
+ lazyPut bh complete_matches
+ lazyPut bh abi_hashes
+
+ get bh = do
+ exports <- lazyGet bh
+ decls <- lazyGet bh
+ fixities <- lazyGet bh
+ warns <- lazyGet bh
+ anns <- lazyGet bh
+ defaults <- lazyGet bh
+ insts <- lazyGet bh
+ fam_insts <- lazyGet bh
+ rules <- lazyGet bh
+ trust <- lazyGet bh
+ trust_pkg <- lazyGet bh
+ complete_matches <- lazyGet bh
+ abi_hashes <- lazyGet bh
+ return (mkIfacePublic exports decls fixities warns anns defaults insts fam_insts rules trust trust_pkg complete_matches abi_hashes)
+
+instance Binary IfaceAbiHashes where
+ put_ bh (IfaceAbiHashes { mi_abi_mod_hash = mod_hash
+ , mi_abi_orphan = orphan
+ , mi_abi_finsts = hasFamInsts
+ , mi_abi_exp_hash = exp_hash
+ , mi_abi_orphan_hash = orphan_hash
+ }) = do
+ put_ bh mod_hash
+ put_ bh orphan
+ put_ bh hasFamInsts
+ put_ bh exp_hash
+ put_ bh orphan_hash
+ get bh = do
+ mod_hash <- get bh
+ orphan <- get bh
+ hasFamInsts <- get bh
+ exp_hash <- get bh
+ orphan_hash <- get bh
+ return $ IfaceAbiHashes {
+ mi_abi_mod_hash = mod_hash,
+ mi_abi_orphan = orphan,
+ mi_abi_finsts = hasFamInsts,
+ mi_abi_exp_hash = exp_hash,
+ mi_abi_orphan_hash = orphan_hash
+ }
+
+instance Binary IfaceSimplifiedCore where
+ put_ bh (IfaceSimplifiedCore eds fs) = do
+ put_ bh eds
+ put_ bh fs
+
+ get bh = do
+ eds <- get bh
+ fs <- get bh
+ return (IfaceSimplifiedCore eds fs)
emptyPartialModIface :: Module -> PartialModIface
emptyPartialModIface mod
= PrivateModIface
- { mi_module_ = mod,
- mi_sig_of_ = Nothing,
- mi_hsc_src_ = HsSrcFile,
+ { mi_mod_info_ = emptyIfaceModInfo mod,
+ mi_iface_hash_ = fingerprint0,
mi_hi_bytes_ = PartialIfaceBinHandle,
mi_deps_ = noDependencies,
- mi_exports_ = [],
- mi_fixities_ = [],
- mi_warns_ = IfWarnSome [] [],
- mi_anns_ = [],
- mi_defaults_ = [],
- mi_insts_ = [],
- mi_fam_insts_ = [],
- mi_rules_ = [],
- mi_decls_ = [],
- mi_extra_decls_ = Nothing,
- mi_foreign_ = emptyIfaceForeign,
+ mi_public_ = emptyPublicModIface (),
+ mi_simplified_core_ = Nothing,
mi_top_env_ = IfaceTopEnv emptyDetOrdAvails [] ,
- mi_trust_ = noIfaceTrustInfo,
- mi_trust_pkg_ = False,
- mi_complete_matches_ = [],
mi_docs_ = Nothing,
- mi_final_exts_ = (),
- mi_ext_fields_ = emptyExtensibleFields,
- mi_self_recomp_info_ = Nothing
+ mi_self_recomp_ = Nothing,
+ mi_ext_fields_ = emptyExtensibleFields
+
}
+emptyIfaceModInfo :: Module -> IfaceModInfo
+emptyIfaceModInfo mod = IfaceModInfo
+ { mi_mod_info_module = mod
+ , mi_mod_info_sig_of = Nothing
+ , mi_mod_info_hsc_src = HsSrcFile
+ }
+
+
+emptyPublicModIface :: IfaceAbiHashesExts phase -> IfacePublic_ phase
+emptyPublicModIface abi_hashes = IfacePublic
+ { mi_exports_ = []
+ , mi_decls_ = []
+ , mi_fixities_ = []
+ , mi_warns_ = IfWarnSome [] []
+ , mi_anns_ = []
+ , mi_defaults_ = []
+ , mi_insts_ = []
+ , mi_fam_insts_ = []
+ , mi_rules_ = []
+ , mi_abi_hashes_ = abi_hashes
+ , mi_trust_ = noIfaceTrustInfo
+ , mi_trust_pkg_ = False
+ , mi_caches_ = emptyModIfaceCache
+ , mi_complete_matches_ = []
+ }
+
+emptyModIfaceCache :: IfaceCache
+emptyModIfaceCache = IfaceCache {
+ mi_cache_decl_warn_fn = emptyIfaceWarnCache,
+ mi_cache_export_warn_fn = emptyIfaceWarnCache,
+ mi_cache_fix_fn = emptyIfaceFixCache,
+ mi_cache_hash_fn = emptyIfaceHashCache
+}
+
+emptyIfaceBackend :: IfaceAbiHashes
+emptyIfaceBackend = IfaceAbiHashes
+ { mi_abi_mod_hash = fingerprint0,
+ mi_abi_orphan = False,
+ mi_abi_finsts = False,
+ mi_abi_exp_hash = fingerprint0,
+ mi_abi_orphan_hash = fingerprint0
+ }
+
emptyFullModIface :: Module -> ModIface
emptyFullModIface mod =
(emptyPartialModIface mod)
- { mi_decls_ = []
- , mi_self_recomp_info_ = Nothing
+ { mi_public_ = emptyPublicModIface emptyIfaceBackend
, mi_hi_bytes_ = FullIfaceBinHandle Strict.Nothing
- , mi_final_exts_ = ModIfaceBackend
- { mi_mod_hash = fingerprint0,
- mi_iface_hash = fingerprint0,
- mi_orphan = False,
- mi_finsts = False,
- mi_exp_hash = fingerprint0,
- mi_orphan_hash = fingerprint0,
- mi_decl_warn_fn = emptyIfaceWarnCache,
- mi_export_warn_fn = emptyIfaceWarnCache,
- mi_fix_fn = emptyIfaceFixCache,
- mi_hash_fn = emptyIfaceHashCache } }
+ }
+
-- | Constructs cache for the 'mi_hash_fn' field of a 'ModIface'
mkIfaceHashCache :: [(Fingerprint,IfaceDecl)]
@@ -657,11 +829,11 @@ emptyIfaceHashCache _occ = Nothing
-- ModIface is completely forced since it will live in memory for a long time.
-- If forcing it uses a lot of memory, then store less things in ModIface.
-instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase))
+instance ( NFData (IfaceAbiHashesExts (phase :: ModIfacePhase))
, NFData (IfaceDeclExts (phase :: ModIfacePhase))
) => NFData (ModIface_ phase) where
- rnf (PrivateModIface a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 a24)
- = rnf a1
+ rnf (PrivateModIface a1 a2 a3 a4 a5 a6 a7 a8 a9 a10)
+ = (a1 :: IfaceBinHandle phase)
`seq` rnf a2
`seq` rnf a3
`seq` rnf a4
@@ -671,24 +843,27 @@ instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase))
`seq` rnf a8
`seq` rnf a9
`seq` rnf a10
- `seq` rnf a11
- `seq` rnf a12
- `seq` rnf a13
- `seq` rnf a14
- `seq` rnf a15
- `seq` rnf a16
- `seq` rnf a17
- `seq` rnf a18
- `seq` rnf a19
- `seq` rnf a20
- `seq` rnf a21
- `seq` rnf a22
- -- IfaceBinHandle
- `seq` (a23 :: IfaceBinHandle phase)
- `seq` rnf a24
-
-instance NFData ModIfaceBackend where
- rnf (ModIfaceBackend a1 a2 a3 a4 a5 a6 a7 a8 a9 a10)
+
+instance NFData IfaceModInfo where
+ rnf (IfaceModInfo a1 a2 a3)
+ = rnf a1
+ `seq` rnf a2
+ `seq` rnf a3
+
+
+instance NFData IfaceSimplifiedCore where
+ rnf (IfaceSimplifiedCore eds fs) = rnf eds `seq` rnf fs
+
+instance NFData IfaceAbiHashes where
+ rnf (IfaceAbiHashes a1 a2 a3 a4 a5)
+ = rnf a1
+ `seq` rnf a2
+ `seq` rnf a3
+ `seq` rnf a4
+ `seq` rnf a5
+
+instance (NFData (IfaceAbiHashesExts phase), NFData (IfaceDeclExts phase)) => NFData (IfacePublic_ phase) where
+ rnf (IfacePublic a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14)
= rnf a1
`seq` rnf a2
`seq` rnf a3
@@ -699,6 +874,18 @@ instance NFData ModIfaceBackend where
`seq` rnf a8
`seq` rnf a9
`seq` rnf a10
+ `seq` rnf a11
+ `seq` rnf a12
+ `seq` rnf a13
+ `seq` rnf a14
+
+instance NFData IfaceCache where
+ rnf (IfaceCache a1 a2 a3 a4)
+ = rnf a1
+ `seq` rnf a2
+ `seq` rnf a3
+ `seq` rnf a4
+
forceModIface :: ModIface -> IO ()
@@ -745,28 +932,38 @@ to serialise the 'ModIface' to disk again.
-- | Given a 'PartialModIface', turn it into a 'ModIface' by completing
-- missing fields.
completePartialModIface :: PartialModIface
+ -> Fingerprint
-> [(Fingerprint, IfaceDecl)]
- -> Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
- -> ModIfaceBackend
+ -> Maybe IfaceSimplifiedCore
+ -> IfaceAbiHashes
+ -> IfaceCache
-> ModIface
-completePartialModIface partial decls extra_decls final_exts = partial
- { mi_decls_ = decls
- , mi_extra_decls_ = extra_decls
- , mi_final_exts_ = final_exts
+completePartialModIface partial iface_hash decls extra_decls final_exts cache = partial
+ { mi_public_ = completePublicModIface decls final_exts cache (mi_public_ partial)
+ , mi_simplified_core_ = extra_decls
, mi_hi_bytes_ = FullIfaceBinHandle Strict.Nothing
+ , mi_iface_hash_ = iface_hash
}
+ where
-set_mi_module :: Module -> ModIface_ phase -> ModIface_ phase
-set_mi_module val iface = clear_mi_hi_bytes $ iface { mi_module_ = val }
-
-set_mi_sig_of :: Maybe Module -> ModIface_ phase -> ModIface_ phase
-set_mi_sig_of val iface = clear_mi_hi_bytes $ iface { mi_sig_of_ = val }
+-- | Given a 'PartialIfacePublic', turn it into an 'IfacePublic' by completing
+-- missing fields.
+completePublicModIface :: [(Fingerprint, IfaceDecl)]
+ -> IfaceAbiHashes
+ -> IfaceCache
+ -> PartialIfacePublic
+ -> IfacePublic
+completePublicModIface decls abi_hashes cache partial = partial
+ { mi_decls_ = decls
+ , mi_abi_hashes_ = abi_hashes
+ , mi_caches_ = cache
+ }
-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_mod_info :: IfaceModInfo -> ModIface_ phase -> ModIface_ phase
+set_mi_mod_info val iface = clear_mi_hi_bytes $ iface { mi_mod_info_ = 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_self_recomp :: Maybe IfaceSelfRecomp-> ModIface_ phase -> ModIface_ phase
+set_mi_self_recomp val iface = clear_mi_hi_bytes $ iface { mi_self_recomp_ = val }
set_mi_hi_bytes :: IfaceBinHandle phase -> ModIface_ phase -> ModIface_ phase
set_mi_hi_bytes val iface = iface { mi_hi_bytes_ = val }
@@ -774,59 +971,100 @@ 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_public :: (IfacePublic_ phase -> IfacePublic_ phase) -> ModIface_ phase -> ModIface_ phase
+set_mi_public f iface = clear_mi_hi_bytes $ iface { mi_public_ = f (mi_public_ iface) }
+
+set_mi_simplified_core :: Maybe IfaceSimplifiedCore -> ModIface_ phase -> ModIface_ phase
+set_mi_simplified_core val iface = clear_mi_hi_bytes $ iface { mi_simplified_core_ = val }
+
+set_mi_top_env :: IfaceTopEnv -> ModIface_ phase -> ModIface_ phase
+set_mi_top_env val iface = clear_mi_hi_bytes $ iface { mi_top_env_ = val }
+
+set_mi_docs :: Maybe Docs -> ModIface_ phase -> ModIface_ phase
+set_mi_docs val iface = clear_mi_hi_bytes $ iface { mi_docs_ = val }
+
+set_mi_ext_fields :: ExtensibleFields -> ModIface_ phase -> ModIface_ phase
+set_mi_ext_fields val iface = clear_mi_hi_bytes $ iface { mi_ext_fields_ = val }
+
+{- Settings for mi_public interface fields -}
+
set_mi_exports :: [IfaceExport] -> ModIface_ phase -> ModIface_ phase
-set_mi_exports val iface = clear_mi_hi_bytes $ iface { mi_exports_ = val }
+set_mi_exports val = set_mi_public (\iface -> iface { mi_exports_ = val })
set_mi_fixities :: [(OccName, Fixity)] -> ModIface_ phase -> ModIface_ phase
-set_mi_fixities val iface = clear_mi_hi_bytes $ iface { mi_fixities_ = val }
+set_mi_fixities val = set_mi_public (\iface -> iface { mi_fixities_ = val })
set_mi_warns :: IfaceWarnings -> ModIface_ phase -> ModIface_ phase
-set_mi_warns val iface = clear_mi_hi_bytes $ iface { mi_warns_ = val }
+set_mi_warns val = set_mi_public (\iface -> iface { mi_warns_ = val })
set_mi_anns :: [IfaceAnnotation] -> ModIface_ phase -> ModIface_ phase
-set_mi_anns val iface = clear_mi_hi_bytes $ iface { mi_anns_ = val }
+set_mi_anns val = set_mi_public (\iface -> iface { mi_anns_ = val })
set_mi_insts :: [IfaceClsInst] -> ModIface_ phase -> ModIface_ phase
-set_mi_insts val iface = clear_mi_hi_bytes $ iface { mi_insts_ = val }
+set_mi_insts val = set_mi_public (\iface -> iface { mi_insts_ = val })
set_mi_fam_insts :: [IfaceFamInst] -> ModIface_ phase -> ModIface_ phase
-set_mi_fam_insts val iface = clear_mi_hi_bytes $ iface { mi_fam_insts_ = val }
+set_mi_fam_insts val = set_mi_public (\iface -> iface { mi_fam_insts_ = val })
set_mi_rules :: [IfaceRule] -> ModIface_ phase -> ModIface_ phase
-set_mi_rules val iface = clear_mi_hi_bytes $ iface { mi_rules_ = val }
+set_mi_rules val = set_mi_public (\iface -> iface { mi_rules_ = val })
set_mi_decls :: [IfaceDeclExts phase] -> ModIface_ phase -> ModIface_ phase
-set_mi_decls val iface = clear_mi_hi_bytes $ iface { mi_decls_ = val }
+set_mi_decls val = set_mi_public (\iface -> iface { mi_decls_ = val })
set_mi_defaults :: [IfaceDefault] -> ModIface_ phase -> ModIface_ phase
-set_mi_defaults val iface = clear_mi_hi_bytes $ iface { mi_defaults_ = val }
-
-set_mi_extra_decls :: Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] -> ModIface_ phase -> ModIface_ phase
-set_mi_extra_decls val iface = clear_mi_hi_bytes $ iface { mi_extra_decls_ = val }
-
-set_mi_foreign :: IfaceForeign -> ModIface_ phase -> ModIface_ phase
-set_mi_foreign foreign_ iface = clear_mi_hi_bytes $ iface { mi_foreign_ = foreign_ }
-
-set_mi_top_env :: IfaceTopEnv -> ModIface_ phase -> ModIface_ phase
-set_mi_top_env val iface = clear_mi_hi_bytes $ iface { mi_top_env_ = val }
+set_mi_defaults val = set_mi_public (\iface -> iface { mi_defaults_ = val })
set_mi_trust :: IfaceTrustInfo -> ModIface_ phase -> ModIface_ phase
-set_mi_trust val iface = clear_mi_hi_bytes $ iface { mi_trust_ = val }
+set_mi_trust val = set_mi_public (\iface -> iface { mi_trust_ = val })
set_mi_trust_pkg :: Bool -> ModIface_ phase -> ModIface_ phase
-set_mi_trust_pkg val iface = clear_mi_hi_bytes $ iface { mi_trust_pkg_ = val }
+set_mi_trust_pkg val = set_mi_public (\iface -> iface { mi_trust_pkg_ = val })
set_mi_complete_matches :: [IfaceCompleteMatch] -> ModIface_ phase -> ModIface_ phase
-set_mi_complete_matches val iface = clear_mi_hi_bytes $ iface { mi_complete_matches_ = val }
+set_mi_complete_matches val = set_mi_public (\iface -> iface { mi_complete_matches_ = val })
+
+set_mi_abi_hashes :: IfaceAbiHashesExts phase -> ModIface_ phase -> ModIface_ phase
+set_mi_abi_hashes val = set_mi_public (\iface -> iface { mi_abi_hashes_ = val })
+
+{- Setters for mi_caches interface fields -}
+
+set_mi_decl_warn_fn :: (OccName -> Maybe (WarningTxt GhcRn)) -> ModIface_ phase -> ModIface_ phase
+set_mi_decl_warn_fn val = set_mi_public (\iface -> iface { mi_caches_ = (mi_caches_ iface) { mi_cache_decl_warn_fn = val } })
+
+set_mi_export_warn_fn :: (Name -> Maybe (WarningTxt GhcRn)) -> ModIface_ phase -> ModIface_ phase
+set_mi_export_warn_fn val = set_mi_public (\iface -> iface { mi_caches_ = (mi_caches_ iface) { mi_cache_export_warn_fn = val } })
+
+set_mi_fix_fn :: (OccName -> Maybe Fixity) -> ModIface_ phase -> ModIface_ phase
+set_mi_fix_fn val = set_mi_public (\iface -> iface { mi_caches_ = (mi_caches_ iface) { mi_cache_fix_fn = val } })
+
+set_mi_hash_fn :: (OccName -> Maybe (OccName, Fingerprint)) -> ModIface_ phase -> ModIface_ phase
+set_mi_hash_fn val = set_mi_public (\iface -> iface { mi_caches_ = (mi_caches_ iface) { mi_cache_hash_fn = val } })
+
+set_mi_caches :: IfaceCache -> ModIface_ phase -> ModIface_ phase
+set_mi_caches val = set_mi_public (\iface -> iface { mi_caches_ = val })
+
+{-
+
+-}
+
+{- Setters for mi_mod_info interface fields -}
+
+set_mi_module :: Module -> ModIface_ phase -> ModIface_ phase
+set_mi_module val = set_mi_mod_info_field (\info -> info { mi_mod_info_module = val })
+
+set_mi_sig_of :: Maybe Module -> ModIface_ phase -> ModIface_ phase
+set_mi_sig_of val = set_mi_mod_info_field (\info -> info { mi_mod_info_sig_of = val })
+
+set_mi_hsc_src :: HscSource -> ModIface_ phase -> ModIface_ phase
+set_mi_hsc_src val = set_mi_mod_info_field (\info -> info { mi_mod_info_hsc_src = val })
+
+-- | Helper function for setting fields in mi_mod_info_
+set_mi_mod_info_field :: (IfaceModInfo -> IfaceModInfo) -> ModIface_ phase -> ModIface_ phase
+set_mi_mod_info_field f iface = clear_mi_hi_bytes $ iface { mi_mod_info_ = f (mi_mod_info_ iface) }
-set_mi_docs :: Maybe Docs -> ModIface_ phase -> ModIface_ phase
-set_mi_docs val iface = clear_mi_hi_bytes $ iface { mi_docs_ = val }
-set_mi_final_exts :: IfaceBackendExts phase -> ModIface_ phase -> ModIface_ phase
-set_mi_final_exts val iface = clear_mi_hi_bytes $ iface { mi_final_exts_ = val }
-set_mi_ext_fields :: ExtensibleFields -> ModIface_ phase -> ModIface_ phase
-set_mi_ext_fields val iface = clear_mi_hi_bytes $ iface { mi_ext_fields_ = val }
-- | Invalidate any byte array buffer we might have.
clear_mi_hi_bytes :: ModIface_ phase -> ModIface_ phase
@@ -887,18 +1125,20 @@ However, with the pragma, the correct core is generated:
-- See Note [Inline Pattern synonym of ModIface] for why we have all these
-- inline pragmas.
-{-# INLINE ModIface #-}
+{-# INLINE mi_mod_info #-}
+{-# INLINE mi_iface_hash #-}
{-# INLINE mi_module #-}
{-# INLINE mi_sig_of #-}
{-# INLINE mi_hsc_src #-}
{-# INLINE mi_deps #-}
+{-# INLINE mi_public #-}
{-# INLINE mi_exports #-}
{-# INLINE mi_fixities #-}
{-# INLINE mi_warns #-}
{-# INLINE mi_anns #-}
{-# INLINE mi_decls #-}
-{-# INLINE mi_extra_decls #-}
-{-# INLINE mi_foreign #-}
+{-# INLINE mi_simplified_core #-}
+{-# INLINE mi_defaults #-}
{-# INLINE mi_top_env #-}
{-# INLINE mi_insts #-}
{-# INLINE mi_fam_insts #-}
@@ -907,32 +1147,63 @@ However, with the pragma, the correct core is generated:
{-# INLINE mi_trust_pkg #-}
{-# INLINE mi_complete_matches #-}
{-# INLINE mi_docs #-}
-{-# INLINE mi_final_exts #-}
+{-# INLINE mi_abi_hashes #-}
{-# INLINE mi_ext_fields #-}
{-# INLINE mi_hi_bytes #-}
+{-# INLINE mi_self_recomp_info #-}
+{-# INLINE mi_fix_fn #-}
+{-# INLINE mi_hash_fn #-}
+{-# INLINE mi_decl_warn_fn #-}
+{-# INLINE mi_export_warn_fn #-}
+{-# INLINE ModIface #-}
{-# COMPLETE ModIface #-}
pattern ModIface ::
- Module -> Maybe Module -> HscSource -> Dependencies ->
- [IfaceExport] -> [(OccName, Fixity)] -> IfaceWarnings ->
- [IfaceAnnotation] -> [IfaceDeclExts phase] ->
- Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] -> IfaceForeign ->
- [IfaceDefault] -> IfaceTopEnv -> [IfaceClsInst] -> [IfaceFamInst] -> [IfaceRule] ->
- IfaceTrustInfo -> Bool -> [IfaceCompleteMatch] -> Maybe Docs ->
- IfaceBackendExts phase -> ExtensibleFields -> IfaceBinHandle phase -> Maybe ModIfaceSelfRecomp ->
+ IfaceModInfo
+ -> Module
+ -> Maybe Module
+ -> HscSource
+ -> Fingerprint
+ -> Dependencies
+ -> IfacePublic_ phase
+ -> [IfaceExport]
+ -> [(OccName, Fixity)]
+ -> IfaceWarnings
+ -> [IfaceAnnotation]
+ -> [IfaceDeclExts phase]
+ -> Maybe IfaceSimplifiedCore
+ -> [IfaceDefault]
+ -> IfaceTopEnv
+ -> [IfaceClsInst]
+ -> [IfaceFamInst]
+ -> [IfaceRule]
+ -> IfaceTrustInfo
+ -> Bool
+ -> [IfaceCompleteMatch]
+ -> Maybe Docs
+ -> IfaceAbiHashesExts phase
+ -> ExtensibleFields
+ -> IfaceBinHandle phase
+ -> Maybe IfaceSelfRecomp
+ -> (OccName -> Maybe Fixity)
+ -> (OccName -> Maybe (OccName, Fingerprint))
+ -> (OccName -> Maybe (WarningTxt GhcRn))
+ -> (Name -> Maybe (WarningTxt GhcRn)) ->
ModIface_ phase
pattern ModIface
- { mi_module
+ { mi_mod_info
+ , mi_module
, mi_sig_of
, mi_hsc_src
+ , mi_iface_hash
, mi_deps
+ , mi_public
, mi_exports
, mi_fixities
, mi_warns
, mi_anns
, mi_decls
- , mi_extra_decls
- , mi_foreign
+ , mi_simplified_core
, mi_defaults
, mi_top_env
, mi_insts
@@ -942,33 +1213,45 @@ pattern ModIface
, mi_trust_pkg
, mi_complete_matches
, mi_docs
- , mi_final_exts
+ , mi_abi_hashes
, mi_ext_fields
, mi_hi_bytes
, mi_self_recomp_info
+ , mi_fix_fn
+ , mi_hash_fn
+ , mi_decl_warn_fn
+ , mi_export_warn_fn
} <- PrivateModIface
- { mi_module_ = mi_module
- , mi_sig_of_ = mi_sig_of
- , mi_hsc_src_ = mi_hsc_src
+ { mi_mod_info_ = mi_mod_info at IfaceModInfo { mi_mod_info_module = mi_module
+ , mi_mod_info_sig_of = mi_sig_of
+ , mi_mod_info_hsc_src = mi_hsc_src }
+ , mi_iface_hash_ = mi_iface_hash
, mi_deps_ = mi_deps
- , mi_exports_ = mi_exports
- , mi_fixities_ = mi_fixities
- , mi_warns_ = mi_warns
- , mi_anns_ = mi_anns
- , mi_decls_ = mi_decls
- , mi_extra_decls_ = mi_extra_decls
- , mi_foreign_ = mi_foreign
- , mi_defaults_ = mi_defaults
- , mi_top_env_ = mi_top_env
- , mi_insts_ = mi_insts
- , mi_fam_insts_ = mi_fam_insts
- , mi_rules_ = mi_rules
- , mi_trust_ = mi_trust
- , mi_trust_pkg_ = mi_trust_pkg
- , mi_complete_matches_ = mi_complete_matches
+ , mi_public_ = mi_public at IfacePublic {
+ mi_exports_ = mi_exports
+ , mi_fixities_ = mi_fixities
+ , mi_warns_ = mi_warns
+ , mi_anns_ = mi_anns
+ , mi_decls_ = mi_decls
+ , mi_defaults_ = mi_defaults
+ , mi_insts_ = mi_insts
+ , mi_fam_insts_ = mi_fam_insts
+ , mi_rules_ = mi_rules
+ , mi_trust_ = mi_trust
+ , mi_trust_pkg_ = mi_trust_pkg
+ , mi_complete_matches_ = mi_complete_matches
+ , mi_caches_ = IfaceCache {
+ mi_cache_decl_warn_fn = mi_decl_warn_fn,
+ mi_cache_export_warn_fn = mi_export_warn_fn,
+ mi_cache_fix_fn = mi_fix_fn,
+ mi_cache_hash_fn = mi_hash_fn
+ }
+ , mi_abi_hashes_ = mi_abi_hashes
+ }
, mi_docs_ = mi_docs
- , mi_final_exts_ = mi_final_exts
, mi_ext_fields_ = mi_ext_fields
, mi_hi_bytes_ = mi_hi_bytes
- , mi_self_recomp_info_ = mi_self_recomp_info
+ , mi_self_recomp_ = mi_self_recomp_info
+ , mi_simplified_core_ = mi_simplified_core
+ , mi_top_env_ = mi_top_env
}
=====================================
compiler/GHC/Utils/Binary.hs
=====================================
@@ -107,6 +107,9 @@ module GHC.Utils.Binary
simpleBindingNameReader,
FullBinData(..), freezeBinHandle, thawBinHandle, putFullBinData,
BinArray,
+
+ -- * FingerprintWithValue
+ FingerprintWithValue(..)
) where
import GHC.Prelude
@@ -2088,3 +2091,39 @@ source location as part of a larger structure.
instance (Binary v) => Binary (IntMap v) where
put_ bh m = put_ bh (IntMap.toAscList m)
get bh = IntMap.fromAscList <$> get bh
+
+
+{-
+Note [FingerprintWithValue]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+FingerprintWithValue is a wrapper which allows us to store a fingerprint and
+optionally the value which was used to create the fingerprint.
+
+This is useful for storing information in interface files, where we want to
+store the fingerprint of the interface file, but also the value which was used
+to create the fingerprint (e.g. the DynFlags).
+
+The wrapper is useful to ensure that the fingerprint can be read quickly without
+having to deserialise the value itself.
+
+-}
+
+-- | A wrapper which allows us to store a fingerprint and optionally the value which
+-- was used to create the fingerprint.
+data FingerprintWithValue a = FingerprintWithValue !Fingerprint (Maybe a)
+ deriving Functor
+
+instance Binary a => Binary (FingerprintWithValue a) where
+ put_ bh (FingerprintWithValue fp val) = do
+ put_ bh fp
+ lazyPutMaybe bh val
+
+ get bh = do
+ fp <- get bh
+ val <- lazyGetMaybe bh
+ return $ FingerprintWithValue fp val
+
+instance NFData a => NFData (FingerprintWithValue a) where
+ rnf (FingerprintWithValue fp mflags)
+ = rnf fp `seq` rnf mflags `seq` ()
\ No newline at end of file
=====================================
ghc/Main.hs
=====================================
@@ -1133,6 +1133,8 @@ abiHash strs = do
mods <- mapM find_it strs
+ -- MP: loadUserInterface is inefficient here since we will never find a cached
+ -- interface. computeInterface is probably better.
let get_iface modl = loadUserInterface NotBoot (text "abiHash") modl
ifaces <- initIfaceCheck (text "abiHash") hsc_env $ mapM get_iface mods
@@ -1140,7 +1142,7 @@ abiHash strs = do
put_ bh hiVersion
-- package hashes change when the compiler version changes (for now)
-- see #5328
- mapM_ (put_ bh . mi_mod_hash . mi_final_exts) ifaces
+ mapM_ (put_ bh . mi_mod_hash) ifaces
f <- fingerprintBinMem bh
putStrLn (showPpr dflags f)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9d84972fb5489ea924a4022dbd782e4726733b5a
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9d84972fb5489ea924a4022dbd782e4726733b5a
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/20250314/7d942468/attachment-0001.html>
More information about the ghc-commits
mailing list