[Git][ghc/ghc][wip/romes/graph-compact-easy] 2 commits: revert to ue_unit_dbs
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Tue Jan 7 11:12:20 UTC 2025
Rodrigo Mesquita pushed to branch wip/romes/graph-compact-easy at Glasgow Haskell Compiler / GHC
Commits:
17d0a0c0 by Rodrigo Mesquita at 2025-01-07T10:36:08+00:00
revert to ue_unit_dbs
- - - - -
8c869d92 by Rodrigo Mesquita at 2025-01-07T10:41:32+00:00
cleanup
- - - - -
5 changed files:
- compiler/GHC/Core/Opt/Pipeline.hs
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/Env.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Unit/Env.hs
Changes:
=====================================
compiler/GHC/Core/Opt/Pipeline.hs
=====================================
@@ -98,7 +98,7 @@ core2core hsc_env guts@(ModGuts { mg_module = mod
dflags = hsc_dflags hsc_env
logger = hsc_logger hsc_env
extra_vars = interactiveInScope (hsc_IC hsc_env)
- home_pkg_rules = rulesBelow hsc_env (moduleUnitId mod)
+ home_pkg_rules = hugRulesBelow hsc_env (moduleUnitId mod)
(GWIB { gwib_mod = moduleName mod, gwib_isBoot = NotBoot })
name_ppr_ctx = mkNamePprCtx ptc (hsc_unit_env hsc_env) rdr_env
ptc = initPromotionTickContext dflags
=====================================
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 ue_homeUnitDbs old_unit_env of
+ newdbs <- case ue_unit_dbs old_unit_env of
Nothing -> panic "addUnit: called too early"
Just dbs ->
let newdb = UnitDatabase
=====================================
compiler/GHC/Driver/Env.hs
=====================================
@@ -29,9 +29,9 @@ module GHC.Driver.Env
, lookupIfaceByModule
, mainModIs
- , rulesBelow
- , instancesBelow
- , annsBelow
+ , hugRulesBelow
+ , hugInstancesBelow
+ , hugAnnsBelow
-- * Legacy API
, hscUpdateHPT
@@ -210,46 +210,9 @@ configured via command-line flags (in `GHC.setSessionDynFlags`).
hscEPS :: HscEnv -> IO ExternalPackageState
hscEPS hsc_env = readIORef (euc_eps (ue_eps (hsc_unit_env hsc_env)))
-
---------------------------------------------------------------------------------
--- TODO
---------------------------------------------------------------------------------
--- WE MAY WANT TO CACHE SOME OF THESE AS WE BUILD UP THE HPT, to make these
--- queries O(1). But it's kind of hard because they wouldn't be rehydrated!!!!!
--- Then we'd have the HPT itself rehydrated, but the cached fields with
--- bad references.
-
--- | Get annotations from all modules "below" this one (in the dependency
--- sense) within the home units. If the module is @Nothing@, returns /all/
--- annotations in the home units.
-annsBelow :: HscEnv -> UnitId -> ModuleNameWithIsBoot -> IO AnnEnv
-annsBelow hsc_env uid mn = hugAnnsBelow hsc_env uid mn
-
----- | Get rules from modules "below" this one (in the dependency sense) within
---the home units.
-rulesBelow :: HscEnv -> UnitId -> ModuleNameWithIsBoot -> IO RuleBase
-rulesBelow hsc_env uid mn = hugRulesBelow hsc_env uid mn
-
--- | Find instances visible from the given set of imports
-instancesBelow :: HscEnv -> UnitId -> ModuleNameWithIsBoot -> IO (InstEnv, [FamInst])
-instancesBelow hsc_env uid mn = hugInstancesBelow hsc_env uid mn
-
--------------------------------------------------------------------------------
-- * Queries on Transitive Closure
--------------------------------------------------------------------------------
--- ROMES:TODO: Something else I want to do here is to receive a ModuleGraph and
--- then use the fast reachability queries to determine whether something is
--- reachable or not. That means we can very efficiently filter out things which
--- are not part of the transitive closure...
---
--- So, e.g. it could probably be done faster by filtering out a cached list of
--- rules using a 'ReachabilityIndex' as the filter $O(1)$ fast queries.
-
--- ROMES:TODO: Do something about the
---
--- | isOneShot (ghcMode (hsc_dflags hsc_env)) = []
---
--- shortcut that we used when this was a function on HscEnv...
-- | Find all rules in modules that are in the transitive closure of the given
-- module.
@@ -259,13 +222,16 @@ hugRulesBelow :: HscEnv -> UnitId -> ModuleNameWithIsBoot -> IO RuleBase
hugRulesBelow hsc uid mn = foldr (flip extendRuleBaseList) emptyRuleBase <$>
hugSomeThingsBelowUs (md_rules . hm_details) False hsc uid mn
--- | Get annotations from modules "below" this one (in the dependency sense)
+-- | Get annotations from all modules "below" this one (in the dependency
+-- sense) within the home units. If the module is @Nothing@, returns /all/
+-- annotations in the home units.
--
-- $O(n)$ in the number of dependencies?
hugAnnsBelow :: HscEnv -> UnitId -> ModuleNameWithIsBoot -> IO AnnEnv
hugAnnsBelow hsc uid mn = foldr (flip extendAnnEnvList) emptyAnnEnv <$>
hugSomeThingsBelowUs (md_anns . hm_details) False hsc uid mn
+-- | Find instances visible from the given set of imports
hugInstancesBelow :: HscEnv -> UnitId -> ModuleNameWithIsBoot -> IO (InstEnv, [FamInst])
hugInstancesBelow hsc_env uid mnwib = do
-- ouch... improve
=====================================
compiler/GHC/Tc/Module.hs
=====================================
@@ -462,7 +462,7 @@ tcRnImports hsc_env import_decls
-- modules batch (@--make@) compiled before this one, but
-- which are not below this one.
; (home_insts, home_fam_insts) <- liftIO $
- instancesBelow hsc_env unitId mnwib
+ hugInstancesBelow hsc_env unitId mnwib
-- Record boot-file info in the EPS, so that it's
-- visible to loadHiBootInterface in tcRnSrcDecls,
=====================================
compiler/GHC/Unit/Env.hs
=====================================
@@ -82,7 +82,7 @@ module GHC.Unit.Env
-- ** Queries on the current active home unit
, ue_homeUnitState
- , ue_homeUnitDbs
+ , ue_unit_dbs
, ue_homeUnit
, ue_unitFlags
@@ -262,8 +262,8 @@ ue_findHomeUnitEnv uid e = case HUG.lookupHugUnit uid (ue_home_unit_graph e) of
ue_homeUnitState :: HasDebugCallStack => UnitEnv -> UnitState
ue_homeUnitState = HUG.homeUnitEnv_units . ue_currentHomeUnitEnv
-ue_homeUnitDbs :: UnitEnv -> Maybe [UnitDatabase UnitId]
-ue_homeUnitDbs = HUG.homeUnitEnv_unit_dbs . ue_currentHomeUnitEnv
+ue_unit_dbs :: UnitEnv -> Maybe [UnitDatabase UnitId]
+ue_unit_dbs = HUG.homeUnitEnv_unit_dbs . ue_currentHomeUnitEnv
-- -------------------------------------------------------
-- Query and modify Home Package Table in HomeUnitEnv
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e54108f24510e90f9a054c0e92a1ab2fceae538d...8c869d9278b091ca0bdc15104cd00c39f17ab23b
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e54108f24510e90f9a054c0e92a1ab2fceae538d...8c869d9278b091ca0bdc15104cd00c39f17ab23b
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/20250107/db2b37dc/attachment-0001.html>
More information about the ghc-commits
mailing list