Torsten Schmits pushed to branch wip/torsten.schmits/mwb-26-01/abstract-linkables at Glasgow Haskell Compiler / GHC Commits: e1ce573a by Torsten Schmits at 2026-07-08T14:44:48+02:00 WIP Abstract getLinkDeps - - - - - 184990db by Torsten Schmits at 2026-07-08T17:55:04+02:00 WIP Make extra_decls lazy when loading from Binary - - - - - 5 changed files: - compiler/GHC/Driver/Env/Types.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Linker/Deps.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Unit/Module/ModIface.hs Changes: ===================================== compiler/GHC/Driver/Env/Types.hs ===================================== @@ -3,6 +3,8 @@ module GHC.Driver.Env.Types ( Hsc(..) , HscEnv(..) + , LinkDeps (..) + , Linkables (..) ) where import GHC.Driver.Errors.Types ( GhcMessage ) @@ -29,6 +31,10 @@ import Control.Monad.Trans.Reader import Control.Monad.Trans.State import Data.IORef import GHC.Driver.Env.KnotVars +import GHC.Types.SrcLoc (SrcSpan) +import GHC.Linker.Types (Linkable, LoaderState) +import GHC.Unit.Types (UnitId, Module) +import GHC.Types.Unique.DSet (UniqDSet) -- | The Hsc monad: Passing an environment and diagnostic state newtype Hsc a = Hsc (HscEnv -> Messages GhcMessage -> IO (a, Messages GhcMessage)) @@ -44,6 +50,18 @@ instance ContainsDynFlags HscEnv where instance HasLogger Hsc where getLogger = Hsc $ \e w -> return (hsc_logger e, w) +data LinkDeps = LinkDeps + { ldNeededLinkables :: [Linkable] + , ldAllLinkables :: [Linkable] + , ldNeededUnits :: [UnitId] + , ldAllUnits :: UniqDSet UnitId + } + +data Linkables where + Linkables :: { + linkablesResolve :: SrcSpan -> [Module] -> IO a, + linkablesSelect :: a -> IO LinkDeps + } -> Linkables -- | HscEnv is like 'GHC.Driver.Monad.Session', except that some of the fields are immutable. -- An HscEnv is used to compile a single module from plain Haskell source @@ -87,6 +105,8 @@ data HscEnv -- ^ target code interpreter (if any) to use for TH and GHCi. -- See Note [Target code interpreter] + , hsc_linkables :: HscEnv -> LoaderState -> IO Linkables + , hsc_plugins :: !Plugins -- ^ Plugins ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -304,7 +304,6 @@ import GHC.StgToCmm.Utils (IPEStats) import GHC.Types.Unique.FM import GHC.Types.Unique.DFM import GHC.Cmm.Config (CmmConfig) -import Data.Bifunctor import qualified GHC.Unit.Home.Graph as HUG import GHC.Unit.Home.PackageTable @@ -341,6 +340,7 @@ newHscEnvWithHUG top_dir top_dynflags cur_unit home_unit_graph = do , hsc_FC = fc_var , hsc_type_env_vars = emptyKnotVars , hsc_interp = Nothing + , hsc_linkables = linkablesDefault , hsc_unit_env = unit_env , hsc_plugins = emptyPlugins , hsc_hooks = emptyHooks @@ -2870,10 +2870,10 @@ jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id = do -- Take lock for the actual work. (dep_linkables, dep_units) <- modifyLoaderState interp $ \pls -> do - let link_opts = initLinkDepsOpts hsc_env -- Find what packages and linkables are required - deps <- getLinkDeps link_opts interp pls srcspan needed_mods + linkables <- hsc_linkables hsc_env hsc_env pls + deps <- linkablesGet linkables srcspan needed_mods -- We update the LinkerState even if the JS interpreter maintains its linker -- state independently to load new objects here. ===================================== compiler/GHC/Linker/Deps.hs ===================================== @@ -12,6 +12,8 @@ module GHC.Linker.Deps ( LinkDepsOpts (..) , LinkDeps (..) , getLinkDeps + , Linkables (..) + , linkablesGet ) where @@ -46,7 +48,6 @@ import GHC.Iface.Errors.Ppr import GHC.Utils.Misc import GHC.Unit.Home -import qualified GHC.Unit.Home.Graph as HUG import GHC.Data.Maybe import Control.Applicative @@ -61,10 +62,8 @@ import System.FilePath import System.Directory import GHC.Utils.Logger (Logger) import Control.Monad ((<$!>)) -import GHC.Driver.Env -import {-# SOURCE #-} GHC.Driver.Main -import Data.Time.Clock import GHC.Unit.Home.Graph +import GHC.Driver.Env.Types (Linkables (..), LinkDeps (..)) data LinkDepsOpts = LinkDepsOpts @@ -86,12 +85,9 @@ data LinkDepsOpts = LinkDepsOpts , ldLogger :: !Logger } -data LinkDeps = LinkDeps - { ldNeededLinkables :: [Linkable] - , ldAllLinkables :: [Linkable] - , ldNeededUnits :: [UnitId] - , ldAllUnits :: UniqDSet UnitId - } +linkablesGet :: Linkables -> SrcSpan -> [Module] -> IO LinkDeps +linkablesGet Linkables {..} span mods = + linkablesSelect =<< linkablesResolve span mods -- | Find all the packages and linkables that a set of modules depends on -- ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -32,6 +32,7 @@ module GHC.Linker.Loader , rmDupLinkables , modifyLoaderState , initLinkDepsOpts + , linkablesDefault ) where @@ -97,7 +98,6 @@ import Control.Monad import qualified Data.Set as Set import Data.Char (isSpace) import Data.Functor ((<&>)) -import qualified Data.Foldable as Foldable import Data.IORef import Data.List (intercalate, isPrefixOf, nub, partition) import Data.Maybe @@ -115,7 +115,7 @@ import System.Win32.Info (getSystemDirectory) #endif import GHC.Utils.Exception -import GHC.Unit.Home.Graph (lookupHug, unitEnv_foldWithKey) +import GHC.Unit.Home.Graph (unitEnv_foldWithKey) -- Note [Linkers and loaders] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -231,10 +231,10 @@ loadDependencies -> IO (LoaderState, SuccessFlag, [Linkable], PkgsLoaded) -- ^ returns the set of linkables required -- When called, the loader state must have been initialized (see `initLoaderState`) loadDependencies interp hsc_env pls span needed_mods = do - let opts = initLinkDepsOpts hsc_env + linkables <- hsc_linkables hsc_env hsc_env pls -- Find what packages and linkables are required - deps <- getLinkDeps opts interp pls span needed_mods + deps <- linkablesGet linkables span needed_mods let this_pkgs_needed = ldAllUnits deps @@ -683,6 +683,15 @@ initLinkDepsOpts hsc_env = opts EPS {eps_iface_bytecode} <- hscEPS hsc_env pure (lookupModuleEnv eps_iface_bytecode mod) +linkablesDefault :: + HscEnv -> + LoaderState -> + IO Linkables +linkablesDefault hsc_env pls = + pure Linkables { + linkablesResolve = getLinkDeps (initLinkDepsOpts hsc_env) (hscInterp hsc_env) pls, + linkablesSelect = pure + } {- ********************************************************************** ===================================== compiler/GHC/Unit/Module/ModIface.hs ===================================== @@ -503,7 +503,7 @@ instance Binary ModIface where lazyPut bh warns lazyPut bh anns put_ bh decls - put_ bh extra_decls + lazyPut bh extra_decls put_ bh foreign_ put_ bh insts put_ bh fam_insts @@ -536,7 +536,7 @@ instance Binary ModIface where warns <- {-# SCC "bin_warns" #-} lazyGet bh anns <- {-# SCC "bin_anns" #-} lazyGet bh decls <- {-# SCC "bin_tycldecls" #-} get bh - extra_decls <- get bh + extra_decls <- lazyGet bh foreign_ <- get bh insts <- {-# SCC "bin_insts" #-} get bh fam_insts <- {-# SCC "bin_fam_insts" #-} get bh View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/91fac8f283f82d4d9b1958c20ef4d14... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/91fac8f283f82d4d9b1958c20ef4d14... You're receiving this email because of your account on gitlab.haskell.org.