[Git][ghc/ghc][wip/romes/graph-compact-easy] 2 commits: Revert mapMG renaming
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Thu Dec 12 12:30:51 UTC 2024
Rodrigo Mesquita pushed to branch wip/romes/graph-compact-easy at Glasgow Haskell Compiler / GHC
Commits:
1ea72649 by Rodrigo Mesquita at 2024-12-12T12:30:42+00:00
Revert mapMG renaming
We had previously renamed this function for consistency, but that caused unnecessary breakage
- - - - -
bfba5d6c by Rodrigo Mesquita at 2024-12-12T12:30:42+00:00
Tweaks
- - - - -
5 changed files:
- compiler/GHC.hs
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Unit/Home/PackageTable.hs
- compiler/GHC/Unit/Module/Graph.hs
- compiler/GHC/Unit/Module/Status.hs
Changes:
=====================================
compiler/GHC.hs
=====================================
@@ -75,7 +75,7 @@ module GHC (
compileToCoreModule, compileToCoreSimplified,
-- * Inspecting the module structure of the program
- ModuleGraph, emptyMG, mgMap, mkModuleGraph, mgModSummaries,
+ ModuleGraph, emptyMG, mapMG, mkModuleGraph, mgModSummaries,
mgLookupModule,
ModSummary(..), ms_mod_name, ModLocation(..),
pattern ModLocation,
@@ -879,7 +879,7 @@ setProgramDynFlags_ invalidate_needed dflags = do
--
invalidateModSummaryCache :: GhcMonad m => m ()
invalidateModSummaryCache =
- modifySession $ \h -> h { hsc_mod_graph = mgMap inval (hsc_mod_graph h) }
+ modifySession $ \h -> h { hsc_mod_graph = mapMG inval (hsc_mod_graph h) }
where
inval ms = ms { ms_hs_hash = fingerprint0 }
=====================================
compiler/GHC/Driver/Backpack.hs
=====================================
@@ -91,6 +91,7 @@ import qualified Data.Map as Map
import qualified Data.Set as Set
import GHC.Types.Error (mkUnknownDiagnostic)
import qualified GHC.Unit.Home.Graph as HUG
+import GHC.Unit.Home.ModInfo
import GHC.Unit.Home.PackageTable
-- | Entry point to compile a Backpack file.
@@ -342,18 +343,17 @@ buildUnit session cid insts lunit = do
-- Compile relevant only
hsc_env <- getSession
- linkables <- liftIO $ hptCollectObjects (hsc_HPT hsc_env)
+ let takeLinkables x
+ | mi_hsc_src (hm_iface x) == HsSrcFile
+ = [Just $ expectJust "bkp link" $ homeModInfoObject x]
+ | otherwise
+ = [Nothing]
+ linkables <- liftIO $ catMaybes <$> concatHpt takeLinkables (hsc_HPT hsc_env)
let
- -- ROMES:TODO: before we filtered by HsSrcFile, but that
- -- seems irrelevant because boots or sigs shouldn't have
- -- linkables in the first place?
- -- map (expectJust "bkp link" . homeModInfoObject)
- -- . filter ((==HsSrcFile) . mi_hsc_src . hm_iface) $
- -- home_mod_infos
obj_files = concatMap linkableFiles linkables
state = hsc_units hsc_env
- let compat_fs = unitIdFS cid
+ compat_fs = unitIdFS cid
compat_pn = PackageName compat_fs
unit_id = homeUnitId (hsc_home_unit hsc_env)
=====================================
compiler/GHC/Unit/Home/PackageTable.hs
=====================================
@@ -70,6 +70,9 @@ module GHC.Unit.Home.PackageTable
, hptCollectObjects
, hptCollectModules
+ -- ** Memory dangerous queries
+ , concatHpt
+
-- * Utilities
, pprHPT
@@ -132,6 +135,7 @@ data HomePackageTable = HPT {
-- about the table 'HomeModInfo' updates. On insertions we must make sure to
-- update this field (insertions can only be done through the API exposed).
+-- ROMES:TODO: change to lastLoadedModule
lastLoadedKey :: Maybe Unique
-- ^ What was the last module loaded into this HPT?
--
@@ -190,15 +194,14 @@ addHomeModInfoToHpt :: HomeModInfo -> HomePackageTable -> IO HomePackageTable
addHomeModInfoToHpt hmi hpt = addToHpt hpt (moduleName (mi_module (hm_iface hmi))) hmi
where
addToHpt :: HomePackageTable -> ModuleName -> HomeModInfo -> IO HomePackageTable
- addToHpt HPT{table=hptr, hasHoles, lastLoadedKey} mn hmi = do
- alreadyExisted <- atomicModifyIORef' hptr (\hpt -> (addToUDFM hpt mn hmi, elemUDFM mn hpt))
+ addToHpt HPT{table=hptr, hasHoles} mn hmi = do
+ atomicModifyIORef' hptr (\hpt -> (addToUDFM hpt mn hmi, ()))
-- If the key already existed in the map, this insertion is overwriting
-- the HMI of a previously loaded module (likely in rehydration).
return
HPT{ table = hptr
- , hasHoles = hasHoles && isHoleModule (mi_semantic_module (hm_iface hmi))
- , lastLoadedKey = if alreadyExisted then lastLoadedKey
- else Just $! getUnique mn
+ , hasHoles = hasHoles || isHoleModule (mi_semantic_module (hm_iface hmi))
+ , lastLoadedKey = Just $! getUnique mn {- yes, even if we're overwriting something already in the map -}
}
----------------------------------------------------------------------------------
=====================================
compiler/GHC/Unit/Module/Graph.hs
=====================================
@@ -46,7 +46,7 @@ module GHC.Unit.Module.Graph
-- (without changing the 'ModuleGraph' structure itself!).
-- 'mgModSummaries' lists out all 'ModSummary's, and
-- 'mgLookupModule' looks up a 'ModSummary' for a given module.
- , mgMap, mgMapM
+ , mapMG, mgMapM
, mgModSummaries
, mgLookupModule
@@ -239,8 +239,8 @@ lengthMG = length . mg_mss
-- | Map a function 'f' over all the 'ModSummaries'.
-- To preserve invariants, 'f' can't change the isBoot status.
-mgMap :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph
-mgMap f mg at ModuleGraph{..} = mg
+mapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph
+mapMG f mg at ModuleGraph{..} = mg
{ mg_mss = flip fmap mg_mss $ \case
InstantiationNode uid iuid -> InstantiationNode uid iuid
LinkNode uid nks -> LinkNode uid nks
=====================================
compiler/GHC/Unit/Module/Status.hs
=====================================
@@ -41,6 +41,9 @@ data HscBackendAction
-- changed.
}
+instance Outputable HscRecompStatus where
+ ppr HscUpToDate{} = text "HscUpToDate"
+ ppr HscRecompNeeded{} = text "HscRecompNeeded"
instance Outputable HscBackendAction where
ppr (HscUpdate mi) = text "Update:" <+> (ppr (mi_module mi))
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/04fa9b901df5a7531d358010787d80c6b9b8e39b...bfba5d6c53bc85e74fff6161407a192aa2bc55b3
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/04fa9b901df5a7531d358010787d80c6b9b8e39b...bfba5d6c53bc85e74fff6161407a192aa2bc55b3
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/20241212/7399c8ff/attachment-0001.html>
More information about the ghc-commits
mailing list