Torsten Schmits pushed to branch wip/torsten.schmits/worker-gbc at Glasgow Haskell Compiler / GHC Commits: 373fc0f2 by Torsten Schmits at 2026-09-29T00:09:36+02:00 Split `getLinkDeps` and abstract over the interface This allows API clients to customize bytecode loading to implement on-demand compilation of interface core bindings. - - - - - 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/Linker/Types.hs Changes: ===================================== compiler/GHC/Driver/Env/Types.hs ===================================== @@ -29,6 +29,7 @@ import Control.Monad.Trans.Reader import Control.Monad.Trans.State import Data.IORef import GHC.Driver.Env.KnotVars +import GHC.Linker.Types (LoaderState, Linkables) -- | The Hsc monad: Passing an environment and diagnostic state newtype Hsc a = Hsc (HscEnv -> Messages GhcMessage -> IO (a, Messages GhcMessage)) @@ -50,7 +51,6 @@ instance ContainsDynFlags HscEnv where instance HasLogger Hsc where getLogger = Hsc $ \e w -> return (hsc_logger e, w) - -- | 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 -- code (after preprocessing) to either C, assembly or C--. It's also used @@ -90,6 +90,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 ===================================== @@ -342,6 +342,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 @@ -2936,10 +2937,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 ===================================== @@ -11,6 +11,9 @@ module GHC.Linker.Deps ( LinkDepsOpts (..) , LinkDeps (..) , getLinkDeps + , Linkables (..) + , resolveLinkDeps + , selectLinkDeps ) where @@ -62,13 +65,6 @@ data LinkDepsOpts = LinkDepsOpts , ldGetDependencies :: !([Module] -> IO ([Module], UniqDSet UnitId)) } -data LinkDeps = LinkDeps - { ldNeededLinkables :: [Linkable] - , ldAllLinkables :: [LinkableUsage] - , ldUnits :: [UnitId] - , ldNeededUnits :: UniqDSet UnitId - } - -- | Find all the packages and linkables that a set of modules depends on -- -- Return the module and package dependencies for the needed modules. @@ -84,22 +80,20 @@ getLinkDeps -> [Module] -- If you need these -> IO LinkDeps -- ... then link these first getLinkDeps opts interp pls span mods = do - -- The interpreter and dynamic linker can only handle object code built - -- the "normal" way, i.e. no non-std ways like profiling or ticky-ticky. - -- So here we check the build tag: if we're building a non-standard way - -- then we need to find & link object files built the "normal" way. - maybe_normal_osuf <- checkNonStdWay opts interp span - - get_link_deps opts pls maybe_normal_osuf span mods + linkables <- resolveLinkDeps opts pls span mods + selectLinkDeps opts interp span linkables -get_link_deps +-- | Compute the transitive dependencies of the given modules and split them +-- into those that are already loaded and those that need to be linked. +-- +-- Returns @(loaded linkables, needed modules, needed units, all units)@. +resolveLinkDeps :: LinkDepsOpts -> LoaderState - -> Maybe FilePath -- replace object suffixes? -> SrcSpan -> [Module] - -> IO LinkDeps -get_link_deps opts pls maybe_normal_osuf span mods = do + -> IO ([LinkableUsage], [Module], [UnitId], UniqDSet UnitId) +resolveLinkDeps opts pls _span mods = do -- Three step process: @@ -120,6 +114,33 @@ get_link_deps opts pls maybe_normal_osuf span mods = do Just linkable -> Right linkable Nothing -> Left mod + pure (links_got, mods_needed, pkgs_needed, pkgs_s) + where + relevant_mods = filterOut isInteractiveModule mods + +-- | Find the linkables for the modules that need to be loaded, as determined +-- by 'resolveLinkDeps'. +selectLinkDeps + :: LinkDepsOpts + -> Interp + -> SrcSpan -- for error messages + -> ([LinkableUsage], [Module], [UnitId], UniqDSet UnitId) + -> IO LinkDeps -- ... then link these first +selectLinkDeps opts interp span linkables = do + -- The interpreter and dynamic linker can only handle object code built + -- the "normal" way, i.e. no non-std ways like profiling or ticky-ticky. + -- So here we check the build tag: if we're building a non-standard way + -- then we need to find & link object files built the "normal" way. + maybe_normal_osuf <- checkNonStdWay opts interp span + select_link_deps opts maybe_normal_osuf span linkables + +select_link_deps + :: LinkDepsOpts + -> Maybe FilePath -- replace object suffixes? + -> SrcSpan + -> ([LinkableUsage], [Module], [UnitId], UniqDSet UnitId) + -> IO LinkDeps +select_link_deps opts maybe_normal_osuf span (links_got, mods_needed, pkgs_needed, pkgs_s) = do -- 3. For each dependent module, find its linkable -- This will either be in the HPT or (in the case of one-shot -- compilation) we may need to use maybe_getFileLinkable @@ -139,7 +160,6 @@ get_link_deps opts pls maybe_normal_osuf span mods = do return link_deps where unit_env = ldUnitEnv opts - relevant_mods = filterOut isInteractiveModule mods no_obj :: Outputable a => a -> IO b no_obj mod = dieWith opts span $ ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -36,6 +36,7 @@ module GHC.Linker.Loader , initLinkDepsOpts , getGccSearchDirectory , mkDynLoadLib + , linkablesDefault ) where @@ -253,10 +254,10 @@ loadDependencies -> IO (LoaderState, SuccessFlag, [LinkableUsage], 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 = ldNeededUnits deps @@ -651,6 +652,18 @@ findWholeCoreBindings hsc_env mod = do sequence (lookupModuleEnv eps_iface_bytecode mod) +linkablesDefault :: + HscEnv -> + LoaderState -> + IO Linkables +linkablesDefault hsc_env pls = + pure Linkables { + linkablesResolve = resolveLinkDeps opts pls, + linkablesSelect = selectLinkDeps opts (hscInterp hsc_env) + } + where + opts = initLinkDepsOpts hsc_env + findBytecodeLinkableMaybe :: HscEnv -> ModLocation -> IO (Maybe Linkable) findBytecodeLinkableMaybe hsc_env locn = do let bytecode_fn = ml_bytecode_file locn ===================================== compiler/GHC/Linker/Types.hs ===================================== @@ -1,6 +1,8 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE GADTs #-} ----------------------------------------------------------------------------- -- @@ -78,6 +80,9 @@ module GHC.Linker.Types , mkLinkableUsage , ModuleByteCode(..) + , LinkDeps (..) + , Linkables (..) + , linkablesGet ) where @@ -95,6 +100,7 @@ import GHC.Stack.CCS import GHC.Types.Name.Env ( NameEnv, emptyNameEnv, extendNameEnvList, lookupNameEnv ) import GHC.Types.Name ( Name ) import GHC.Types.SptEntry +import GHC.Types.SrcLoc (SrcSpan) import GHC.Types.Unique.DSet import GHC.Types.Unique.DFM import GHC.Unit.Module.Deps (LinkablePartUsage (..), linkablePartUsageObjectPaths) @@ -693,3 +699,23 @@ instance Outputable LibrarySpec where ppr (DLLPath f) = text "DLLPath" <+> text f ppr (Framework s) = text "Framework" <+> text s ppr (BytecodeLibrary f) = text "BytecodeLibrary" <+> text f + +data LinkDeps = LinkDeps + { ldNeededLinkables :: [Linkable] + , ldAllLinkables :: [LinkableUsage] + , ldUnits :: [UnitId] + , ldNeededUnits :: UniqDSet UnitId + } + +-- | Customizable procedure for determining the linkables required by a set of +-- modules, split into a resolution phase and a selection phase with an +-- intermediate representation that is opaque to consumers. +data Linkables where + Linkables :: { + linkablesResolve :: SrcSpan -> [Module] -> IO a, + linkablesSelect :: SrcSpan -> a -> IO LinkDeps + } -> Linkables + +linkablesGet :: Linkables -> SrcSpan -> [Module] -> IO LinkDeps +linkablesGet Linkables {..} span mods = + linkablesSelect span =<< linkablesResolve span mods View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/373fc0f2bd7e13cf2edb012d46bf6125... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/373fc0f2bd7e13cf2edb012d46bf6125... 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