[Git][ghc/ghc][wip/torsten.schmits/oneshot-bytecode-pkgdeps] reimplement lookup avoidance
Torsten Schmits (@torsten.schmits)
gitlab at gitlab.haskell.org
Fri Jul 12 11:00:54 UTC 2024
Torsten Schmits pushed to branch wip/torsten.schmits/oneshot-bytecode-pkgdeps at Glasgow Haskell Compiler / GHC
Commits:
9cd5a0f7 by Torsten Schmits at 2024-07-12T13:00:40+02:00
reimplement lookup avoidance
- - - - -
3 changed files:
- compiler/GHC/Linker/Deps.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Unit/Finder.hs
Changes:
=====================================
compiler/GHC/Linker/Deps.hs
=====================================
@@ -6,6 +6,7 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
module GHC.Linker.Deps
( LinkDepsOpts (..)
@@ -82,8 +83,8 @@ data LinkDepsOpts = LinkDepsOpts
data LinkDeps = LinkDeps
{ ldNeededLinkables :: [Linkable]
, ldAllLinkables :: [Linkable]
- , ldUnits :: [UnitId]
- , ldNeededUnits :: UniqDSet UnitId
+ , ldNeededUnits :: [UnitId]
+ , ldAllUnits :: UniqDSet UnitId
}
-- | Find all the packages and linkables that a set of modules depends on
@@ -109,7 +110,6 @@ getLinkDeps opts interp pls span mods = do
get_link_deps opts pls maybe_normal_osuf span mods
-
get_link_deps
:: LinkDepsOpts
-> LoaderState
@@ -128,33 +128,24 @@ get_link_deps opts pls maybe_normal_osuf span mods = do
then oneshot_deps opts (filterOut isInteractiveModule mods)
else make_deps
- -- TODO this used to avoid some lookups, maybe we can move that to
- -- oneshot_deps now
- -- (mods_needed, links_got) = partitionWith split_mods mods_s
- --
- -- split_mods mod =
- -- let is_linked = lookupModuleEnv (objs_loaded pls) mod
- -- <|> lookupModuleEnv (bcos_loaded pls) mod
- -- in case is_linked of
- -- Just linkable -> Right linkable
- -- Nothing -> Left mod
-
- -- 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
- (lnks, pkgs_s) <- partitionWithM dep_linkable deps
- let
- lnks_needed = concat lnks
- pkgs_s' = mkUniqDSet pkgs_s
- pkgs_needed = eltsUDFM $ getUniqDSet pkgs_s' `minusUDFM` pkgs_loaded pls
-
- return $ LinkDeps
- { ldNeededLinkables = lnks_needed
- -- , ldAllLinkables = links_got ++ lnks_needed
- , ldAllLinkables = lnks_needed
- , ldUnits = pkgs_needed
- , ldNeededUnits = pkgs_s'
- }
+ -- 2. Exclude ones already linked
+ -- Main reason: avoid findModule calls in get_linkable
+ -- TODO outdated
+ let (loaded_modules, needed_modules, ldAllUnits, ldNeededUnits) =
+ classify_deps pls deps
+
+ -- 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
+ -- TODO outdated
+ ldNeededLinkables <- mapM module_linkable needed_modules
+
+ pure LinkDeps {
+ ldNeededLinkables,
+ ldAllLinkables = loaded_modules ++ ldNeededLinkables,
+ ldNeededUnits,
+ ldAllUnits
+ }
where
mod_graph = ldModuleGraph opts
unit_env = ldUnitEnv opts
@@ -217,11 +208,7 @@ get_link_deps opts pls maybe_normal_osuf span mods = do
while_linking_expr = text "while linking an interpreted expression"
- dep_linkable = \case
- LinkModules mods -> Left <$> mapM get_linkable (eltsUDFM mods)
- LinkLibrary uid -> pure (Right uid)
-
- get_linkable = \case
+ module_linkable = \case
LinkHomeModule hmi ->
pure (expectJust "getLinkDeps" (homeModLinkable hmi))
@@ -271,21 +258,27 @@ get_link_deps opts pls maybe_normal_osuf span mods = do
adjust_ul _ l at LoadedBCOs{} = return l
adjust_ul _ (CoreBindings (WholeCoreBindings _ mod _)) = pprPanic "Unhydrated core bindings" (ppr mod)
-data LinkObjectModule =
+data LinkModule =
LinkHomeModule HomeModInfo
|
LinkObjectModule ModIface ModLocation
|
LinkByteCodeModule ModIface WholeCoreBindings
-instance Outputable LinkObjectModule where
+link_module_iface :: LinkModule -> ModIface
+link_module_iface = \case
+ LinkHomeModule hmi -> hm_iface hmi
+ LinkObjectModule iface _ -> iface
+ LinkByteCodeModule iface _ -> iface
+
+instance Outputable LinkModule where
ppr = \case
LinkHomeModule hmi -> ppr (mi_module (hm_iface hmi)) <+> brackets (text "HMI")
LinkObjectModule iface _ -> ppr (mi_module iface)
LinkByteCodeModule _ wcb -> ppr (wcb_module wcb) <+> brackets (text "BC")
data LinkDep =
- LinkModules (UniqDFM ModuleName LinkObjectModule)
+ LinkModules (UniqDFM ModuleName LinkModule)
|
LinkLibrary UnitId
@@ -433,6 +426,33 @@ link_boot_mod_error mod =
text "module" <+> ppr mod <+>
text "cannot be linked; it is only available as a boot module"
+classify_deps ::
+ LoaderState ->
+ [LinkDep] ->
+ ([Linkable], [LinkModule], UniqDSet UnitId, [UnitId])
+classify_deps pls deps =
+ (loaded_modules, needed_modules, all_packages, needed_packages)
+ where
+ (loaded_modules, needed_modules) =
+ partitionWith loaded_or_needed (concatMap eltsUDFM modules)
+
+ needed_packages =
+ eltsUDFM (getUniqDSet all_packages `minusUDFM` pkgs_loaded pls)
+
+ all_packages = mkUniqDSet packages
+
+ (modules, packages) = flip partitionWith deps $ \case
+ LinkModules mods -> Left mods
+ LinkLibrary lib -> Right lib
+
+ loaded_or_needed lm =
+ maybe (Right lm) Left (loaded_linkable (mi_module (link_module_iface lm)))
+
+ loaded_linkable mod =
+ lookupModuleEnv (objs_loaded pls) mod
+ <|>
+ lookupModuleEnv (bcos_loaded pls) mod
+
{-
Note [Using Byte Code rather than Object Code for Template Haskell]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -230,10 +230,10 @@ loadDependencies interp hsc_env pls span needed_mods = do
-- Find what packages and linkables are required
deps <- getLinkDeps opts interp pls span needed_mods
- let this_pkgs_needed = ldNeededUnits deps
+ let this_pkgs_needed = ldAllUnits deps
-- Link the packages and modules required
- pls1 <- loadPackages' interp hsc_env (ldUnits deps) pls
+ pls1 <- loadPackages' interp hsc_env (ldNeededUnits deps) pls
(pls2, succ) <- loadModuleLinkables interp hsc_env pls1 (ldNeededLinkables deps)
let this_pkgs_loaded = udfmRestrictKeys all_pkgs_loaded $ getUniqDSet trans_pkgs_needed
all_pkgs_loaded = pkgs_loaded pls2
=====================================
compiler/GHC/Unit/Finder.hs
=====================================
@@ -748,7 +748,7 @@ mkStubPaths fopts mod location
stub_basename <.> os "h"
-- -----------------------------------------------------------------------------
--- findLinkable isn't related to the other stuff in here,
+-- findObjectLinkable isn't related to the other stuff in here,
-- but there's no other obvious place for it
findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9cd5a0f7b271ab9931e8b26703134a3c00c1b518
--
This project does not include diff previews in email notifications.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9cd5a0f7b271ab9931e8b26703134a3c00c1b518
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240712/cd4a6277/attachment-0001.html>
More information about the ghc-commits
mailing list