Wolfgang Jeltsch pushed to branch wip/jeltsch/smaller-pit at Glasgow Haskell Compiler / GHC Commits: 52b7a873 by Wolfgang Jeltsch at 2026-10-02T00:00:39+03:00 Make Haddock avoid the PIT To this end, Haddock has been using `loadSysInterface` to fetch module interfaces. The `loadSysInterface` operation is very complex, containing many bits that do not seem to be needed by Haddock. In particular, storing interface data in and potentially retrieving it from the PIT seems to be superfluous. This interaction with the PIT limits how much we can statically shrink the amount of information that is stored in the PIT. Therefore, we drop the use of `loadSysInterface` and implement the necessary bits of interface fetching directly in `loadHiFile`, where `loadSysInterface` use to be invoked. - - - - - 5da11526 by Wolfgang Jeltsch at 2026-10-02T00:33:09+03:00 Statically enforce module interface reduction for the PIT `GHC.Iface.Load.loadInterface` used to replace certain fields of each fetched module interface by `panic` applications before storing it in the PIT. With the present change, the absence of those fields in the PIT is guaranteed statically. See #27044 for the bigger picture. - - - - - 22 changed files: - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Main/Interactive.hs - compiler/GHC/Driver/Main/Passes.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Driver/Session/Inspect.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Load.hs-boot - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Family.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Unit/External.hs - compiler/GHC/Unit/Module/ModIface.hs - ghc/Main.hs - utils/haddock/haddock-api/src/Haddock/Interface.hs Changes: ===================================== compiler/GHC/Driver/Downsweep.hs ===================================== @@ -688,7 +688,8 @@ expandFixedModuleNode key loc = do -- part of the compiler. lookupIfaceByModuleHsc hsc_env (mnkToModule key) >>= \case Just iface -> return (M.Succeeded iface) - Nothing -> readIface (hsc_hooks hsc_env) (hsc_logger hsc_env) (hsc_dflags hsc_env) (hsc_NC hsc_env) (mnkToModule key) (ml_hi_file loc) + Nothing -> fmap shrinkModIface <$> + readIface (hsc_hooks hsc_env) (hsc_logger hsc_env) (hsc_dflags hsc_env) (hsc_NC hsc_env) (mnkToModule key) (ml_hi_file loc) case read_result of M.Succeeded iface -> do -- Computer information about this node ===================================== compiler/GHC/Driver/Env.hs ===================================== @@ -372,10 +372,10 @@ lookupIfaceByModule :: HomeUnitGraph -> PackageIfaceTable -> Module - -> IO (Maybe ModIface) + -> IO (Maybe RetainedModIface) lookupIfaceByModule hug pit mod = HUG.lookupHugByModule mod hug >>= pure . \case - Just hm -> Just (hm_iface hm) + Just hm -> Just (shrinkModIface (hm_iface hm)) Nothing -> lookupModuleEnv pit mod -- If the module does come from the home package, why do we look in the PIT as well? -- (a) In OneShot mode, even home-package modules accumulate in the PIT @@ -384,7 +384,7 @@ lookupIfaceByModule hug pit mod -- We could eliminate (b) if we wanted, by making GHC.Prim belong to a package -- of its own, but it doesn't seem worth the bother. -lookupIfaceByModuleHsc :: HscEnv -> Module -> IO (Maybe ModIface) +lookupIfaceByModuleHsc :: HscEnv -> Module -> IO (Maybe RetainedModIface) lookupIfaceByModuleHsc hsc_env mod = do eps <- hscEPS hsc_env lookupIfaceByModule (hsc_HUG hsc_env) (eps_PIT eps) mod ===================================== compiler/GHC/Driver/Main/Interactive.hs ===================================== @@ -148,7 +148,7 @@ hscIsGHCiMonad :: HscEnv -> String -> IO Name hscIsGHCiMonad hsc_env name = runHsc hsc_env $ ioMsgMaybe $ hoistTcRnMessage $ isGHCiMonad hsc_env name -hscGetModuleInterface :: HscEnv -> Module -> IO ModIface +hscGetModuleInterface :: HscEnv -> Module -> IO RetainedModIface hscGetModuleInterface hsc_env0 mod = runInteractiveHsc hsc_env0 $ do hsc_env <- getHscEnv ioMsgMaybe $ hoistTcRnMessage $ getModuleInterface hsc_env mod @@ -270,7 +270,7 @@ hscCheckSafe' m l = do _ | isHomeModule home_unit mod -> True _ -> isUnitTrusted unit_state (moduleUnit m) - lookup' :: Module -> Hsc (Maybe ModIface) + lookup' :: Module -> Hsc (Maybe RetainedModIface) lookup' m = do hsc_env <- getHscEnv iface <- liftIO $ lookupIfaceByModuleHsc hsc_env m ===================================== compiler/GHC/Driver/Main/Passes.hs ===================================== @@ -1335,7 +1335,7 @@ hscCheckSafe' m l = do _ | isHomeModule home_unit mod -> True _ -> isUnitTrusted unit_state (moduleUnit m) - lookup' :: Module -> Hsc (Maybe ModIface) + lookup' :: Module -> Hsc (Maybe RetainedModIface) lookup' m = do hsc_env <- getHscEnv iface <- liftIO $ lookupIfaceByModuleHsc hsc_env m ===================================== compiler/GHC/Driver/Plugins.hs ===================================== @@ -224,7 +224,7 @@ data PluginWithArgs = PluginWithArgs data LoadedPlugin = LoadedPlugin { lpPlugin :: PluginWithArgs -- ^ the actual plugin together with its commandline arguments - , lpModule :: ModIface + , lpModule :: RetainedModIface -- ^ the module containing the plugin } ===================================== compiler/GHC/Driver/Session/Inspect.hs ===================================== @@ -87,7 +87,7 @@ data ModuleInfo = ModuleInfo { minf_type_env :: TypeEnv, minf_exports :: [AvailInfo], minf_instances :: [ClsInst], - minf_iface :: Maybe ModIface, + minf_iface :: Maybe RetainedModIface, minf_safe :: SafeHaskellMode, minf_modBreaks :: Maybe InternalModBreaks } @@ -140,7 +140,7 @@ getHomeModuleInfo hsc_env mdl = Nothing -> return Nothing Just hmi -> do let details = hm_details hmi - iface = hm_iface hmi + iface = shrinkModIface (hm_iface hmi) return (Just (ModuleInfo { minf_type_env = md_types details, minf_exports = md_exports details, @@ -187,7 +187,7 @@ modInfoLookupName minf name = withSession $ \hsc_env -> do Just tyThing -> return (Just tyThing) Nothing -> liftIO (lookupType hsc_env name) -modInfoIface :: ModuleInfo -> Maybe ModIface +modInfoIface :: ModuleInfo -> Maybe RetainedModIface modInfoIface = minf_iface -- | Retrieve module safe haskell mode ===================================== compiler/GHC/HsToCore/Usage.hs ===================================== @@ -276,7 +276,7 @@ mk_mod_usage_info uc home_unit home_unit_ids this_mod direct_imports imp_decls u -- a) we used something from it; has something in used_names -- b) we imported it, even if we used nothing from it -- (need to recompile if its export list changes: export_fprint) - mkUsage :: Module -> ModIface -> Maybe Usage + mkUsage :: Module -> RetainedModIface -> Maybe Usage mkUsage mod iface | toUnitId (moduleUnit mod) `Set.notMember` home_unit_ids = Just $ UsagePackageModule{ usg_mod = mod, @@ -302,9 +302,9 @@ mk_mod_usage_info uc home_unit home_unit_ids this_mod direct_imports imp_decls u usg_entities = Map.toList ent_hashs, usg_safe = imp_safe } where - finsts_mod = mi_finsts iface + finsts_mod = mi_abi_finsts (mi_abi_hashes iface) hash_env = mi_hash_fn iface - mod_hash = mi_mod_hash iface + mod_hash = mi_abi_mod_hash (mi_abi_hashes iface) imported_exports = if not depend_on_exports then Nothing @@ -312,9 +312,9 @@ mk_mod_usage_info uc home_unit home_unit_ids this_mod direct_imports imp_decls u Just $ HomeModImport { hmiu_orphanLikeHash - = mi_orphan_like_hash iface + = mi_abi_orphan_like_hash (mi_abi_hashes iface) , hmiu_importedAvails - = moduleImportedAvails mod (mi_export_avails_hash iface) imp_decls + = moduleImportedAvails mod (mi_abi_export_avails_hash (mi_abi_hashes iface)) imp_decls } by_is_safe (ImportedByUser imv) = imv_is_safe imv ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -308,7 +308,7 @@ loadKnownKeyOccMaps known_key_maps :: Module -> IfM lcl KnownKeyNameMaps known_key_maps mod = do { iface <- loadInterfaceWithException doc mod ImportBySystem - ; let !abi_hash = mi_mod_hash iface + ; let !abi_hash = mi_abi_mod_hash (mi_abi_hashes iface) ; eps <- getEps ; case lookupModuleEnv (eps_known_keys eps) mod of Just (cached_hash, kk_maps) @@ -321,7 +321,7 @@ loadKnownKeyOccMaps (abi_hash, kk_maps) } ; return kk_maps } } - build_maps :: ModIface -> KnownKeyNameMaps + build_maps :: RetainedModIface -> KnownKeyNameMaps build_maps iface = (kk_map, occ_map) where kk_map :: UniqFM KnownKey Name @@ -628,7 +628,7 @@ loadSrcInterface :: SDoc -> ModuleName -> IsBootInterface -- {-# SOURCE #-} ? -> PkgQual -- "package", if any - -> RnM ModIface + -> RnM RetainedModIface loadSrcInterface doc scope mod want_boot maybe_pkg = do { res <- loadSrcInterface_maybe doc scope mod want_boot maybe_pkg @@ -648,7 +648,7 @@ loadSrcInterface_maybe :: SDoc -> ModuleName -> IsBootInterface -- {-# SOURCE #-} ? -> PkgQual -- "package", if any - -> RnM (MaybeErr MissingInterfaceError ModIface) + -> RnM (MaybeErr MissingInterfaceError RetainedModIface) loadSrcInterface_maybe doc scope mod want_boot maybe_pkg -- We must first find which Module this import refers to. This involves @@ -667,7 +667,7 @@ loadSrcInterface_maybe doc scope mod want_boot maybe_pkg -- rare operation, but in particular it is used to load orphan modules -- in order to pull their instances into the global package table and to -- handle some operations in GHCi). -loadModuleInterface :: SDoc -> Module -> TcM ModIface +loadModuleInterface :: SDoc -> Module -> TcM RetainedModIface loadModuleInterface doc mod = initIfaceTcRn (loadSysInterface doc mod) -- | Load interfaces for a collection of modules. @@ -681,7 +681,7 @@ loadModuleInterfaces doc mods -- | Loads the interface for a given Name. -- Should only be called for an imported name; -- otherwise loadSysInterface may not find the interface -loadInterfaceForName :: SDoc -> Name -> TcRn ModIface +loadInterfaceForName :: SDoc -> Name -> TcRn RetainedModIface loadInterfaceForName doc name = do { when debugIsOn $ -- Check pre-condition do { this_mod <- getModule @@ -690,7 +690,7 @@ loadInterfaceForName doc name initIfaceTcRn $ loadSysInterface doc (nameModule name) } -- | Loads the interface for a given Module. -loadInterfaceForModule :: SDoc -> Module -> TcRn ModIface +loadInterfaceForModule :: SDoc -> Module -> TcRn RetainedModIface loadInterfaceForModule doc m = do -- Should not be called with this module @@ -724,23 +724,23 @@ loadWiredInHomeIface name ------------------ -- | Loads a system interface and throws an exception if it fails -loadSysInterface :: SDoc -> Module -> IfM lcl ModIface +loadSysInterface :: SDoc -> Module -> IfM lcl RetainedModIface loadSysInterface doc mod_name = loadInterfaceWithException doc mod_name ImportBySystem ------------------ -- | Loads a user interface and throws an exception if it fails. The first parameter indicates -- whether we should import the boot variant of the module -loadUserInterface :: IsBootInterface -> SDoc -> Module -> IfM lcl ModIface +loadUserInterface :: IsBootInterface -> SDoc -> Module -> IfM lcl RetainedModIface loadUserInterface is_boot doc mod_name = loadInterfaceWithException doc mod_name (ImportByUser is_boot) -loadPluginInterface :: SDoc -> Module -> IfM lcl ModIface +loadPluginInterface :: SDoc -> Module -> IfM lcl RetainedModIface loadPluginInterface doc mod_name = loadInterfaceWithException doc mod_name ImportByPlugin ------------------ -- | A wrapper for 'loadInterface' that throws an exception if it fails -loadInterfaceWithException :: SDoc -> Module -> WhereFrom -> IfM lcl ModIface +loadInterfaceWithException :: SDoc -> Module -> WhereFrom -> IfM lcl RetainedModIface loadInterfaceWithException doc mod_name where_from = do dflags <- getDynFlags @@ -749,7 +749,7 @@ loadInterfaceWithException doc mod_name where_from ------------------ loadInterface :: SDoc -> Module -> WhereFrom - -> IfM lcl (MaybeErr MissingInterfaceError ModIface) + -> IfM lcl (MaybeErr MissingInterfaceError RetainedModIface) -- loadInterface looks in both the HPT and PIT for the required interface -- If not found, it loads it, and puts it in the PIT (always). @@ -796,7 +796,7 @@ loadInterface doc_str mod from liftIO $ computeInterface hsc_env doc_str hi_boot_file mod ; case read_result of { Failed err -> do - { let fake_iface = emptyFullModIface mod + { let fake_iface = shrinkModIface (emptyFullModIface mod) ; updateEps_ $ \eps -> eps { eps_PIT = extendModuleEnv (eps_PIT eps) (mi_module fake_iface) fake_iface } @@ -856,16 +856,7 @@ loadInterface doc_str mod from ; new_eps_complete_matches <- tcIfaceCompleteMatches (mi_complete_matches iface) ; purged_hsc_env <- getTopEnv - ; let final_iface = iface - & set_mi_decls (panic "No mi_decls in PIT") - & set_mi_insts (panic "No mi_insts in PIT") - & set_mi_defaults (panic "No mi_defaults in PIT") - & 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_simplified_core (panic "No mi_simplified_core in PIT") - - bad_boot = mi_boot iface == IsBoot + ; let bad_boot = mi_boot iface == IsBoot && isJust (lookupKnotVars (if_rec_types gbl_env) mod) -- Warn against an EPS-updating import -- of one's own boot file! (one-shot only) @@ -892,7 +883,7 @@ loadInterface doc_str mod from then eps { eps_PTE = addDeclsToPTE (eps_PTE eps) new_eps_decls } else eps { - eps_PIT = extendModuleEnv (eps_PIT eps) mod final_iface, + eps_PIT = extendModuleEnv (eps_PIT eps) mod (shrinkModIface iface), eps_PTE = addDeclsToPTE (eps_PTE eps) new_eps_decls, eps_iface_bytecode = add_bytecode (eps_iface_bytecode eps), eps_rule_base = extendRuleBaseList (eps_rule_base eps) @@ -921,10 +912,8 @@ loadInterface doc_str mod from eps_defaults = extendModuleEnv (eps_defaults eps) mod new_eps_defaults } - ; -- invoke plugins with *full* interface, not final_iface, to ensure - -- that plugins have access to declarations, etc. - res <- withPlugins (hsc_plugins hsc_env) (\p -> interfaceLoadAction p) iface - ; return (Succeeded res) + ; res <- withPlugins (hsc_plugins hsc_env) (\p -> interfaceLoadAction p) iface + ; return (Succeeded (shrinkModIface res)) }}}} {- Note [Loading your own hi-boot file] ===================================== compiler/GHC/Iface/Load.hs-boot ===================================== @@ -2,7 +2,7 @@ module GHC.Iface.Load where import GHC.Unit.Module (Module) import GHC.Tc.Utils.Monad (IfM) -import GHC.Unit.Module.ModIface (ModIface) +import GHC.Unit.Module.ModIface (RetainedModIface) import GHC.Utils.Outputable (SDoc) -loadSysInterface :: SDoc -> Module -> IfM lcl ModIface +loadSysInterface :: SDoc -> Module -> IfM lcl RetainedModIface ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -707,7 +707,7 @@ checkDependencies hsc_env summary iface return $ needsRecompileBecause $ ModulePackageChanged new_name -needInterface :: Module -> (ModIface -> IO RecompileRequired) +needInterface :: Module -> (RetainedModIface -> IO RecompileRequired) -> IfG RecompileRequired needInterface mod continue = do @@ -727,7 +727,7 @@ needBytecode mod continue Nothing -> return $ NeedsRecompile MustCompile Just mbc -> liftIO $ continue mbc -tryGetModIface :: String -> Module -> IfG (Maybe ModIface) +tryGetModIface :: String -> Module -> IfG (Maybe RetainedModIface) tryGetModIface doc_msg mod = do -- Load the imported interface if possible logger <- getLogger @@ -779,7 +779,7 @@ checkModUsage _ UsagePackageModule{ logger <- getLogger needInterface mod $ \iface -> do let reason = ModuleChanged (moduleName mod) - checkModuleFingerprint logger reason old_mod_hash (mi_mod_hash iface) + checkModuleFingerprint logger reason old_mod_hash (mi_abi_mod_hash (mi_abi_hashes 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 @@ -789,7 +789,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 iface) + checkModuleFingerprint logger reason old_mod_hash (mi_abi_mod_hash (mi_abi_hashes iface)) checkModUsage _ UsageHomeModuleBytecode{ usg_mod_name = mod_name , usg_unit_id = uid , usg_bytecode_hash = old_bytecode_hash } = do @@ -810,7 +810,7 @@ checkModUsage _ UsageHomeModule{ logger <- getLogger needInterface mod $ \iface -> do let - new_mod_hash = mi_mod_hash iface + new_mod_hash = mi_abi_mod_hash (mi_abi_hashes iface) new_decl_hash = mi_hash_fn iface reason = ModuleChanged (moduleName mod) @@ -864,7 +864,7 @@ checkModUsage fc UsageDirectory{ usg_dir_path = dir, -- Does this require recompilation? -- -- See Note [When to recompile when export lists change?] -checkHomeModImport :: Logger -> RecompReason -> Maybe HomeModImport -> ModIface -> IO RecompileRequired +checkHomeModImport :: Logger -> RecompReason -> Maybe HomeModImport -> RetainedModIface -> IO RecompileRequired checkHomeModImport _ _ Nothing _ = return UpToDate checkHomeModImport logger reason (Just (HomeModImport old_orphan_like_hash old_avails)) @@ -901,8 +901,8 @@ checkHomeModImport logger reason 2 (ppr changes) return $ needsRecompileBecause reason where - new_orphan_like_hash = mi_orphan_like_hash iface - new_avails_hash = mi_export_avails_hash iface + new_orphan_like_hash = mi_abi_orphan_like_hash (mi_abi_hashes iface) + new_avails_hash = mi_abi_export_avails_hash (mi_abi_hashes iface) new_exports = mi_exports iface -- | The exported avails of a module have changed. Should this cause recompilation @@ -1617,7 +1617,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 iface) + return (mi_abi_orphan_hash (mi_abi_hashes iface)) mapM get_orph_hash mods ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -517,7 +517,7 @@ renamePkgQual unit_env mn mb_pkg = case mb_pkg of -- interface, but without 'imp_mods'. calculateAvails :: HomeUnit -> S.Set UnitId - -> ModIface + -> RetainedModIface -> IsSafeImport -> IsBootInterface -> ImportedBy @@ -525,8 +525,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 iface - has_finsts = mi_finsts iface + orph_iface = mi_abi_orphan (mi_abi_hashes iface) + has_finsts = mi_abi_finsts (mi_abi_hashes iface) deps = mi_deps iface trust = getSafeMode $ mi_trust iface trust_pkg = mi_trust_pkg iface @@ -1209,7 +1209,7 @@ gresFromAvail hsc_env prov avail = gresFromAvails :: HscEnv -> Maybe ImportSpec -> [AvailInfo] -> [GlobalRdrElt] gresFromAvails hsc_env prov = concatMap (gresFromAvail hsc_env prov) -importsFromIface :: HscEnv -> ModIface -> ImpDeclSpec -> Maybe NameSet -> GlobalRdrEnv +importsFromIface :: HscEnv -> RetainedModIface -> ImpDeclSpec -> Maybe NameSet -> GlobalRdrEnv importsFromIface hsc_env iface decl_spec hidden = mkGlobalRdrEnv $ case hidden of Nothing -> all_gres Just hidden_names -> filter (not . (`elemNameSet` hidden_names) . greName) all_gres @@ -1225,7 +1225,7 @@ rnNamespaceSpecifier (DataNamespaceSpecifier x) = DataNamespaceSpecifier x filterImports :: HasDebugCallStack => HscEnv - -> ModIface + -> RetainedModIface -> ImpDeclSpec -- ^ Import spec -> Maybe (ImportListInterpretation, [LIE GhcPs]) @@ -2327,7 +2327,7 @@ getMinimalImports ie_decls where doc = text "Compute minimal imports for" <+> ppr decl - to_ie :: GlobalRdrEnv -> ModIface -> AvailInfo -> RnM [IE GhcRn] + to_ie :: GlobalRdrEnv -> RetainedModIface -> AvailInfo -> RnM [IE GhcRn] -- The main trick here is that if we're importing all the constructors -- we want to say "T(..)", but if we're importing only a subset we want -- to say "T(A,B,C)". So we have to find out what the module exports. @@ -2529,7 +2529,7 @@ DRFPatSynExport for a test of this. -} badImportItemErr - :: ModIface -> ImpDeclSpec -> IE GhcPs + :: RetainedModIface -> ImpDeclSpec -> IE GhcPs -> IsSubordinateError -> [AvailInfo] -> TcRn (NonEmpty ImportLookupReason) ===================================== compiler/GHC/Rename/Utils.hs ===================================== @@ -534,7 +534,7 @@ warnIfDeclDeprecated gre@(GRE { gre_imp = iss }) definedMod = moduleName $ assertPpr (isExternalName name) (ppr name) (nameModule name) doc = text "The name" <+> quotes (ppr occ) <+> text "is mentioned explicitly" -lookupImpDeclDeprec :: ModIface -> GlobalRdrElt -> Maybe (WarningTxt GhcRn) +lookupImpDeclDeprec :: RetainedModIface -> GlobalRdrElt -> Maybe (WarningTxt GhcRn) lookupImpDeclDeprec iface gre -- Bleat if the thing, or its parent, is warn'd = mi_decl_warn_fn iface (greOccName gre) `mplus` ===================================== compiler/GHC/Runtime/Loader.hs ===================================== @@ -190,7 +190,7 @@ checkExternalInterpreter hsc_env = case interpInstance <$> hsc_interp hsc_env of -> throwIO (InstallationError "Plugins require -fno-external-interpreter") _ -> pure () -loadPlugin' :: OccName -> Name -> HscEnv -> ModuleName -> IO (a, ModIface, [LinkableUsage], PkgsLoaded) +loadPlugin' :: OccName -> Name -> HscEnv -> ModuleName -> IO (a, RetainedModIface, [LinkableUsage], PkgsLoaded) loadPlugin' occ_name plugin_name hsc_env mod_name = do { let plugin_rdr_name = mkRdrQual mod_name occ_name dflags = hsc_dflags hsc_env @@ -341,7 +341,7 @@ lessUnsafeCoerce logger context what = do -- Need the module as well to record information in the interface file lookupRdrNameInModuleForPlugins :: HasDebugCallStack => HscEnv -> ModuleName -> RdrName - -> IO (Maybe (Name, ModIface)) + -> IO (Maybe (Name, RetainedModIface)) lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do let dflags = hsc_dflags hsc_env -- First find the unit the module resides in by searching exposed units and home modules ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -6386,7 +6386,7 @@ pprImportLookup :: ImportLookupReason -> SDoc pprImportLookup = \case ImportLookupBad k iface decl_spec ie _exts -> let - pprImpDeclSpec :: ModIface -> ImpDeclSpec -> SDoc + pprImpDeclSpec :: RetainedModIface -> ImpDeclSpec -> SDoc pprImpDeclSpec iface decl_spec = quotes (ppr (moduleName $ is_mod decl_spec)) <+> case mi_boot iface of IsBoot -> text "(hi-boot interface)" ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -215,7 +215,7 @@ import GHC.Types.DefaultEnv (ClassDefaults) import GHC.Unit.Types (Module) import GHC.Unit.State (UnitState) -import GHC.Unit.Module.ModIface (ModIface) +import GHC.Unit.Module.ModIface (RetainedModIface) import GHC.Utils.Outputable @@ -6635,7 +6635,7 @@ data ImportLookupReason where T9006, T11071, T9905fail2, T5385, T10668 -} ImportLookupBad :: BadImportKind - -> ModIface + -> RetainedModIface -> ImpDeclSpec -> IE GhcPs -> ImportLookupExtensions ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -1693,7 +1693,7 @@ lookupArgDoc i nm = do _ -> pure Nothing -- | Returns the module a Name belongs to, if it is isn't local. -getExternalModIface :: Name -> TcM (Maybe ModIface) +getExternalModIface :: Name -> TcM (Maybe RetainedModIface) getExternalModIface nm = do isLocal <- nameIsLocalOrFrom <$> getModule <*> pure nm if isLocal ===================================== 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 ifc + if mi_abi_finsts (mi_abi_hashes ifc) then mod:deps else deps ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -2964,7 +2964,7 @@ externaliseAndTidyId this_mod id -- a package module with an interface on disk. If neither of these is -- true, then the result will be an error indicating the interface -- could not be found. -getModuleInterface :: HscEnv -> Module -> IO (Messages TcRnMessage, Maybe ModIface) +getModuleInterface :: HscEnv -> Module -> IO (Messages TcRnMessage, Maybe RetainedModIface) getModuleInterface hsc_env mod = runTcInteractive NoTcMPlugins hsc_env $ loadModuleInterface (text "getModuleInterface") mod ===================================== compiler/GHC/Unit/External.hs ===================================== @@ -49,7 +49,7 @@ type PackageAnnEnv = AnnEnv type PackageCompleteMatches = CompleteMatches -- | Helps us find information about modules in the imported packages -type PackageIfaceTable = ModuleEnv ModIface +type PackageIfaceTable = ModuleEnv RetainedModIface -- Domain = modules in the imported packages -- | Constructs an empty PackageIfaceTable ===================================== compiler/GHC/Unit/Module/ModIface.hs ===================================== @@ -2,6 +2,7 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE RecordWildCards #-} module GHC.Unit.Module.ModIface ( ModIface @@ -68,19 +69,31 @@ module GHC.Unit.Module.ModIface , set_mi_fix_fn , set_mi_hash_fn , completePartialModIface + , shrinkModIface , IfaceBinHandle(..) , PartialModIface + , RetainedModIface , IfaceAbiHashes (..) , IfaceSelfRecomp (..) , IfaceCache (..) , IfaceSimplifiedCore (..) , withSelfRecomp - , IfaceDeclExts - , IfaceAbiHashesExts + , IfaceSelfRecompData + , IfaceSimplifiedCoreData + , ExtensibleFieldsData + , IfaceAnnotationsData + , IfaceDeclsData + , IfaceDefaultsData + , IfaceClsInstsData + , IfaceFamInstsData + , IfaceRulesData + , IfaceCompleteMatchesData + , IfaceAbiHashesData , IfaceExport , IfacePublic_(..) , IfacePublic , PartialIfacePublic + , RetainedIfacePublic , IfaceModInfo(..) , WhetherHasOrphans , WhetherHasFamInst @@ -167,9 +180,11 @@ We can build a full interface file two ways: type PartialModIface = ModIface_ 'ModIfaceCore type ModIface = ModIface_ 'ModIfaceFinal +type RetainedModIface = ModIface_ 'ModIfaceRetained type PartialIfacePublic = IfacePublic_ 'ModIfaceCore type IfacePublic = IfacePublic_ 'ModIfaceFinal +type RetainedIfacePublic = IfacePublic_ 'ModIfaceRetained -- | Extends a PartialModIface with hashes of the ABI. -- @@ -212,19 +227,11 @@ data IfaceCache = IfaceCache data ModIfacePhase = ModIfaceCore - -- ^ Partial interface built based on output of core pipeline. + -- ^ Partial interface built from the output of the core pipeline | ModIfaceFinal - --- | Selects a IfaceDecl representation. --- For fully instantiated interfaces we also maintain --- a fingerprint, which is used for recompilation checks. -type family IfaceDeclExts (phase :: ModIfacePhase) = decl | decl -> phase where - IfaceDeclExts 'ModIfaceCore = IfaceDecl - IfaceDeclExts 'ModIfaceFinal = (Fingerprint, IfaceDecl) - -type family IfaceAbiHashesExts (phase :: ModIfacePhase) = bk | bk -> phase where - IfaceAbiHashesExts 'ModIfaceCore = () - IfaceAbiHashesExts 'ModIfaceFinal = IfaceAbiHashes + -- ^ Complete interface + | ModIfaceRetained + -- ^ Interface shrunk to the parts that may be retained -- | In-memory byte array representation of a 'ModIface'. -- @@ -237,9 +244,66 @@ data IfaceBinHandle (phase :: ModIfacePhase) where -- See Note [Private fields in ModIface] for when this fields needs to be cleared -- (e.g., set to 'Nothing'). FullIfaceBinHandle :: !(Strict.Maybe FullBinData) -> IfaceBinHandle 'ModIfaceFinal - - -withSelfRecomp :: ModIface_ phase -> r -> (IfaceSelfRecomp -> r) -> r + RetainedIfaceBinHandle :: IfaceBinHandle 'ModIfaceRetained + +type family IfaceSelfRecompData (phase :: ModIfacePhase) where + IfaceSelfRecompData 'ModIfaceCore = Maybe IfaceSelfRecomp + IfaceSelfRecompData 'ModIfaceFinal = Maybe IfaceSelfRecomp + IfaceSelfRecompData 'ModIfaceRetained = () + +type family IfaceSimplifiedCoreData (phase :: ModIfacePhase) where + IfaceSimplifiedCoreData 'ModIfaceCore = Maybe IfaceSimplifiedCore + IfaceSimplifiedCoreData 'ModIfaceFinal = Maybe IfaceSimplifiedCore + IfaceSimplifiedCoreData 'ModIfaceRetained = () + +type family ExtensibleFieldsData (phase :: ModIfacePhase) where + ExtensibleFieldsData 'ModIfaceCore = ExtensibleFields + ExtensibleFieldsData 'ModIfaceFinal = ExtensibleFields + ExtensibleFieldsData 'ModIfaceRetained = () + +type family IfaceAnnotationsData (phase :: ModIfacePhase) where + IfaceAnnotationsData 'ModIfaceCore = [IfaceAnnotation] + IfaceAnnotationsData 'ModIfaceFinal = [IfaceAnnotation] + IfaceAnnotationsData 'ModIfaceRetained = () + +-- | The fingerprint in the 'ModIfaceFinal' case is used for recompilation +-- checks. +type family IfaceDeclsData (phase :: ModIfacePhase) where + IfaceDeclsData 'ModIfaceCore = [IfaceDecl] + IfaceDeclsData 'ModIfaceFinal = [(Fingerprint, IfaceDecl)] + IfaceDeclsData 'ModIfaceRetained = () + +type family IfaceDefaultsData (phase :: ModIfacePhase) where + IfaceDefaultsData 'ModIfaceCore = [IfaceDefault] + IfaceDefaultsData 'ModIfaceFinal = [IfaceDefault] + IfaceDefaultsData 'ModIfaceRetained = () + +type family IfaceClsInstsData (phase :: ModIfacePhase) where + IfaceClsInstsData 'ModIfaceCore = [IfaceClsInst] + IfaceClsInstsData 'ModIfaceFinal = [IfaceClsInst] + IfaceClsInstsData 'ModIfaceRetained = () + +type family IfaceFamInstsData (phase :: ModIfacePhase) where + IfaceFamInstsData 'ModIfaceCore = [IfaceFamInst] + IfaceFamInstsData 'ModIfaceFinal = [IfaceFamInst] + IfaceFamInstsData 'ModIfaceRetained = () + +type family IfaceRulesData (phase :: ModIfacePhase) where + IfaceRulesData 'ModIfaceCore = [IfaceRule] + IfaceRulesData 'ModIfaceFinal = [IfaceRule] + IfaceRulesData 'ModIfaceRetained = () + +type family IfaceCompleteMatchesData (phase :: ModIfacePhase) where + IfaceCompleteMatchesData 'ModIfaceCore = [IfaceCompleteMatch] + IfaceCompleteMatchesData 'ModIfaceFinal = [IfaceCompleteMatch] + IfaceCompleteMatchesData 'ModIfaceRetained = () + +type family IfaceAbiHashesData (phase :: ModIfacePhase) where + IfaceAbiHashesData 'ModIfaceCore = () + IfaceAbiHashesData 'ModIfaceFinal = IfaceAbiHashes + IfaceAbiHashesData 'ModIfaceRetained = IfaceAbiHashes + +withSelfRecomp :: ModIface -> r -> (IfaceSelfRecomp -> r) -> r withSelfRecomp iface nk jk = case mi_self_recomp_info iface of Nothing -> nk @@ -279,11 +343,11 @@ data ModIface_ (phase :: ModIfacePhase) -- importing this module. The main, original part of an interface. - mi_self_recomp_ :: Maybe IfaceSelfRecomp, + mi_self_recomp_ :: IfaceSelfRecompData phase, -- ^ Information needed for checking self-recompilation. -- See Note [Self recompilation information in interface files] - mi_simplified_core_ :: Maybe IfaceSimplifiedCore, + mi_simplified_core_ :: IfaceSimplifiedCoreData phase, -- ^ The part of the interface written when `-fwrite-if-simplified-core` is enabled. -- These parts are used to restart bytecode generation. @@ -301,7 +365,7 @@ data ModIface_ (phase :: ModIfacePhase) -- defined by the user). Used for GHCi and for inspecting -- the contents of modules via the GHC API only. - mi_ext_fields_ :: ExtensibleFields + mi_ext_fields_ :: ExtensibleFieldsData phase -- ^ 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 @@ -334,12 +398,12 @@ data IfacePublic_ phase = IfacePublic { -- ^ Warnings -- NOT STRICT! we read this field lazily from the interface file - mi_anns_ :: [IfaceAnnotation], + mi_anns_ :: IfaceAnnotationsData phase, -- ^ Annotations -- NOT STRICT! we read this field lazily from the interface file - mi_decls_ :: [IfaceDeclExts phase], + mi_decls_ :: IfaceDeclsData phase, -- ^ Type, class and variable declarations -- The hash of an Id changes if its fixity or deprecations change -- (as well as its type of course) @@ -347,14 +411,14 @@ data IfacePublic_ phase = IfacePublic { -- the hash of the parent class/tycon changes - mi_defaults_ :: [IfaceDefault], + mi_defaults_ :: IfaceDefaultsData phase, -- ^ default declarations exported by the module -- Instance declarations and rules - mi_insts_ :: [IfaceClsInst], -- ^ Sorted class instance - mi_fam_insts_ :: [IfaceFamInst], -- ^ Sorted family instances - mi_rules_ :: [IfaceRule], -- ^ Sorted rules + mi_insts_ :: IfaceClsInstsData phase, -- ^ Sorted class instance + mi_fam_insts_ :: IfaceFamInstsData phase, -- ^ Sorted family instances + mi_rules_ :: IfaceRulesData phase, -- ^ Sorted rules mi_trust_ :: IfaceTrustInfo, @@ -367,20 +431,20 @@ data IfacePublic_ phase = IfacePublic { -- 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_ :: IfaceCompleteMatchesData phase, -- ^ {-# COMPLETE #-} declarations mi_caches_ :: IfaceCache, -- ^ Cached lookups of some parts of mi_public - mi_abi_hashes_ :: (IfaceAbiHashesExts phase) + mi_abi_hashes_ :: IfaceAbiHashesData phase -- ^ Either `()` or `IfaceAbiHashes` for -- a fully instantiated interface. -- These fields are hashes of different parts of the public interface. } mkIfacePublic :: [IfaceExport] - -> [IfaceDeclExts 'ModIfaceFinal] + -> [(Fingerprint, IfaceDecl)] -> [(OccName, Fixity)] -> IfaceWarnings -> [IfaceAnnotation] @@ -501,22 +565,22 @@ That's why in GHC.Driver.Main.hscMaybeWriteIface there is the call to forceModIface. -} -mi_flag_hash :: ModIface_ phase -> Maybe (FingerprintWithValue IfaceDynFlags) +mi_flag_hash :: ModIface -> Maybe (FingerprintWithValue IfaceDynFlags) mi_flag_hash = fmap mi_sr_flag_hash . mi_self_recomp_ -mi_opt_hash :: ModIface_ phase -> Maybe Fingerprint +mi_opt_hash :: ModIface -> Maybe Fingerprint mi_opt_hash = fmap mi_sr_opt_hash . mi_self_recomp_ -mi_hpc_hash :: ModIface_ phase -> Maybe Fingerprint +mi_hpc_hash :: ModIface -> Maybe Fingerprint mi_hpc_hash = fmap mi_sr_hpc_hash . mi_self_recomp_ -mi_src_hash :: ModIface_ phase -> Maybe Fingerprint +mi_src_hash :: ModIface -> Maybe Fingerprint mi_src_hash = fmap mi_sr_src_hash . mi_self_recomp_ -mi_usages :: ModIface_ phase -> Maybe [Usage] +mi_usages :: ModIface -> Maybe [Usage] mi_usages = fmap mi_sr_usages . mi_self_recomp_ -mi_plugin_hash :: ModIface_ phase -> Maybe Fingerprint +mi_plugin_hash :: ModIface -> Maybe Fingerprint mi_plugin_hash = fmap mi_sr_plugin_hash . mi_self_recomp_ -- | Accessor for the module hash of the ABI from a ModIface. @@ -547,7 +611,7 @@ 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. -mi_boot :: ModIface -> IsBootInterface +mi_boot :: ModIface_ phase -> IsBootInterface mi_boot iface = if mi_hsc_src iface == HsBootFile then IsBoot else NotBoot @@ -557,7 +621,7 @@ 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 :: ModIface_ phase -> OccName -> Fixity mi_fix iface name = mi_fix_fn iface name `orElse` defaultFixity -- | The semantic module for this interface; e.g., if it's a interface @@ -573,7 +637,7 @@ 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 +mi_free_holes :: ModIface_ phase -> UniqDSet ModuleName mi_free_holes iface = case getModuleInstantiation (mi_module iface) of (_, Just indef) @@ -771,7 +835,7 @@ emptyPartialModIface mod mi_iface_hash_ = fingerprint0, mi_hi_bytes_ = PartialIfaceBinHandle, mi_deps_ = noDependencies, - mi_public_ = emptyPublicModIface (), + mi_public_ = emptyPublicModIface [] [] [] [] [] [] [] (), mi_simplified_core_ = Nothing, mi_top_env_ = IfaceTopEnv emptyDetOrdAvails [] , mi_docs_ = Nothing, @@ -787,24 +851,39 @@ emptyIfaceModInfo mod = IfaceModInfo , 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_ = [] - } +emptyPublicModIface :: IfaceAnnotationsData phase + -> IfaceDeclsData phase + -> IfaceDefaultsData phase + -> IfaceClsInstsData phase + -> IfaceFamInstsData phase + -> IfaceRulesData phase + -> IfaceCompleteMatchesData phase + -> IfaceAbiHashesData phase + -> IfacePublic_ phase +emptyPublicModIface anns + decls + defaults + insts + fam_insts + rules + complete_matches + abi_hashes + = IfacePublic + { mi_exports_ = [] + , mi_fixities_ = [] + , mi_warns_ = IfWarnSome [] [] + , mi_anns_ = anns + , mi_decls_ = decls + , mi_defaults_ = defaults + , mi_insts_ = insts + , mi_fam_insts_ = fam_insts + , mi_rules_ = rules + , mi_trust_ = noIfaceTrustInfo + , mi_trust_pkg_ = False + , mi_complete_matches_ = complete_matches + , mi_caches_ = emptyModIfaceCache + , mi_abi_hashes_ = abi_hashes + } emptyModIfaceCache :: IfaceCache emptyModIfaceCache = IfaceCache { @@ -827,7 +906,7 @@ emptyIfaceBackend = IfaceAbiHashes emptyFullModIface :: Module -> ModIface emptyFullModIface mod = (emptyPartialModIface mod) - { mi_public_ = emptyPublicModIface emptyIfaceBackend + { mi_public_ = emptyPublicModIface [] [] [] [] [] [] [] emptyIfaceBackend , mi_hi_bytes_ = FullIfaceBinHandle Strict.Nothing } @@ -848,8 +927,17 @@ 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 (IfaceAbiHashesExts (phase :: ModIfacePhase)) - , NFData (IfaceDeclExts (phase :: ModIfacePhase)) +instance ( NFData (IfaceSelfRecompData phase) + , NFData (IfaceSimplifiedCoreData phase) + , NFData (ExtensibleFieldsData phase) + , NFData (IfaceAnnotationsData phase) + , NFData (IfaceDeclsData phase) + , NFData (IfaceDefaultsData phase) + , NFData (IfaceClsInstsData phase) + , NFData (IfaceFamInstsData phase) + , NFData (IfaceRulesData phase) + , NFData (IfaceCompleteMatchesData phase) + , NFData (IfaceAbiHashesData phase) ) => NFData (ModIface_ phase) where rnf (PrivateModIface a1 a2 a3 a4 a5 a6 a7 a8 a9 a10) = (a1 :: IfaceBinHandle phase) @@ -882,7 +970,15 @@ instance NFData IfaceAbiHashes where `seq` rnf a5 `seq` rnf a6 -instance (NFData (IfaceAbiHashesExts phase), NFData (IfaceDeclExts phase)) => NFData (IfacePublic_ phase) where +instance ( NFData (IfaceAnnotationsData phase) + , NFData (IfaceDeclsData phase) + , NFData (IfaceDefaultsData phase) + , NFData (IfaceClsInstsData phase) + , NFData (IfaceFamInstsData phase) + , NFData (IfaceRulesData phase) + , NFData (IfaceCompleteMatchesData phase) + , NFData (IfaceAbiHashesData 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 @@ -958,7 +1054,6 @@ completePartialModIface partial iface_hash decls extra_decls final_exts cache = , mi_hi_bytes_ = FullIfaceBinHandle Strict.Nothing , mi_iface_hash_ = iface_hash } - where -- | Given a 'PartialIfacePublic', turn it into an 'IfacePublic' by completing -- missing fields. @@ -973,10 +1068,36 @@ completePublicModIface decls abi_hashes cache partial = partial , mi_caches_ = cache } +shrinkModIface :: ModIface -> RetainedModIface +shrinkModIface PrivateModIface {..} + = PrivateModIface + { + mi_hi_bytes_ = RetainedIfaceBinHandle, + mi_public_ = shrinkIfacePublic mi_public_, + mi_self_recomp_ = (), + mi_simplified_core_ = (), + mi_ext_fields_ = (), + .. + } + +shrinkIfacePublic :: IfacePublic -> RetainedIfacePublic +shrinkIfacePublic IfacePublic {..} + = IfacePublic + { + mi_anns_ = (), + mi_decls_ = (), + mi_defaults_ = (), + mi_insts_ = (), + mi_fam_insts_ = (), + mi_rules_ = (), + mi_complete_matches_ = (), + .. + } + 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 IfaceSelfRecomp-> ModIface_ phase -> ModIface_ phase +set_mi_self_recomp :: IfaceSelfRecompData phase -> 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 @@ -988,7 +1109,7 @@ 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 :: IfaceSimplifiedCoreData phase -> 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 @@ -997,7 +1118,7 @@ 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 :: ExtensibleFieldsData phase -> 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 -} @@ -1011,22 +1132,22 @@ set_mi_fixities val = set_mi_public (\iface -> iface { mi_fixities_ = val }) set_mi_warns :: IfaceWarnings -> ModIface_ phase -> ModIface_ phase set_mi_warns val = set_mi_public (\iface -> iface { mi_warns_ = val }) -set_mi_anns :: [IfaceAnnotation] -> ModIface_ phase -> ModIface_ phase +set_mi_anns :: IfaceAnnotationsData phase -> ModIface_ phase -> ModIface_ phase set_mi_anns val = set_mi_public (\iface -> iface { mi_anns_ = val }) -set_mi_insts :: [IfaceClsInst] -> ModIface_ phase -> ModIface_ phase +set_mi_insts :: IfaceClsInstsData phase -> ModIface_ phase -> ModIface_ phase 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 :: IfaceFamInstsData phase -> ModIface_ phase -> ModIface_ phase 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 :: IfaceRulesData phase -> ModIface_ phase -> ModIface_ phase set_mi_rules val = set_mi_public (\iface -> iface { mi_rules_ = val }) -set_mi_decls :: [IfaceDeclExts phase] -> ModIface_ phase -> ModIface_ phase +set_mi_decls :: IfaceDeclsData phase -> ModIface_ phase -> ModIface_ phase set_mi_decls val = set_mi_public (\iface -> iface { mi_decls_ = val }) -set_mi_defaults :: [IfaceDefault] -> ModIface_ phase -> ModIface_ phase +set_mi_defaults :: IfaceDefaultsData phase -> ModIface_ phase -> ModIface_ phase set_mi_defaults val = set_mi_public (\iface -> iface { mi_defaults_ = val }) set_mi_trust :: IfaceTrustInfo -> ModIface_ phase -> ModIface_ phase @@ -1035,10 +1156,10 @@ 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 = set_mi_public (\iface -> iface { mi_trust_pkg_ = val }) -set_mi_complete_matches :: [IfaceCompleteMatch] -> ModIface_ phase -> ModIface_ phase +set_mi_complete_matches :: IfaceCompleteMatchesData phase -> ModIface_ phase -> ModIface_ phase 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 :: IfaceAbiHashesData 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 -} @@ -1084,8 +1205,9 @@ set_mi_mod_info_field f iface = clear_mi_hi_bytes $ iface { mi_mod_info_ = f (mi clear_mi_hi_bytes :: ModIface_ phase -> ModIface_ phase clear_mi_hi_bytes iface = iface { mi_hi_bytes_ = case mi_hi_bytes iface of - PartialIfaceBinHandle -> PartialIfaceBinHandle - FullIfaceBinHandle _ -> FullIfaceBinHandle Strict.Nothing + PartialIfaceBinHandle -> PartialIfaceBinHandle + FullIfaceBinHandle _ -> FullIfaceBinHandle Strict.Nothing + RetainedIfaceBinHandle -> RetainedIfaceBinHandle } -- ---------------------------------------------------------------------------- @@ -1183,22 +1305,22 @@ pattern ModIface :: -> [IfaceExport] -> [(OccName, Fixity)] -> IfaceWarnings - -> [IfaceAnnotation] - -> [IfaceDeclExts phase] - -> Maybe IfaceSimplifiedCore - -> [IfaceDefault] + -> IfaceAnnotationsData phase + -> IfaceDeclsData phase + -> IfaceSimplifiedCoreData phase + -> IfaceDefaultsData phase -> IfaceTopEnv - -> [IfaceClsInst] - -> [IfaceFamInst] - -> [IfaceRule] + -> IfaceClsInstsData phase + -> IfaceFamInstsData phase + -> IfaceRulesData phase -> IfaceTrustInfo -> Bool - -> [IfaceCompleteMatch] + -> IfaceCompleteMatchesData phase -> Maybe Docs - -> IfaceAbiHashesExts phase - -> ExtensibleFields + -> IfaceAbiHashesData phase + -> ExtensibleFieldsData phase -> IfaceBinHandle phase - -> Maybe IfaceSelfRecomp + -> IfaceSelfRecompData phase -> (OccName -> Maybe Fixity) -> (OccName -> Maybe (OccName, Fingerprint)) -> (OccName -> Maybe (WarningTxt GhcRn)) ===================================== ghc/Main.hs ===================================== @@ -515,7 +515,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) ifaces + mapM_ (put_ bh . mi_abi_mod_hash . mi_abi_hashes) ifaces f <- fingerprintBinMem bh putStrLn (showPpr dflags f) ===================================== utils/haddock/haddock-api/src/Haddock/Interface.hs ===================================== @@ -63,7 +63,7 @@ import GHC.Driver.Session hiding (verbosity) import GHC.Driver.Phases import GHC.Driver.Pipeline (compileFile) import GHC.HsToCore.Docs (getMainDeclBinder) -import GHC.Iface.Load (loadSysInterface) +import GHC.Iface.Load (findAndReadIface) import GHC.IfaceToCore (tcIfaceInst, tcIfaceFamInst) import GHC.Tc.Utils.Monad (initIfaceLoad, initIfaceLcl) import GHC.Tc.Utils.Env (lookupGlobal_maybe) @@ -72,6 +72,7 @@ import GHC.Types.Name.Occurrence (emptyOccEnv) import GHC.Unit.Finder (findImportedModule, ModuleLookupScope(..), FindResult(Found)) import GHC.Unit.Home.ModInfo import GHC.Unit.Home.PackageTable +import GHC.Unit.Module (getModuleInstantiation) import GHC.Unit.Module.Graph (ModuleGraphNode (..), ModuleNodeInfo(..)) import GHC.Unit.Module.ModDetails import GHC.Unit.Module.ModIface (mi_semantic_module, mi_boot) @@ -254,19 +255,20 @@ dropErr :: MaybeErr e a -> Maybe a dropErr (Succeeded a) = Just a dropErr (Failed _) = Nothing -loadHiFile :: HscEnv -> Outputable.SDoc -> Module -> IO (ModIface, ([ClsInst], [FamInst])) -loadHiFile hsc_env doc theModule = initIfaceLoad hsc_env $ do - - mod_iface <- loadSysInterface doc theModule - - insts <- initIfaceLcl (mi_semantic_module mod_iface) doc (mi_boot mod_iface) $ do - - new_eps_insts <- mapM tcIfaceInst (mi_insts mod_iface) - new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts mod_iface) - - pure (new_eps_insts, new_eps_fam_insts) - - pure (mod_iface, insts) +loadHiFile :: Verbosity -> HscEnv -> Outputable.SDoc -> Module -> IO (ModIface, ([ClsInst], [FamInst])) +loadHiFile verbosity hsc_env doc requested = initIfaceLoad hsc_env $ do + let installed = fst (getModuleInstantiation requested) + iface_fetch_result <- liftIO $ findAndReadIface hsc_env doc installed requested NotBoot + case iface_fetch_result of + Failed _ -> do + out verbosity normal "Interface fetching failed" + liftIO exitFailure + Succeeded (mod_iface, _) -> do + insts <- initIfaceLcl (mi_semantic_module mod_iface) doc (mi_boot mod_iface) $ do + new_eps_insts <- mapM tcIfaceInst (mi_insts mod_iface) + new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts mod_iface) + pure (new_eps_insts, new_eps_fam_insts) + pure (mod_iface, insts) processModule :: Verbosity -> ModSummary -> [Flag] -> IfaceMap -> InstIfaceMap -> WarningMap -> Ghc (Maybe Interface) processModule verbosity modSummary flags ifaceMap instIfaceMap warningMap = do @@ -279,7 +281,7 @@ processModule verbosity modSummary flags ifaceMap instIfaceMap warningMap = do unit_state = hsc_units hsc_env (mod_iface, insts) <- if Flag_NoCompilation `elem` flags - then liftIO $ loadHiFile hsc_env doc $ ms_mod modSummary + then liftIO $ loadHiFile verbosity hsc_env doc $ ms_mod modSummary else do hmi <- liftIO $ lookupHpt (hsc_HPT hsc_env) (moduleName $ ms_mod modSummary) >>= \case Nothing -> error "processModule: All modules should be loaded into the HPT by this point" @@ -374,7 +376,7 @@ createOneShotIface verbosity flags instIfaceMap moduleNameStr = do modifySession $ hscSetFlags dflags hsc_env <- getSession - (iface, insts) <- liftIO $ loadHiFile hsc_env doc $ mkMainModule_ moduleNm + (iface, insts) <- liftIO $ loadHiFile verbosity hsc_env doc $ mkMainModule_ moduleNm -- Update the DynFlags with the extensions from the source file (as stored in the interface file) -- This is instead of ms_hspp_opts from ModSummary, which is not available in one-shot mode. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d98c999ba9904de469303b93125bc8f... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d98c999ba9904de469303b93125bc8f... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help