[Git][ghc/ghc][wip/romes/graph-compact-easy] 2 commits: Drop outdated note
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Fri Jan 3 17:54:07 UTC 2025
Rodrigo Mesquita pushed to branch wip/romes/graph-compact-easy at Glasgow Haskell Compiler / GHC
Commits:
7a3cc49c by Rodrigo Mesquita at 2025-01-03T16:27:14+00:00
Drop outdated note
- - - - -
63b6ebb5 by Rodrigo Mesquita at 2025-01-03T17:53:53+00:00
Rename UnitEnv functions with ue_
- - - - -
18 changed files:
- compiler/GHC.hs
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/Env.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Iface/Errors.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Linker/Deps.hs
- compiler/GHC/Linker/ExtraObj.hs
- compiler/GHC/Linker/Static.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Runtime/Interpreter/JS.hs
- compiler/GHC/Runtime/Loader.hs
- compiler/GHC/StgToJS/Linker/Linker.hs
- compiler/GHC/SysTools/Cpp.hs
- compiler/GHC/Types/Name/Ppr.hs
- compiler/GHC/Unit/Env.hs
- compiler/GHC/Unit/Finder.hs
Changes:
=====================================
compiler/GHC.hs
=====================================
@@ -734,7 +734,7 @@ setTopSessionDynFlags dflags = do
wasmInterpTargetPlatform = targetPlatform dflags,
wasmInterpProfiled = profiled,
wasmInterpHsSoSuffix = way_tag ++ dynLibSuffix (ghcNameVersion dflags),
- wasmInterpUnitState = homeUnitState $ hsc_unit_env hsc_env
+ wasmInterpUnitState = ue_homeUnitState $ hsc_unit_env hsc_env
}
pure $ Just $ Interp (ExternalInterp $ ExtWasm $ ExtInterpState cfg s) loader lookup_cache
@@ -822,7 +822,7 @@ setProgramDynFlags_ invalidate_needed dflags = do
if changed
then do
-- additionally, set checked dflags so we don't lose fixes
- old_unit_env <- UnitEnv.setFlags dflags0 . hsc_unit_env <$> getSession
+ old_unit_env <- ue_setFlags dflags0 . hsc_unit_env <$> getSession
home_unit_graph <- forM (ue_home_unit_graph old_unit_env) $ \homeUnitEnv -> do
let cached_unit_dbs = homeUnitEnv_unit_dbs homeUnitEnv
=====================================
compiler/GHC/Driver/Backpack.hs
=====================================
@@ -433,7 +433,7 @@ addUnit u = do
logger <- getLogger
let dflags0 = hsc_dflags hsc_env
let old_unit_env = hsc_unit_env hsc_env
- newdbs <- case homeUnitDbs old_unit_env of
+ newdbs <- case ue_homeUnitDbs old_unit_env of
Nothing -> panic "addUnit: called too early"
Just dbs ->
let newdb = UnitDatabase
=====================================
compiler/GHC/Driver/Env.hs
=====================================
@@ -113,10 +113,10 @@ hsc_home_unit :: HscEnv -> HomeUnit
hsc_home_unit = unsafeGetHomeUnit . hsc_unit_env
hsc_home_unit_maybe :: HscEnv -> Maybe HomeUnit
-hsc_home_unit_maybe = homeUnit . hsc_unit_env
+hsc_home_unit_maybe = ue_homeUnit . hsc_unit_env
hsc_units :: HasDebugCallStack => HscEnv -> UnitState
-hsc_units = homeUnitState . hsc_unit_env
+hsc_units = ue_homeUnitState . hsc_unit_env
hsc_HPT :: HscEnv -> HomePackageTable
hsc_HPT = ue_hpt . hsc_unit_env
@@ -421,7 +421,7 @@ hscUpdateFlags f h = hscSetFlags (f (hsc_dflags h)) h
hscSetFlags :: HasDebugCallStack => DynFlags -> HscEnv -> HscEnv
hscSetFlags dflags h =
hscUpdateLoggerFlags $ h { hsc_dflags = dflags
- , hsc_unit_env = setFlags dflags (hsc_unit_env h) }
+ , hsc_unit_env = ue_setFlags dflags (hsc_unit_env h) }
-- See Note [Multiple Home Units]
hscSetActiveHomeUnit :: HasDebugCallStack => HomeUnit -> HscEnv -> HscEnv
@@ -430,7 +430,7 @@ hscSetActiveHomeUnit home_unit = hscSetActiveUnitId (homeUnitId home_unit)
hscSetActiveUnitId :: HasDebugCallStack => UnitId -> HscEnv -> HscEnv
hscSetActiveUnitId uid e = e
{ hsc_unit_env = ue_setActiveUnit uid (hsc_unit_env e)
- , hsc_dflags = UnitEnv.unitFlags uid (hsc_unit_env e) }
+ , hsc_dflags = ue_unitFlags uid (hsc_unit_env e) }
hscActiveUnitId :: HscEnv -> UnitId
hscActiveUnitId e = ue_currentUnit (hsc_unit_env e)
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -1898,7 +1898,7 @@ enableCodeGenWhen
enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = do
mgMapM enable_code_gen mg
where
- defaultBackendOf ms = platformDefaultBackend (targetPlatform $ unitFlags (ms_unitid ms) unit_env)
+ defaultBackendOf ms = platformDefaultBackend (targetPlatform $ ue_unitFlags (ms_unitid ms) unit_env)
enable_code_gen :: ModSummary -> IO ModSummary
enable_code_gen ms
| ModSummary
@@ -2848,39 +2848,6 @@ executeLinkNode hug kn uid deps = do
Failed -> fail "Link Failed"
Succeeded -> return ()
-{-
-Note [ModuleNameSet, efficiency and space leaks]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-During upsweep, the results of compiling modules are placed into a MVar. When we need
-to compute the right compilation environment for a module, we consult this MVar and
-set the HomeUnitGraph accordingly. This is done to avoid having to precisely track
-module dependencies and recreating the HUG from scratch each time, which is very expensive.
-
-In serial mode (-j1), this all works out fine: a module can only be compiled
-after its dependencies have finished compiling, and compilation can't be
-interleaved with the compilation of other module loops. This ensures that
-the HUG only ever contains finalised interfaces.
-
-In parallel mode, we have to be more careful: the HUG variable can contain non-finalised
-interfaces, which have been started by another thread. In order to avoid a space leak
-in which a finalised interface is compiled against a HPT which contains a non-finalised
-interface, we have to restrict the HUG to only contain the visible modules.
-
-The collection of visible modules explains which transitive modules are visible
-from a certain point. It is recorded in the ModuleNameSet.
-Before a module is compiled, we use this set to restrict the HUG to the visible
-modules only, avoiding this tricky space leak.
-
-Efficiency of the ModuleNameSet is of utmost importance, because a union occurs for
-each edge in the module graph. To achieve this, the set is represented directly as an IntSet,
-which provides suitable performance – even using a UniqSet (which is backed by an IntMap) is
-too slow. The crucial test of performance here is the time taken to a do a no-op build in --make mode.
-
-See test "jspace" for an example which used to trigger this problem.
-
--}
-
-- | Wait for dependencies to finish, and then return their results.
wait_deps :: [BuildResult] -> RunMakeM [HomeModInfo]
wait_deps [] = return []
@@ -3073,6 +3040,4 @@ which can be checked easily using ghc-debug.
5. At the end of a successful upsweep, the number of live ModDetails equals the
number of non-boot Modules.
Why? Each module has a HomeModInfo which contains a ModDetails from that module.
- Where? See Note [ModuleNameSet, efficiency and space leaks], a variety of places
- in the driver are responsible.
-}
=====================================
compiler/GHC/Driver/Pipeline.hs
=====================================
@@ -469,7 +469,7 @@ linkingNeeded logger dflags unit_env staticLink linkables pkg_deps = do
-- modification times on all of the objects and libraries, then omit
-- linking (unless the -fforce-recomp flag was given).
let platform = ue_platform unit_env
- unit_state = homeUnitState unit_env
+ unit_state = ue_homeUnitState unit_env
arch_os = platformArchOS platform
exe_file = exeFileName arch_os staticLink (outputFile_ dflags)
e_exe_time <- tryIO $ getModificationUTCTime exe_file
=====================================
compiler/GHC/Iface/Errors.hs
=====================================
@@ -87,7 +87,7 @@ cannotFindModule hsc_env = cannotFindModule'
cannotFindModule' :: UnitEnv -> Profile -> ModuleName -> FindResult
-> MissingInterfaceError
cannotFindModule' unit_env profile mod res =
- CantFindErr (homeUnitState unit_env) FindingModule $
+ CantFindErr (ue_homeUnitState unit_env) FindingModule $
cantFindErr unit_env
profile
mod
@@ -105,7 +105,7 @@ cantFindErr _ _ mod_name (FoundMultiple mods)
cantFindErr unit_env profile mod_name find_result
= CantFindInstalled mod_name more_info
where
- mhome_unit = homeUnit unit_env
+ mhome_unit = ue_homeUnit unit_env
more_info
= case find_result of
NoPackage pkg
@@ -131,7 +131,7 @@ cantFindErr unit_env profile mod_name find_result
| otherwise
-> GenericMissing
- (map ((\uid -> (uid, lookupUnit (homeUnitState unit_env) uid))) pkg_hiddens)
+ (map ((\uid -> (uid, lookupUnit (ue_homeUnitState unit_env) uid))) pkg_hiddens)
mod_hiddens unusables files
_ -> panic "cantFindErr"
=====================================
compiler/GHC/Iface/Load.hs
=====================================
@@ -445,7 +445,7 @@ loadInterface doc_str mod from
-- Check whether we have the interface already
; hsc_env <- getTopEnv
- ; let mhome_unit = homeUnit (hsc_unit_env hsc_env)
+ ; let mhome_unit = ue_homeUnit (hsc_unit_env hsc_env)
; liftIO (lookupIfaceByModule hug (eps_PIT eps) mod) >>= \case {
Just iface
-> return (Succeeded iface) ; -- Already loaded
=====================================
compiler/GHC/Linker/Deps.hs
=====================================
@@ -228,15 +228,15 @@ get_link_deps opts pls maybe_normal_osuf span mods = do
(_, GWIB m IsBoot) -> Left m
(_, GWIB m NotBoot) -> Right m
- mod_deps' = case homeUnit unit_env of
+ mod_deps' = case ue_homeUnit unit_env of
Nothing -> []
Just home_unit -> filter (not . (`elementOfUniqDSet` acc_mods)) (map (mkHomeModule home_unit) $ (boot_deps ++ mod_deps))
- acc_mods' = case homeUnit unit_env of
+ acc_mods' = case ue_homeUnit unit_env of
Nothing -> acc_mods
Just home_unit -> addListToUniqDSet acc_mods (mod : map (mkHomeModule home_unit) mod_deps)
acc_pkgs' = addListToUniqDSet acc_pkgs (Set.toList pkg_deps)
- case homeUnit unit_env of
+ case ue_homeUnit unit_env of
Just home_unit | isHomeUnit home_unit pkg -> follow_deps (mod_deps' ++ mods)
acc_mods' acc_pkgs'
_ -> follow_deps mods acc_mods (addOneToUniqDSet acc_pkgs' (toUnitId pkg))
@@ -273,7 +273,7 @@ get_link_deps opts pls maybe_normal_osuf span mods = do
Nothing -> do
-- It's not in the HPT because we are in one shot mode,
-- so use the Finder to get a ModLocation...
- case homeUnit unit_env of
+ case ue_homeUnit unit_env of
Nothing -> no_obj mod
Just home_unit -> do
from_bc <- ldLoadByteCode opts mod
=====================================
compiler/GHC/Linker/ExtraObj.hs
=====================================
@@ -159,7 +159,7 @@ mkNoteObjsToLinkIntoBinary logger tmpfs dflags unit_env dep_packages = do
else return []
where
- unit_state = homeUnitState unit_env
+ unit_state = ue_homeUnitState unit_env
platform = ue_platform unit_env
link_opts info = hcat
[ -- "link info" section (see Note [LinkInfo section])
=====================================
compiler/GHC/Linker/Static.hs
=====================================
@@ -71,7 +71,7 @@ linkBinary = linkBinary' False
linkBinary' :: Bool -> Logger -> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
linkBinary' staticLink logger tmpfs dflags unit_env o_files dep_units = do
let platform = ue_platform unit_env
- unit_state = homeUnitState unit_env
+ unit_state = ue_homeUnitState unit_env
toolSettings' = toolSettings dflags
verbFlags = getVerbFlags dflags
arch_os = platformArchOS platform
=====================================
compiler/GHC/Rename/Names.hs
=====================================
@@ -452,14 +452,14 @@ renamePkgQual :: UnitEnv -> ModuleName -> Maybe FastString -> PkgQual
renamePkgQual unit_env mn mb_pkg = case mb_pkg of
Nothing -> NoPkgQual
Just pkg_fs
- | Just uid <- homeUnitId <$> homeUnit unit_env
+ | Just uid <- homeUnitId <$> ue_homeUnit unit_env
, pkg_fs == fsLit "this"
-> ThisPkg uid
| Just (uid, _) <- find (fromMaybe False . fmap (== pkg_fs) . snd) home_names
-> ThisPkg uid
- | Just uid <- resolvePackageImport units mn (PackageName pkg_fs)
+ | Just uid <- resolvePackageImport unit_state mn (PackageName pkg_fs)
-> OtherPkg uid
| otherwise
@@ -469,10 +469,10 @@ renamePkgQual unit_env mn mb_pkg = case mb_pkg of
where
home_names = map (\uid -> (uid, mkFastString <$> thisPackageName (homeUnitEnv_dflags (ue_findHomeUnitEnv uid unit_env)))) hpt_deps
- units = homeUnitState unit_env
+ unit_state = ue_homeUnitState unit_env
hpt_deps :: [UnitId]
- hpt_deps = homeUnitDepends units
+ hpt_deps = homeUnitDepends unit_state
-- | Calculate the 'ImportAvails' induced by an import of a particular
=====================================
compiler/GHC/Runtime/Interpreter/JS.hs
=====================================
@@ -166,7 +166,7 @@ spawnJSInterp cfg = do
-- get the unit-id of the ghci package. We need this to load the
-- interpreter code.
- ghci_unit_id <- case lookupPackageName (homeUnitState unit_env) (PackageName (fsLit "ghci")) of
+ ghci_unit_id <- case lookupPackageName (ue_homeUnitState unit_env) (PackageName (fsLit "ghci")) of
Nothing -> cmdLineErrorIO "JS interpreter: couldn't find \"ghci\" package"
Just i -> pure i
@@ -265,7 +265,7 @@ jsLinkInterp logger tmpfs tmp_dir cfg unit_env inst = do
let ghci_unit_id = instGhciUnitId (instExtra inst)
-- compute unit dependencies of ghc_unit_id
- let unit_map = unitInfoMap (homeUnitState unit_env)
+ let unit_map = unitInfoMap (ue_homeUnitState unit_env)
dep_units <- mayThrowUnitErr $ closeUnitDeps unit_map [(ghci_unit_id,Nothing)]
let units = dep_units ++ [ghci_unit_id]
@@ -304,7 +304,7 @@ jsLinkObjects logger tmpfs tmp_dir cfg unit_env inst objs is_root = do
, lcLinkCsources = True -- enable C sources, if any
}
- let units = preloadUnits (homeUnitState unit_env)
+ let units = preloadUnits (ue_homeUnitState unit_env)
-- compute dependencies
let link_spec = LinkSpec
=====================================
compiler/GHC/Runtime/Loader.hs
=====================================
@@ -215,7 +215,7 @@ loadPlugin' occ_name plugin_name hsc_env mod_name
; case eith_plugin of
Left actual_type ->
throwGhcExceptionIO (CmdLineError $
- showSDocForUser dflags (homeUnitState (hsc_unit_env hsc_env))
+ showSDocForUser dflags (ue_homeUnitState (hsc_unit_env hsc_env))
alwaysQualify $ hsep
[ text "The value", ppr name
, text "with type", ppr actual_type
@@ -346,7 +346,7 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
let fopts = initFinderOpts dflags
let fc = hsc_FC hsc_env
let unit_env = hsc_unit_env hsc_env
- let unit_state = homeUnitState unit_env
+ let unit_state = ue_homeUnitState unit_env
let mhome_unit = hsc_home_unit_maybe hsc_env
-- First find the unit the module resides in by searching exposed units and home modules
found_module <- findPluginModule fc fopts unit_state mhome_unit mod_name
=====================================
compiler/GHC/StgToJS/Linker/Linker.hs
=====================================
@@ -486,7 +486,7 @@ computeLinkDependencies cfg unit_env link_spec finder_opts finder_cache ar_cache
Nothing ->
-- It's not in the HPT because we are in one shot mode,
-- so use the Finder to get a ModLocation...
- case homeUnit unit_env of
+ case ue_homeUnit unit_env of
Nothing -> pprPanic "getDeps: No home-unit: " (pprModule mod)
Just home_unit -> do
mb_stuff <- findHomeModule finder_cache finder_opts home_unit (moduleName mod)
@@ -670,7 +670,7 @@ getPackageArchives cfg unit_env units =
, l <- getInstalledPackageHsLibs ue_state u
]
where
- ue_state = homeUnitState unit_env
+ ue_state = ue_homeUnitState unit_env
-- XXX the profiling library name is probably wrong now
profSuff | csProf cfg = "_p"
=====================================
compiler/GHC/SysTools/Cpp.hs
=====================================
@@ -113,7 +113,7 @@ doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> CppOpts -> FilePath -> FilePa
doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do
let hscpp_opts = picPOpts dflags
let cmdline_include_paths = offsetIncludePaths dflags (includePaths dflags)
- let unit_state = homeUnitState unit_env
+ let unit_state = ue_homeUnitState unit_env
pkg_include_dirs <- mayThrowUnitErr
(collectIncludeDirs <$> preloadUnitsInfo unit_env)
-- MP: This is not quite right, the headers which are supposed to be installed in
@@ -121,7 +121,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do
-- enough approximation for things to work. A proper solution would be to have to declare which paths should
-- be propagated to dependent packages.
let home_pkg_deps =
- [homeUnitEnv_dflags . ue_findHomeUnitEnv uid $ unit_env | uid <- UnitEnv.transitiveHomeDeps (ue_currentUnit unit_env) unit_env]
+ [homeUnitEnv_dflags . ue_findHomeUnitEnv uid $ unit_env | uid <- ue_transitiveHomeDeps (ue_currentUnit unit_env) unit_env]
dep_pkg_extra_inputs = [offsetIncludePaths fs (includePaths fs) | fs <- home_pkg_deps]
let include_paths_global = foldr (\ x xs -> ("-I" ++ x) : xs) []
@@ -274,7 +274,7 @@ getGhcVersionPathName dflags unit_env = do
-- use a wrong file. See #25106 where a globally installed
-- /usr/include/ghcversion.h file was used instead of the one provided
-- by the rts.
- Nothing -> case lookupUnitId (homeUnitState unit_env) rtsUnitId of
+ Nothing -> case lookupUnitId (ue_homeUnitState unit_env) rtsUnitId of
Nothing -> []
Just info -> (</> "ghcversion.h") <$> collectIncludeDirs [info]
=====================================
compiler/GHC/Types/Name/Ppr.hs
=====================================
@@ -76,8 +76,8 @@ mkNamePprCtx ptc unit_env env
(mkQualPackage unit_state)
(mkPromTick ptc env)
where
- unit_state = homeUnitState unit_env
- home_unit = homeUnit unit_env
+ unit_state = ue_homeUnitState unit_env
+ home_unit = ue_homeUnit unit_env
mkQualName :: Outputable info => GlobalRdrEnvX info -> QueryQualifyName
mkQualName env = qual_name where
=====================================
compiler/GHC/Unit/Env.hs
=====================================
@@ -10,11 +10,11 @@
--
-- Querying...
--
--- This module is meant to be imported qualified as @UnitEnv@:
+-- This module is meant to be imported as @UnitEnv@ when calling @insertHpt@:
--
-- @
-- import GHC.Unit.Env (UnitEnv, HomeUnitGraph, HomeUnitEnv)
--- import qualified GHC.Unit.Env as UnitEnv
+-- import GHC.Unit.Env as UnitEnv
-- @
--
-- Here is an overview of how the UnitEnv, ModuleGraph, HUG, HPT, and EPS interact:
@@ -75,18 +75,18 @@ module GHC.Unit.Env
-- ** Modifying the current active home unit
, insertHpt
- , setFlags
+ , ue_setFlags
-- * Queries
-- ** Queries on the current active home unit
- , homeUnitState
- , homeUnitDbs
- , homeUnit
- , unitFlags
+ , ue_homeUnitState
+ , ue_homeUnitDbs
+ , ue_homeUnit
+ , ue_unitFlags
-- ** Reachability
- , transitiveHomeDeps
+ , ue_transitiveHomeDeps
--------------------------------------------------------------------------------
-- Harder queries for the whole UnitEnv
@@ -217,7 +217,7 @@ preloadUnitsInfo' unit_env ids0 = all_infos
where
unit_state = HUG.homeUnitEnv_units (ue_currentHomeUnitEnv unit_env)
ids = ids0 ++ inst_ids
- inst_ids = case homeUnit unit_env of
+ inst_ids = case ue_homeUnit unit_env of
Nothing -> []
Just home_unit
-- An indefinite package will have insts to HOLE,
@@ -258,11 +258,11 @@ ue_findHomeUnitEnv uid e = case HUG.lookupHugUnit uid (ue_home_unit_graph e) of
-- Query and modify UnitState of active unit in HomeUnitEnv
-- -------------------------------------------------------
-homeUnitState :: HasDebugCallStack => UnitEnv -> UnitState
-homeUnitState = HUG.homeUnitEnv_units . ue_currentHomeUnitEnv
+ue_homeUnitState :: HasDebugCallStack => UnitEnv -> UnitState
+ue_homeUnitState = HUG.homeUnitEnv_units . ue_currentHomeUnitEnv
-homeUnitDbs :: UnitEnv -> Maybe [UnitDatabase UnitId]
-homeUnitDbs = HUG.homeUnitEnv_unit_dbs . ue_currentHomeUnitEnv
+ue_homeUnitDbs :: UnitEnv -> Maybe [UnitDatabase UnitId]
+ue_homeUnitDbs = HUG.homeUnitEnv_unit_dbs . ue_currentHomeUnitEnv
-- -------------------------------------------------------
-- Query and modify Home Package Table in HomeUnitEnv
@@ -288,12 +288,12 @@ ue_updateUnitHUG f ue_env = ue_env { ue_home_unit_graph = f (ue_home_unit_graph
-- Query and modify DynFlags in HomeUnitEnv
-- -------------------------------------------------------
-unitFlags :: HasDebugCallStack => UnitId -> UnitEnv -> DynFlags
-unitFlags uid ue_env = HUG.homeUnitEnv_dflags $ ue_findHomeUnitEnv uid ue_env
+ue_unitFlags :: HasDebugCallStack => UnitId -> UnitEnv -> DynFlags
+ue_unitFlags uid ue_env = HUG.homeUnitEnv_dflags $ ue_findHomeUnitEnv uid ue_env
-- | Sets the 'DynFlags' of the /current unit/ being compiled to the given ones
-setFlags :: HasDebugCallStack => DynFlags -> UnitEnv -> UnitEnv
-setFlags dflags env =
+ue_setFlags :: HasDebugCallStack => DynFlags -> UnitEnv -> UnitEnv
+ue_setFlags dflags env =
env
{ ue_home_unit_graph = HUG.updateUnitFlags
(ue_currentUnit env)
@@ -305,11 +305,11 @@ setFlags dflags env =
-- Query and modify home units in HomeUnitEnv
-- -------------------------------------------------------
-homeUnit :: UnitEnv -> Maybe HomeUnit
-homeUnit = HUG.homeUnitEnv_home_unit . ue_currentHomeUnitEnv
+ue_homeUnit :: UnitEnv -> Maybe HomeUnit
+ue_homeUnit = HUG.homeUnitEnv_home_unit . ue_currentHomeUnitEnv
ue_unsafeHomeUnit :: UnitEnv -> HomeUnit
-ue_unsafeHomeUnit ue = case homeUnit ue of
+ue_unsafeHomeUnit ue = case ue_homeUnit ue of
Nothing -> panic "unsafeGetHomeUnit: No home unit"
Just h -> h
@@ -375,8 +375,8 @@ renameUnitId oldUnit newUnit unitEnv =
-- Transitive closure
-- ---------------------------------------------
-transitiveHomeDeps :: UnitId -> UnitEnv -> [UnitId]
-transitiveHomeDeps uid e =
+ue_transitiveHomeDeps :: UnitId -> UnitEnv -> [UnitId]
+ue_transitiveHomeDeps uid e =
case HUG.transitiveHomeDeps uid (ue_home_unit_graph e) of
Nothing -> pprPanic "Unit unknown to the internal unit environment"
$ text "unit (" <> ppr uid <> text ")"
@@ -461,7 +461,7 @@ in order to allow users to offset their own relative paths.
-- * Legacy API
--------------------------------------------------------------------------------
-{-# DEPRECATED ue_units "Renamed to homeUnitState" #-}
+{-# DEPRECATED ue_units "Renamed to ue_homeUnitState because of confusion between units(tate) and unit(s) plural" #-}
ue_units :: HasDebugCallStack => UnitEnv -> UnitState
-ue_units = homeUnitState
+ue_units = ue_homeUnitState
=====================================
compiler/GHC/Unit/Finder.hs
=====================================
@@ -215,7 +215,7 @@ findImportedModuleNoHsc fc fopts ue mhome_unit mod_name mb_pkg =
findExposedPackageModule fc fopts units mod_name NoPkgQual
units = case mhome_unit of
- Nothing -> homeUnitState ue
+ Nothing -> ue_homeUnitState ue
Just home_unit -> HUG.homeUnitEnv_units $ ue_findHomeUnitEnv (homeUnitId home_unit) ue
hpt_deps :: [UnitId]
hpt_deps = homeUnitDepends units
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4d40680b3a75ff89a8496a4d429dfdbc34ad029e...63b6ebb568afc829f495ce5be5759a7a40ffb6ce
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4d40680b3a75ff89a8496a4d429dfdbc34ad029e...63b6ebb568afc829f495ce5be5759a7a40ffb6ce
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/20250103/ef6c42d6/attachment-0001.html>
More information about the ghc-commits
mailing list