Wolfgang Jeltsch pushed to branch wip/jeltsch/smaller-pit at Glasgow Haskell Compiler / GHC Commits: 4c77cd99 by Wolfgang Jeltsch at 2026-10-06T17:22:27+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. - - - - - 51cbfb3e by Wolfgang Jeltsch at 2026-10-06T17:22:39+03:00 Make `IfaceBinHandle` a type synonym family This brings the handling of `IfaceBinHandle` somewhat in line with how other phase-dependent data is handled. Note that `mi_hi_bytes_` now includes the `Strict.Maybe` layer itself, independently of the phase. This is necessary, because with a type family instead of a GADT `clear_mi_hi_bytes` cannot determine the phase at runtime anymore and thus has to set `mi_hi_bytes_` to `Strict.Nothing` for every phase. - - - - - 24 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/Binary.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Load.hs-boot - compiler/GHC/Iface/Make.hs - 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/count-deps/Main.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/Binary.hs ===================================== @@ -197,7 +197,7 @@ getIfaceWithExtFields name_cache bh = do modIfaceBinData <- freezeBinHandle bh start pure $ mod_iface & set_mi_ext_fields extFields - & set_mi_hi_bytes (FullIfaceBinHandle $ Strict.Just modIfaceBinData) + & set_mi_hi_bytes (Strict.Just modIfaceBinData) -- | This performs a get action after reading the dictionary and symbol -- table. It is necessary to run this before trying to deserialise any @@ -276,10 +276,10 @@ writeBinIface profile traceBinIface compressionLevel hi_path mod_iface = do putIfaceWithExtFields :: TraceBinIFace -> CompressionIFace -> WriteBinHandle -> ModIface -> IO () putIfaceWithExtFields traceBinIface compressionLevel bh mod_iface = case mi_hi_bytes mod_iface of - FullIfaceBinHandle Strict.Nothing -> do + Strict.Nothing -> do forwardPutRel_ bh (\_ -> put_ bh (mi_ext_fields mod_iface)) $ do putWithUserData traceBinIface compressionLevel bh mod_iface - FullIfaceBinHandle (Strict.Just binData) -> putFullBinData bh binData + Strict.Just binData -> putFullBinData bh binData -- | Put a piece of data with an initialised `UserData` field. This -- is necessary if you want to serialise Names or FastStrings. ===================================== 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/Make.hs ===================================== @@ -77,6 +77,7 @@ import GHC.Iface.Binary import GHC.Data.FastString import GHC.Data.Maybe +import qualified GHC.Data.Strict as Strict import GHC.HsToCore.Docs import GHC.HsToCore.Usage @@ -394,7 +395,7 @@ mkIface_ hsc_env & set_mi_docs docs & set_mi_abi_hashes () & set_mi_ext_fields emptyExtensibleFields - & set_mi_hi_bytes PartialIfaceBinHandle + & set_mi_hi_bytes Strict.Nothing where cmp_rule = lexicalCompareFS `on` ifRuleName ===================================== 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 - , IfaceBinHandle(..) + , 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 @@ -147,6 +160,7 @@ import GHC.Utils.Binary import Control.DeepSeq import Control.Exception +import Data.Void (Void) {- Note [Interface file stages] @@ -167,9 +181,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,34 +228,78 @@ 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'. -- -- See Note [Sharing of ModIface] for why we need this. -data IfaceBinHandle (phase :: ModIfacePhase) where - -- | A partial 'ModIface' cannot be serialised to disk. - PartialIfaceBinHandle :: IfaceBinHandle 'ModIfaceCore - -- | Optional 'FullBinData' that can be serialised to disk directly. - -- - -- 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 +type family IfaceBinHandle (phase :: ModIfacePhase) where + IfaceBinHandle 'ModIfaceCore = Void + IfaceBinHandle 'ModIfaceFinal = FullBinData + IfaceBinHandle 'ModIfaceRetained = Void + +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 @@ -258,11 +318,12 @@ withSelfRecomp iface nk jk = -- fields. data ModIface_ (phase :: ModIfacePhase) = PrivateModIface { - mi_hi_bytes_ :: !(IfaceBinHandle phase), + mi_hi_bytes_ :: !(Strict.Maybe (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]. + -- See Note [Sharing of ModIface] and + -- Note [Private fields in ModIface]. mi_iface_hash_ :: Fingerprint, -- A hash of the whole interface mi_mod_info_ :: IfaceModInfo, @@ -279,11 +340,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 +362,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 +395,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 +408,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 +428,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 +562,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 +608,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 +618,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 +634,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) @@ -654,7 +715,7 @@ instance Binary ModIface where -- 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 + mi_hi_bytes_ = Strict.Nothing }) instance Binary IfaceModInfo where @@ -769,9 +830,9 @@ emptyPartialModIface mod = PrivateModIface { mi_mod_info_ = emptyIfaceModInfo mod, mi_iface_hash_ = fingerprint0, - mi_hi_bytes_ = PartialIfaceBinHandle, + mi_hi_bytes_ = Strict.Nothing, mi_deps_ = noDependencies, - mi_public_ = emptyPublicModIface (), + mi_public_ = emptyPublicModIface [] [] [] [] [] [] [] (), mi_simplified_core_ = Nothing, mi_top_env_ = IfaceTopEnv emptyDetOrdAvails [] , mi_docs_ = Nothing, @@ -787,24 +848,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,8 +903,8 @@ emptyIfaceBackend = IfaceAbiHashes emptyFullModIface :: Module -> ModIface emptyFullModIface mod = (emptyPartialModIface mod) - { mi_public_ = emptyPublicModIface emptyIfaceBackend - , mi_hi_bytes_ = FullIfaceBinHandle Strict.Nothing + { mi_public_ = emptyPublicModIface [] [] [] [] [] [] [] emptyIfaceBackend + , mi_hi_bytes_ = Strict.Nothing } @@ -848,11 +924,20 @@ 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) + = a1 `seq` rnf a2 `seq` rnf a3 `seq` rnf a4 @@ -882,7 +967,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 @@ -955,10 +1048,9 @@ completePartialModIface :: PartialModIface 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_hi_bytes_ = Strict.Nothing , mi_iface_hash_ = iface_hash } - where -- | Given a 'PartialIfacePublic', turn it into an 'IfacePublic' by completing -- missing fields. @@ -973,13 +1065,39 @@ completePublicModIface decls abi_hashes cache partial = partial , mi_caches_ = cache } +shrinkModIface :: ModIface -> RetainedModIface +shrinkModIface PrivateModIface {..} + = PrivateModIface + { + mi_hi_bytes_ = Strict.Nothing, + 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 +set_mi_hi_bytes :: Strict.Maybe (IfaceBinHandle phase) -> ModIface_ phase -> ModIface_ phase set_mi_hi_bytes val iface = iface { mi_hi_bytes_ = val } set_mi_deps :: Dependencies -> ModIface_ phase -> ModIface_ phase @@ -988,7 +1106,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 +1115,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 +1129,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 +1153,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 -} @@ -1082,11 +1200,7 @@ set_mi_mod_info_field f iface = clear_mi_hi_bytes $ iface { mi_mod_info_ = f (mi -- | Invalidate any byte array buffer we might have. 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 - } +clear_mi_hi_bytes iface = iface { mi_hi_bytes_ = Strict.Nothing } -- ---------------------------------------------------------------------------- -- 'ModIface' pattern synonyms to keep breakage low. @@ -1183,22 +1297,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 - -> IfaceBinHandle phase - -> Maybe IfaceSelfRecomp + -> IfaceAbiHashesData phase + -> ExtensibleFieldsData phase + -> Strict.Maybe (IfaceBinHandle phase) + -> 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/count-deps/Main.hs ===================================== @@ -79,5 +79,5 @@ calcDeps modName libdir = mkModule :: String -> ModuleName -> Module mkModule ghcUnitId = Module (stringToUnit ghcUnitId) - modDeps :: ModIface -> [ModuleName] + modDeps :: ModIface_ phase -> [ModuleName] modDeps mi = map (gwib_mod . (\(_, _, mn) -> mn)) $ Set.toList $ dep_direct_mods (mi_deps mi) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c767ce9a48c7401e2e5c772bf7741e5... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c767ce9a48c7401e2e5c772bf7741e5... 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