Wolfgang Jeltsch pushed to branch wip/jeltsch/smaller-pit at Glasgow Haskell Compiler / GHC Commits: 260b75fc by Wolfgang Jeltsch at 2026-10-01T13:55:13+03:00 Statically guarantee the information reduction for the PIT - - - - - 23 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 - utils/haddock/haddock-api/src/Haddock/Interface/Create.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,6 +69,7 @@ module GHC.Unit.Module.ModIface , set_mi_fix_fn , set_mi_hash_fn , completePartialModIface + , shrinkModIface , IfaceBinHandle(..) , PartialModIface , RetainedModIface @@ -82,8 +84,6 @@ module GHC.Unit.Module.ModIface , IfaceAnnotationsData , IfaceDeclsData , IfaceDefaultsData - , IfaceClsInstsData - , IfaceFamInstsData , IfaceRulesData , IfaceCompleteMatchesData , IfaceAbiHashesData @@ -268,23 +268,13 @@ type family IfaceAnnotationsData (phase :: ModIfacePhase) where type family IfaceDeclsData (phase :: ModIfacePhase) where IfaceDeclsData 'ModIfaceCore = [IfaceDecl] IfaceDeclsData 'ModIfaceFinal = [(Fingerprint, IfaceDecl)] - IfaceDeclsData 'ModIfaceRetained = () + IfaceDeclsData 'ModIfaceRetained = [IfaceDecl] 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] @@ -413,9 +403,9 @@ data IfacePublic_ phase = IfacePublic { -- Instance declarations and rules - mi_insts_ :: IfaceClsInstsData phase, -- ^ Sorted class instance - mi_fam_insts_ :: IfaceFamInstsData phase, -- ^ Sorted family instances - mi_rules_ :: IfaceRulesData phase, -- ^ Sorted rules + mi_insts_ :: [IfaceClsInst], -- ^ Sorted class instance + mi_fam_insts_ :: [IfaceFamInst], -- ^ Sorted family instances + mi_rules_ :: IfaceRulesData phase, -- ^ Sorted rules mi_trust_ :: IfaceTrustInfo, @@ -608,7 +598,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 @@ -618,7 +608,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 @@ -634,7 +624,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) @@ -851,8 +841,8 @@ emptyIfaceModInfo mod = IfaceModInfo emptyPublicModIface :: IfaceAnnotationsData phase -> IfaceDeclsData phase -> IfaceDefaultsData phase - -> IfaceClsInstsData phase - -> IfaceFamInstsData phase + -> [IfaceClsInst] + -> [IfaceFamInst] -> IfaceRulesData phase -> IfaceCompleteMatchesData phase -> IfaceAbiHashesData phase @@ -930,8 +920,6 @@ instance ( NFData (IfaceSelfRecompData 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) @@ -970,8 +958,6 @@ instance NFData IfaceAbiHashes 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) @@ -1051,7 +1037,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. @@ -1066,6 +1051,30 @@ 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_ = map snd mi_decls_, + mi_defaults_ = (), + 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 } @@ -1107,10 +1116,10 @@ set_mi_warns val = set_mi_public (\iface -> iface { mi_warns_ = val }) set_mi_anns :: IfaceAnnotationsData phase -> ModIface_ phase -> ModIface_ phase set_mi_anns val = set_mi_public (\iface -> iface { mi_anns_ = val }) -set_mi_insts :: IfaceClsInstsData phase -> ModIface_ phase -> ModIface_ phase +set_mi_insts :: [IfaceClsInst] -> ModIface_ phase -> ModIface_ phase set_mi_insts val = set_mi_public (\iface -> iface { mi_insts_ = val }) -set_mi_fam_insts :: IfaceFamInstsData phase -> ModIface_ phase -> ModIface_ phase +set_mi_fam_insts :: [IfaceFamInst] -> ModIface_ phase -> ModIface_ phase set_mi_fam_insts val = set_mi_public (\iface -> iface { mi_fam_insts_ = val }) set_mi_rules :: IfaceRulesData phase -> ModIface_ phase -> ModIface_ phase @@ -1282,8 +1291,8 @@ pattern ModIface :: -> IfaceSimplifiedCoreData phase -> IfaceDefaultsData phase -> IfaceTopEnv - -> IfaceClsInstsData phase - -> IfaceFamInstsData phase + -> [IfaceClsInst] + -> [IfaceFamInst] -> IfaceRulesData phase -> IfaceTrustInfo -> Bool ===================================== 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 ===================================== @@ -74,7 +74,7 @@ import GHC.Unit.Home.ModInfo import GHC.Unit.Home.PackageTable import GHC.Unit.Module.Graph (ModuleGraphNode (..), ModuleNodeInfo(..)) import GHC.Unit.Module.ModDetails -import GHC.Unit.Module.ModIface (mi_semantic_module, mi_boot) +import GHC.Unit.Module.ModIface (RetainedModIface, shrinkModIface, mi_semantic_module, mi_boot) import GHC.Unit.Module.ModSummary (isBootSummary) import GHC.Utils.Outputable (Outputable, (<+>), pprModuleName, text) import GHC.Utils.Error (withTiming) @@ -254,7 +254,7 @@ dropErr :: MaybeErr e a -> Maybe a dropErr (Succeeded a) = Just a dropErr (Failed _) = Nothing -loadHiFile :: HscEnv -> Outputable.SDoc -> Module -> IO (ModIface, ([ClsInst], [FamInst])) +loadHiFile :: HscEnv -> Outputable.SDoc -> Module -> IO (RetainedModIface, ([ClsInst], [FamInst])) loadHiFile hsc_env doc theModule = initIfaceLoad hsc_env $ do mod_iface <- loadSysInterface doc theModule @@ -288,7 +288,7 @@ processModule verbosity modSummary flags ifaceMap instIfaceMap warningMap = do let cls_insts = instEnvElts . md_insts $ hm_details hmi fam_insts = md_fam_insts $ hm_details hmi - pure (hm_iface hmi, (cls_insts, fam_insts)) + pure (shrinkModIface (hm_iface hmi), (cls_insts, fam_insts)) !interface <- do logger <- getLogger ===================================== utils/haddock/haddock-api/src/Haddock/Interface/Create.hs ===================================== @@ -81,7 +81,7 @@ createInterface1 => [Flag] -> UnitState -> ModSummary - -> ModIface + -> RetainedModIface -> IfaceMap -> InstIfaceMap -> ([ClsInst], [FamInst]) @@ -105,7 +105,7 @@ createInterface1' -> UnitState -> DynFlags -> FilePath - -> ModIface + -> RetainedModIface -> IfaceMap -> InstIfaceMap -> ([ClsInst], [FamInst]) @@ -150,7 +150,7 @@ createInterface1' flags unit_state dflags hie_file mod_iface ifaces inst_ifaces def_meths_env = mkOccEnv def_meths def_meths = [ (nameOccName nm, nm) - | (_, IfaceId{ifName = nm}) <- mi_decls mod_iface + | IfaceId{ifName = nm} <- mi_decls mod_iface , let occ = nameOccName nm , isDefaultMethodOcc occ ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/260b75fcb25d56ba552159637ef70053... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/260b75fcb25d56ba552159637ef70053... 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