[Git][ghc/ghc][wip/romes/27461] downsweep: make control flow simpler and cache correct
by Rodrigo Mesquita (＠alt-romes) 11 Jul '26
by Rodrigo Mesquita (＠alt-romes) 11 Jul '26
11 Jul '26
Rodrigo Mesquita pushed to branch wip/romes/27461 at Glasgow Haskell Compiler / GHC
Commits:
513ff655 by Rodrigo Mesquita at 2026-07-11T09:25:32+01:00
downsweep: make control flow simpler and cache correct
This refactor extracts the control flow of downsweep into a single
function `dfsBuild`, which takes care of iteratively expanding and
traversing all nodes of the in-construction module graph necessary to
build a full `ModuleGraph`.
There are three levels of caching going on, all of which are necessary
to make sure we don't do repeated work (specifically: NEVER summarise
the same module twice).
1. `dfsBuild` accumulates the final module graph and never revisits the
same node of the module graph. Cache is keyed by the final
`ModuleGraph`s `NodeKey`s.
2. For Module A in home-unit u1, each import in the list of imports
needs to be *found* (call to `findImportedModuleWithIsBoot`): at this
point, we only have the `ModuleName` of the import, not the `Module`.
This *finding* is somewhat expensive, so we cache it as well
(`ImportsCache`). The cache key is the home-unit to which the module
belongs~[1], the import package qualifier, and the ModuleName.
[1] Different home-units will have different package flags, which means
potentially different `Module` resolution for the same `ModuleName`.
3. The most expensive operation we want to avoid is summarising a
`Module` into a `ModSummary`, which notably involves parsing the
module header from scratch.
The third cache, in essence, maps a `Module` to its `ModSummary`
(named `ModSummaryCache`). This cache upholds the invariant: we NEVER
summarise the same module twice. In practice, the cache key is the
Module's UnitId and the Source path; the reason is we need to
distinguish between `.hs` and `.hs-boot` files, as their summaries
will differ.
Note that (2) can't guarantee this alone: Two ModuleName imports in
separate units can (and likely do) map to the same `Module`.
Note that the previous implementation failed to achieve the
no-duplicate-work summarisation invariant, and we ended up doing a
quadratic amount of processing in scenarios like test
`MultiComponentModules100`.
See also Note [Downsweep Control Flow and Caching]
Fixes #27461
- - - - -
2 changed files:
- compiler/GHC/Driver/Downsweep.hs
- utils/check-ppr/Main.hs
Changes:
=====================================
compiler/GHC/Driver/Downsweep.hs
=====================================
@@ -5,6 +5,8 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FunctionalDependencies #-}
module GHC.Driver.Downsweep
( downsweep
, downsweepThunk
@@ -91,7 +93,7 @@ import GHC.Unit.Module.Deps
import qualified GHC.Unit.Home.Graph as HUG
import GHC.Unit.Module.Stage
-import Data.Either ( rights, partitionEithers, lefts )
+import Data.Either ( partitionEithers, lefts )
import qualified Data.Map as Map
import qualified Data.Set as Set
@@ -111,6 +113,8 @@ import Control.Monad.Trans.Reader
import qualified Data.Map.Strict as M
import Control.Monad.Trans.Class
import System.IO.Unsafe (unsafeInterleaveIO)
+import Data.IORef
+import qualified Data.List.NonEmpty as NE
{-
Note [Downsweep and the ModuleGraph]
@@ -142,14 +146,6 @@ The result is having a uniform graph available for the whole compilation pipelin
-}
--- This caches the answer to the question, if we are in this unit, what does
--- an import of this module mean.
-type DownsweepCache = M.Map (UnitId, PkgQual, ModuleNameWithIsBoot) [Either DriverMessages ModuleNodeInfo]
-
-moduleGraphNodeMap :: ModuleGraph -> M.Map NodeKey ModuleGraphNode
-moduleGraphNodeMap graph
- = M.fromList [(mkNodeKey node, node) | node <- mgModSummaries' graph]
-
-----------------------------------------------------------------------------
--
-- | Downsweep (dependency analysis) for --make mode
@@ -195,8 +191,11 @@ downsweep :: HscEnv
-- (Modules, IsBoot) identifiers, unless the Bool is true in
-- which case there can be repeats
downsweep hsc_env diag_wrapper msg old_summaries maybe_base_graph excl_mods allow_dup_roots = do
- n_jobs <- mkWorkerLimit (hsc_dflags hsc_env)
- (root_errs, root_summaries) <- rootSummariesParallel n_jobs hsc_env diag_wrapper msg summary
+ n_jobs <- mkWorkerLimit (hsc_dflags hsc_env)
+ summ_cache <- newIORef (mkModSummaryCache (zip old_summaries (repeat SummOld)))
+ imps_cache <- newIORef Map.empty
+ (root_errs, root_summaries) <- rootSummariesParallel n_jobs hsc_env diag_wrapper msg
+ (getRootSummary excl_mods summ_cache imps_cache)
let closure_errs = checkHomeUnitsClosed unit_env
unit_env = hsc_unit_env hsc_env
@@ -204,9 +203,13 @@ downsweep hsc_env diag_wrapper msg old_summaries maybe_base_graph excl_mods allo
case all_errs of
[] -> do
- (downsweep_errs, downsweep_nodes) <- downsweepFromRootNodes hsc_env old_summary_map maybe_base_graph excl_mods allow_dup_roots DownsweepUseCompile (map ModuleNodeCompile root_summaries) []
+ (downsweep_errs, downsweep_nodes) <-
+ downsweepFromRootNodes hsc_env summ_cache imps_cache maybe_base_graph
+ excl_mods allow_dup_roots DownsweepUseCompile (map ModuleNodeCompile root_summaries) []
- let (other_errs, unit_nodes) = partitionEithers $ HUG.unitEnv_foldWithKey (\nodes uid hue -> nodes ++ unitModuleNodes downsweep_nodes uid hue) [] (hsc_HUG hsc_env)
+ let (other_errs, unit_nodes) = partitionEithers $
+ HUG.unitEnv_foldWithKey (\nodes uid hue -> nodes ++ unitModuleNodes downsweep_nodes uid hue) []
+ (hsc_HUG hsc_env)
let all_nodes = downsweep_nodes ++ unit_nodes
let all_errs = downsweep_errs ++ other_errs
@@ -222,17 +225,6 @@ downsweep hsc_env diag_wrapper msg old_summaries maybe_base_graph excl_mods allo
return (all_errs, th_configured_nodes)
_ -> return (all_errs, emptyMG)
where
- summary = getRootSummary excl_mods old_summary_map
-
- -- A cache from file paths to the already summarised modules. The same file
- -- can be used in multiple units so the map is also keyed by which unit the
- -- file was used in.
- -- Reuse these if we can because the most expensive part of downsweep is
- -- reading the headers.
- old_summary_map :: M.Map (UnitId, OsPath) ModSummary
- old_summary_map =
- M.fromList [((ms_unitid ms, msHsFileOsPath ms), ms) | ms <- old_summaries]
-
-- Dependencies arising on a unit (backpack and module linking deps)
unitModuleNodes :: [ModuleGraphNode] -> UnitId -> HomeUnitEnv -> [Either (Messages DriverMessage) ModuleGraphNode]
unitModuleNodes summaries uid hue =
@@ -245,7 +237,9 @@ downsweep hsc_env diag_wrapper msg old_summaries maybe_base_graph excl_mods allo
downsweepThunk :: HscEnv -> ModSummary -> IO ModuleGraph
downsweepThunk hsc_env mod_summary = unsafeInterleaveIO $ do
debugTraceMsg (hsc_logger hsc_env) 3 $ text "Computing Module Graph thunk..."
- ~(errs, mg) <- downsweepFromRootNodes hsc_env mempty Nothing [] True DownsweepUseFixed [ModuleNodeCompile mod_summary] []
+ summs <- newIORef (mkModSummaryCache [(mod_summary,SummOld)])
+ imps <- newIORef mempty
+ ~(errs, mg) <- downsweepFromRootNodes hsc_env summs imps Nothing [] True DownsweepUseFixed [ModuleNodeCompile mod_summary] []
let dflags = hsc_dflags hsc_env
liftIO $ printOrThrowDiagnostics (hsc_logger hsc_env)
(initPrintConfig dflags)
@@ -269,83 +263,22 @@ downsweepInteractiveImports hsc_env ic = unsafeInterleaveIO $ do
debugTraceMsg (hsc_logger hsc_env) 3 $ (text "Computing Interactive Module Graph thunk...")
let imps = ic_imports (hsc_IC hsc_env)
- let interactive_mn = icInteractiveModule ic
- -- No sensible value for ModLocation.. if you hit this panic then you probably
- -- need to add proper support for modules without any source files to the driver.
- let ml = pprPanic "modLocation" (ppr interactive_mn <+> ppr imps)
- let key = moduleToMnk interactive_mn NotBoot
- let node_type = ModuleNodeFixed key ml
+ interactive_mn = icInteractiveModule ic
+ key = dsNodeInfoKey (DSInteractive interactive_mn imps)
-- The existing nodes in the module graph. This will be populated when GHCi runs
-- :load. Any home package modules need to already be in here.
let cached_nodes = Map.fromList [ (mkNodeKey n, n) | n <- mg_mss (hsc_mod_graph hsc_env) ]
- (module_edges, graph) <- loopFromInteractive hsc_env (map mkEdge imps) cached_nodes
- let interactive_node = ModuleNode module_edges node_type
-
- let all_nodes = M.elems graph
+ summ_cache <- newIORef mempty
+ imps_cache <- newIORef mempty
+ let env = DownsweepEnv hsc_env DownsweepUseFixed{-or UseCompiled?-} summ_cache imps_cache []
+ graph <- runDownsweepM env do
+ loopFromInteractive cached_nodes interactive_mn imps
+ let interactive_node = expectJust $ M.lookup key graph
+ all_nodes = M.elems graph
return $ mkModuleGraph (interactive_node : all_nodes)
- where
- --
- mkEdge :: InteractiveImport -> Either ModuleNodeEdge (UnitId, ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))
- -- A simple edge to a module from the same home unit
- mkEdge (IIModule n) =
- let
- mod_node_key = ModNodeKeyWithUid
- { mnkModuleName = GWIB (moduleName n) NotBoot
- , mnkUnitId =
- -- 'toUnitId' is safe here, as we can't import modules that
- -- don't have a 'UnitId'.
- toUnitId (moduleUnit n)
- }
- mod_node_edge =
- ModuleNodeEdge NormalLevel (NodeKey_Module mod_node_key)
- in Left mod_node_edge
- -- A complete import statement
- mkEdge (IIDecl i) =
- let lvl = convImportLevel (ideclLevelSpec i)
- wanted_mod = unLoc (ideclName i)
- is_boot = ideclSource i
- mb_pkg = renameRawPkgQual (hsc_unit_env hsc_env) (unLoc $ ideclName i) (ideclPkgQual i)
- unitId = homeUnitId $ hsc_home_unit hsc_env
- in Right (unitId, lvl, mb_pkg, GWIB (noLoc wanted_mod) is_boot)
-
-loopFromInteractive :: HscEnv
- -> [Either ModuleNodeEdge (UnitId, ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))]
- -> M.Map NodeKey ModuleGraphNode
- -> IO ([ModuleNodeEdge],M.Map NodeKey ModuleGraphNode)
-loopFromInteractive _ [] cached_nodes = return ([], cached_nodes)
-loopFromInteractive hsc_env (edge:edges) cached_nodes =
- case edge of
- Left edge -> do
- (edges, cached_nodes') <- loopFromInteractive hsc_env edges cached_nodes
- return (edge : edges, cached_nodes')
- Right (unitId, lvl, mb_pkg, GWIB wanted_mod is_boot) -> do
- let home_unit = ue_unitHomeUnit unitId (hsc_unit_env hsc_env)
- let k _ loc mod =
- let key = moduleToMnk mod is_boot
- in return $ FoundHome (ModuleNodeFixed key loc)
- found <- liftIO $ summariseModuleDispatch k hsc_env home_unit is_boot wanted_mod mb_pkg []
- case found of
- -- Case 1: Home modules have to already be in the cache.
- FoundHome (ModuleNodeFixed mod _) -> do
- let edge = ModuleNodeEdge lvl (NodeKey_Module mod)
- -- Note: Does not perform any further downsweep as the module must already be in the cache.
- (edges, cached_nodes') <- loopFromInteractive hsc_env edges cached_nodes
- return (edge : edges, cached_nodes')
- -- Case 2: External units may not be in the cache, if we haven't already initialised the
- -- module graph. We can construct the module graph for those here by calling loopUnit.
- External uid -> do
- let hsc_env' = hscSetActiveHomeUnit home_unit hsc_env
- cached_nodes' = loopUnit hsc_env' cached_nodes [uid]
- edge = ModuleNodeEdge lvl (NodeKey_ExternalUnit uid)
- (edges, cached_nodes') <- loopFromInteractive hsc_env edges cached_nodes'
- return (edge : edges, cached_nodes')
- -- And if it's not found.. just carry on and hope.
- _ -> loopFromInteractive hsc_env edges cached_nodes
-
-
-- | Create a module graph from a list of installed modules.
-- This is used by the loader when we need to load modules but there
-- isn't already an existing module graph. For example, when loading plugins
@@ -373,7 +306,9 @@ downsweepInstalledModules hsc_env mods = do
_ -> throwGhcException $ ProgramError $ showSDoc (hsc_dflags hsc_env) $ text "downsweepInstalledModules: Could not find installed module" <+> ppr i
nodes <- mapM process installed_mods
- (errs, mg) <- downsweepFromRootNodes hsc_env mempty Nothing [] True DownsweepUseFixed nodes external_uids
+ summs <- newIORef mempty
+ imps <- newIORef mempty
+ (errs, mg) <- downsweepFromRootNodes hsc_env summs imps Nothing [] True DownsweepUseFixed nodes external_uids
-- Similarly here, we should really not get any errors, but print them out if we do.
let dflags = hsc_dflags hsc_env
@@ -397,7 +332,8 @@ data DownsweepMode = DownsweepUseCompile | DownsweepUseFixed
-- This function will start at the given roots, and traverse downwards to find
-- all the dependencies, all the way to the leaf units.
downsweepFromRootNodes :: HscEnv
- -> M.Map (UnitId, OsPath) ModSummary
+ -> ModSummaryCache
+ -> ImportsCache
-> Maybe ModuleGraph
-> [ModuleName]
-> Bool
@@ -405,44 +341,47 @@ downsweepFromRootNodes :: HscEnv
-> [ModuleNodeInfo] -- ^ The starting ModuleNodeInfo
-> [UnitId] -- ^ The starting units
-> IO ([DriverMessages], [ModuleGraphNode])
-downsweepFromRootNodes hsc_env old_summaries maybe_base_graph excl_mods allow_dup_roots mode root_nodes root_uids
- = do
- let root_map = mkRootMap root_nodes
- checkDuplicates root_map
- let env = DownsweepEnv hsc_env mode old_summaries excl_mods
- (deps', map0) <- runDownsweepM env $ do
- let base_nodes = maybe M.empty moduleGraphNodeMap maybe_base_graph
- (module_deps, map0) <- loopModuleNodeInfos root_nodes (base_nodes, root_map)
- let all_deps = loopUnit hsc_env module_deps root_uids
- let all_instantiations = getHomeUnitInstantiations hsc_env
- deps' <- loopInstantiations all_instantiations all_deps
- return (deps', map0)
-
-
- let downsweep_errs = lefts $ concat $ M.elems map0
- downsweep_nodes = M.elems deps'
-
- return (downsweep_errs, downsweep_nodes)
- where
- getHomeUnitInstantiations :: HscEnv -> [(UnitId, InstantiatedUnit)]
- getHomeUnitInstantiations hsc_env = HUG.unitEnv_foldWithKey (\nodes uid hue -> nodes ++ instantiationNodes uid (homeUnitEnv_units hue)) [] (hsc_HUG hsc_env)
-
- -- In a root module, the filename is allowed to diverge from the module
- -- name, so we have to check that there aren't multiple root files
- -- defining the same module (otherwise the duplicates will be silently
- -- ignored, leading to confusing behaviour).
- checkDuplicates
- :: DownsweepCache
- -> IO ()
- checkDuplicates root_map
- | not allow_dup_roots
- , dup_root:_ <- dup_roots = liftIO $ multiRootsErr sec dup_root
- | otherwise = pure ()
- where
- sec = initSourceErrorContext (hsc_dflags hsc_env)
- dup_roots :: [[ModuleNodeInfo]] -- Each at least of length 2
- dup_roots = filterOut isSingleton $ map rights (M.elems root_map)
-
+downsweepFromRootNodes hsc_env summ_cache imps_cache maybe_base_graph excl_mods allow_dup_roots mode root_nodes root_uids = do
+ when (not allow_dup_roots) $
+ case root_duplicates of
+ [] -> return ()
+ (dup_root:_) -> multiRootsErr sec dup_root
+ let env = DownsweepEnv hsc_env mode summ_cache imps_cache excl_mods
+ deps' <- runDownsweepM env $ do
+ let base_nodes = maybe M.empty moduleGraphNodeMap maybe_base_graph
+ module_deps <- loopModuleNodeInfos base_nodes root_nodes
+ all_deps <- loopUnits module_deps (hscActiveUnitId hsc_env) root_uids
+ deps' <- loopInstantiations all_deps (getHomeUnitInstantiations hsc_env)
+ return deps'
+ f_cache <- readIORef summ_cache
+ let downsweep_errs = lefts (M.elems f_cache)
+ downsweep_nodes = M.elems deps'
+
+ return (downsweep_errs, downsweep_nodes)
+ where
+ getHomeUnitInstantiations :: HscEnv -> [(UnitId, InstantiatedUnit)]
+ getHomeUnitInstantiations hsc_env = HUG.unitEnv_foldWithKey
+ (\nodes uid hue -> nodes ++ instantiationNodes uid (homeUnitEnv_units hue)) [] (hsc_HUG hsc_env)
+
+ -- In a root module, the filename is allowed to diverge from the module
+ -- name, so we have to check that there aren't multiple root files
+ -- defining the same module (otherwise the duplicates will be silently
+ -- ignored, leading to confusing behaviour).
+ root_duplicates :: [NE.NonEmpty ModuleNodeInfo]
+ root_duplicates = mapMaybe takes2 (M.elems root_map)
+ where
+ takes2 (a:as@(_:_)) = Just (a NE.:| as) -- Each at least of length 2
+ takes2 _ = Nothing
+
+ root_map = Map.fromListWith (flip (++))
+ [ ((moduleNodeInfoUnitId s, moduleNodeInfoMnwib s), [s])
+ | s <- root_nodes ]
+
+ moduleGraphNodeMap :: ModuleGraph -> M.Map NodeKey ModuleGraphNode
+ moduleGraphNodeMap graph
+ = M.fromList [(mkNodeKey node, node) | node <- mgModSummaries' graph]
+
+ sec = initSourceErrorContext (hsc_dflags hsc_env)
calcDeps :: ModSummary -> [(ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))]
calcDeps ms =
@@ -457,104 +396,287 @@ type DownsweepM a = ReaderT DownsweepEnv IO a
data DownsweepEnv = DownsweepEnv {
downsweep_hsc_env :: HscEnv
, _downsweep_mode :: DownsweepMode
- , _downsweep_old_summaries :: M.Map (UnitId, OsPath) ModSummary
+ , _downsweep_summaries_cache :: ModSummaryCache
+ , downsweep_imports_cache :: ImportsCache
, _downsweep_excl_mods :: [ModuleName]
}
+type ModSummaryCache = IORef ModSummaryCacheMap
+type ImportsCache = IORef ImportsCacheMap
+
+-- | A cache from file paths to the already summarised modules. The same file
+-- can be used in multiple units so the map is actually also keyed by which
+-- unit the file was used in.
+--
+-- We want to reuse ModSummaries as far as possible because the most expensive
+-- part of downsweep is reading and parsing the headers.
+--
+-- See Note [Downsweep Control Flow and Caching]
+type ModSummaryCacheMap
+ -- The cache can't be keyed by 'Module' because that isn't sufficient to
+ -- distinguish .hs from .hs-boot files. Use path+unit instead.
+ = ( M.Map (UnitId, OsPath) (Either DriverMessages (ModSummary, SummProvenance)) )
+
+data SummProvenance
+ -- | Constructed during this downsweep: trivially up to date
+ = SummFresh
+ -- | Carried over from a previous run: may be stale, must be hash-checked
+ -- (and considered by -fforce-recomp)
+ | SummOld
+
+mkModSummaryCache :: [(ModSummary, SummProvenance)] -> ModSummaryCacheMap
+mkModSummaryCache summs = foldl' (flip (uncurry addModSummaryCache)) M.empty summs
+
+addModSummaryCache :: ModSummary -> SummProvenance -> ModSummaryCacheMap -> ModSummaryCacheMap
+addModSummaryCache ms pr fe = upd_fe fe
+ where
+ upd_fe fe
+ | Just src_fn_os <- ml_hs_file_ospath (ms_location ms)
+ = M.insert (ms_unitid ms, src_fn_os) (Right (ms, pr)) fe
+ | otherwise = fe
+
+modifySummCache :: ModSummaryCache -> (ModSummaryCacheMap -> ModSummaryCacheMap) -> IO ()
+modifyImpsCache :: ImportsCache -> (ImportsCacheMap -> ImportsCacheMap) -> IO ()
+modifySummCache r f = atomicModifyIORef' r (\c -> (f c, ()))
+modifyImpsCache r f = atomicModifyIORef' r (\c -> (f c, ()))
+
+-- | A cache from a module import (in given home unit context, with a package
+-- qualifier, and the imported module name (with or without SOURCE)) to the
+-- result of summarising that import (see 'summariseModuleDispatch').
+--
+-- See Note [Downsweep Control Flow and Caching]
+type ImportsCacheMap
+ = M.Map (UnitId, PkgQual, ModuleNameWithIsBoot) SummariseResult
+
runDownsweepM :: DownsweepEnv -> DownsweepM a -> IO a
runDownsweepM env act = runReaderT act env
+loopDownsweepNodes :: M.Map NodeKey ModuleGraphNode -> [DownsweepNode] -> DownsweepM (M.Map NodeKey ModuleGraphNode)
+loopModuleNodeInfos :: M.Map NodeKey ModuleGraphNode -> [ModuleNodeInfo] -> DownsweepM (M.Map NodeKey ModuleGraphNode)
+loopUnits :: M.Map NodeKey ModuleGraphNode -> UnitId -> [UnitId] -> DownsweepM (M.Map NodeKey ModuleGraphNode)
+loopInstantiations :: M.Map NodeKey ModuleGraphNode -> [(UnitId, InstantiatedUnit)] -> DownsweepM (M.Map NodeKey ModuleGraphNode)
+loopFromInteractive :: M.Map NodeKey ModuleGraphNode -> Module -> [InteractiveImport] -> DownsweepM (M.Map NodeKey ModuleGraphNode)
+loopDownsweepNodes base_map nodes = dfsBuild (Just base_map) nodes dsNodeInfoKey dsNodeExpand
+loopModuleNodeInfos base_map = loopDownsweepNodes base_map . map DSMod
+loopUnits base_map homud = loopDownsweepNodes base_map . map (DSUnit homud)
+loopInstantiations base_map = loopDownsweepNodes base_map . map (uncurry DSInst)
+loopFromInteractive base_map m = loopDownsweepNodes base_map . (:[]) . DSInteractive m
+
+--------------------------------------------------------------------------------
+
+-- | A 'DownsweepNode' is the basic block of the downsweep algorithm which
+-- encompasses the types of nodes we can iteratively expand to construct the
+-- full module graph. See 'loopDownsweepNodes'.
+--
+-- See Note [Downsweep Control Flow and Caching]
+data DownsweepNode
+ -- | A module node to expand
+ = DSMod ModuleNodeInfo
+ -- | A unit node to expand
+ | DSUnit
+ { home_context_uid :: UnitId
+ -- ^ The home unit which introduced the dependency on this 'node_uid'. This
+ -- 'node_uid' can only be expanded in the context ('HscEnv') where
+ -- 'home_context_uid' is the active home unit, to make sure the package flags
+ -- are the ones attributed to the home package that introduced this node.
+ , node_uid :: UnitId
+ -- ^ The unit node to expand
+ }
+ -- | FIXME: document the meaning of 'DSInst'
+ | DSInst
+ { home_context_uid :: UnitId
+ , instantiated_ud :: InstantiatedUnit
+ }
+ -- | A group of interactive imports from this interactive Module
+ | DSInteractive Module [InteractiveImport]
+
+instance Outputable DownsweepNode where
+ ppr = \case
+ DSMod (ModuleNodeCompile ms) -> text "DSModC" <+> ppr (ms_mod_name ms)
+ DSMod (ModuleNodeFixed key _) -> text "DSModF" <+> ppr key
+ DSUnit{node_uid} -> text "DSUnit" <+> ppr node_uid
+ DSInst{instantiated_ud} -> text "DSInst" <+> ppr instantiated_ud
+ DSInteractive mod ii -> text "DSInteractive" <+> ppr mod <+> ppr ii
+
+-- | They key by which to cache previously visited 'DownsweepNode's
+dsNodeInfoKey :: DownsweepNode -> NodeKey
+dsNodeInfoKey = \case
+ DSMod (ModuleNodeCompile ms) -> NodeKey_Module (msKey ms)
+ DSMod (ModuleNodeFixed mod _) -> NodeKey_Module mod
+ DSUnit{node_uid} -> NodeKey_ExternalUnit node_uid
+ DSInst{instantiated_ud} -> NodeKey_Unit instantiated_ud
+ DSInteractive mod _imps -> NodeKey_Module $ moduleToMnk mod NotBoot
+
+dsNodeExpand :: DownsweepNode -> DownsweepM (Maybe (ModuleGraphNode, [DownsweepNode]))
+dsNodeExpand = \case
+ DSMod (ModuleNodeCompile ms) -> expandModuleSummary ms
+ DSMod (ModuleNodeFixed key loc) -> expandFixedModuleNode key loc
+ DSUnit{ node_uid, home_context_uid } -> expandUnitNode node_uid home_context_uid
+ DSInst{ instantiated_ud
+ , home_context_uid } -> expandInstantiatedUnit instantiated_ud home_context_uid
+ DSInteractive imod iis -> expandInteractiveImports imod iis
+
+expandModuleSummary :: ModSummary -> DownsweepM (Maybe (ModuleGraphNode, [DownsweepNode]))
+expandModuleSummary ms = do -- Didn't work out what the imports mean yet, now do that.
+ hsc_env <- asks downsweep_hsc_env
+ let home_uid = ms_unitid ms
+ home_unit = ue_unitHomeUnit home_uid (hsc_unit_env hsc_env)
+ (final_deps, todo) <- fmap unzip $ forM (calcDeps ms) $ \(imp,mb_pkg,gwib) -> do
+ let GWIB { gwib_mod = L loc mod, gwib_isBoot = is_boot } = gwib
+ wanted_mod = L loc mod
+ mb_s <- downsweepSummarise home_unit is_boot wanted_mod mb_pkg Nothing
+ case mb_s of
+ NotThere -> return
+ ( Nothing, [] )
+ External uid -> return
+ ( Just $ mkModuleEdge imp (NodeKey_ExternalUnit uid)
+ -- Specify home unit, as each unit might have a different visible package database.
+ , [DSUnit{node_uid = uid, home_context_uid = home_uid}] )
+ FoundInstantiation iud -> return
+ ( Just (mkModuleEdge imp (NodeKey_Unit iud)), [] )
+ FoundHomeWithError (_uid, _e) -> return
+ ( Nothing, [] )
+ -- the error @e@ is already stored in the summarisation cache,
+ -- (the IORef in DownsweepM) and will get reported at the end.
+ FoundHome s -> return
+ -- MP: This assumes that we can only instantiate non home units, which is probably fair enough for now.
+ ( Just $ mkModuleEdge imp (NodeKey_Module (mnKey s))
+ , [DSMod s] )
+
+ -- This has the effect of finding a .hs file if we are looking at the .hs-boot file.
+ boot_todo <-
+ if | HsBootFile <- ms_hsc_src ms
+ -> do
+ r <- downsweepSummarise home_unit NotBoot (noLoc $ ms_mod_name ms) NoPkgQual Nothing
+ case r of
+ FoundHome s -> pure [DSMod s]
+ _ -> pure []
+ | otherwise -> pure []
+
+ return $ Just
+ ( ModuleNode (catMaybes final_deps) (ModuleNodeCompile ms)
+ , boot_todo ++ concat todo
+ )
+
+-- | Expand a 'ModuleNodeFixed' node
+-- NB: If you ever reach a Fixed node, everything under that also must be fixed.
+expandFixedModuleNode :: ModNodeKeyWithUid -> ModLocation -> DownsweepM (Maybe (ModuleGraphNode, [DownsweepNode]))
+expandFixedModuleNode key loc = do
+ hsc_env <- asks downsweep_hsc_env
+ -- MP: TODO, we should just read the dependency info from the interface rather than either
+ -- a. Loading the whole thing into the EPS (this might never nececssary and causes lots of things to be permanently loaded into memory)
+ -- b. Loading the whole interface into a buffer before discarding it. (wasted allocation and deserialisation)
+ read_result <- liftIO $
+ -- 1. Check if the interface is already loaded into the EPS by some other
+ -- part of the compiler.
+ lookupIfaceByModuleHsc hsc_env (mnkToModule key) >>= \case
+ Just iface -> return (M.Succeeded iface)
+ Nothing -> readIface (hsc_hooks hsc_env) (hsc_logger hsc_env) (hsc_dflags hsc_env) (hsc_NC hsc_env) (mnkToModule key) (ml_hi_file loc)
+ case read_result of
+ M.Succeeded iface -> do
+ -- Computer information about this node
+ let node_deps = ifaceDeps (mi_deps iface)
+ edges = map mkFixedEdge node_deps
+ node = ModuleNode edges (ModuleNodeFixed key loc)
+ deps' <- catMaybes <$> mapM (mk_dep hsc_env) (bimap snd snd <$> node_deps)
+ pure $ Just (node, deps')
+
+ -- Ignore any failure, we might try to read a .hi-boot file for
+ -- example, even if there is not one.
+ M.Failed {} ->
+ pure Nothing
+ where
+ mk_dep hsc_env (Left key) = do
+ -- Like expandImports, but we already know exactly which module we are looking for.
+ read_result <- liftIO $ findExactModule hsc_env (mnkToInstalledModule key) (mnkIsBoot key)
+ case read_result of
+ InstalledFound loc -> do
+ pure $ Just $ DSMod (ModuleNodeFixed key loc)
+ _otherwise ->
+ -- If the finder fails, just keep going, there will be another
+ -- error later.
+ pure Nothing
+ mk_dep _ (Right uid_dep) = do
+ -- Set active unit so that looking loopUnit finds the correct
+ -- -package flags in the unit state.
+ let home_uid = mnkUnitId key
+ pure (Just DSUnit{node_uid=uid_dep, home_context_uid=home_uid})
+
+-- | Expand a unit id under the context of a certain home unit
+expandUnitNode :: UnitId {-^ @node_uid@ -} -> UnitId {-^ Home unit from where @node_uid@ was introduced -}
+ -> DownsweepM (Maybe (ModuleGraphNode, [DownsweepNode]))
+expandUnitNode node_uid home_context_uid = do
+ -- Set active unit so that looking loopUnit finds the correct
+ -- -package flags in the unit state.
+ hsc_env <- asks downsweep_hsc_env
+ let lcl_hsc_env = hscSetActiveUnitId home_context_uid hsc_env
+ case unitDepends <$> lookupUnitId (hsc_units lcl_hsc_env) node_uid of
+ Just us -> pure $ Just ((UnitNode us node_uid), map (\u -> DSUnit{node_uid=u, home_context_uid{-inherit-}}) us)
+ Nothing -> pprPanic "loopUnit" (text "Malformed package database, missing " <+> ppr node_uid)
+
+expandInstantiatedUnit :: InstantiatedUnit -> UnitId {-^ Home unit -} -> DownsweepM (Maybe (ModuleGraphNode, [DownsweepNode]))
+expandInstantiatedUnit iud home_uid = pure $ Just
+ ( InstantiationNode home_uid iud
+ , [DSUnit{node_uid=instUnitInstanceOf iud, home_context_uid=home_uid}] )
+
+expandInteractiveImports :: Module -> [InteractiveImport] -> DownsweepM (Maybe (ModuleGraphNode, [DownsweepNode]))
+expandInteractiveImports imod imps = do
+ hsc_env <- asks downsweep_hsc_env
+ imps_cache <- asks downsweep_imports_cache
+
+ let
+ -- A simple edge to a module from the same home unit
+ mkEdge (IIModule n) = return $
+ let
+ mod_node_key = ModNodeKeyWithUid
+ { mnkModuleName = GWIB (moduleName n) NotBoot
+ , mnkUnitId =
+ -- 'toUnitId' is safe here, as we can't import modules that
+ -- don't have a 'UnitId'.
+ toUnitId (moduleUnit n)
+ }
+ in (Just $ ModuleNodeEdge NormalLevel (NodeKey_Module mod_node_key), [])
-loopInstantiations :: [(UnitId, InstantiatedUnit)]
- -> M.Map NodeKey ModuleGraphNode
- -> DownsweepM (M.Map NodeKey ModuleGraphNode)
-loopInstantiations [] done = pure done
-loopInstantiations ((home_uid, iud) :xs) done = do
- hsc_env <- asks downsweep_hsc_env
- let home_unit = ue_unitHomeUnit home_uid (hsc_unit_env hsc_env)
- let hsc_env' = hscSetActiveHomeUnit home_unit hsc_env
- done' = loopUnit hsc_env' done [instUnitInstanceOf iud]
- payload = InstantiationNode home_uid iud
- loopInstantiations xs (M.insert (mkNodeKey payload) payload done')
-
-
--- This loops over all the mod summaries in the dependency graph, accumulates the actual dependencies for each module/unit
-loopSummaries :: [ModSummary]
- -> (M.Map NodeKey ModuleGraphNode,
- DownsweepCache)
- -> DownsweepM ((M.Map NodeKey ModuleGraphNode), DownsweepCache)
-loopSummaries [] done = pure done
-loopSummaries (ms:next) (done, summarised)
- | Just {} <- M.lookup k done
- = loopSummaries next (done, summarised)
- -- Didn't work out what the imports mean yet, now do that.
- | otherwise = do
- (final_deps, done', summarised') <- loopImports (ms_unitid ms) (calcDeps ms) done summarised
- -- This has the effect of finding a .hs file if we are looking at the .hs-boot file.
- (_, done'', summarised'') <- loopImports (ms_unitid ms) (maybeToList hs_file_for_boot) done' summarised'
- loopSummaries next (M.insert k (ModuleNode final_deps (ModuleNodeCompile ms)) done'', summarised'')
+ -- A complete import statement
+ mkEdge (IIDecl i) =
+ let lvl = convImportLevel (ideclLevelSpec i)
+ wanted_mod = unLoc (ideclName i)
+ is_boot = ideclSource i
+ mb_pkg = renameRawPkgQual (hsc_unit_env hsc_env) (unLoc $ ideclName i) (ideclPkgQual i)
+ unitId = homeUnitId $ hsc_home_unit hsc_env
+ in do
+ let home_unit = ue_unitHomeUnit unitId (hsc_unit_env hsc_env)
+ let k _ loc mod =
+ let key = moduleToMnk mod is_boot
+ in return $ FoundHome (ModuleNodeFixed key loc)
+
+ found <- liftIO $ summariseModuleDispatch k hsc_env imps_cache
+ home_unit is_boot (noLoc wanted_mod) mb_pkg []
+ case found of
+ -- Case 1: Home modules have to already be in the cache.
+ FoundHome (ModuleNodeFixed mod _) -> do
+ let edge = ModuleNodeEdge lvl (NodeKey_Module mod)
+ -- Note: Does not perform any further downsweep as the module must already be in the cache.
+ return (Just edge, [])
+ -- Case 2: External units may not be in the cache, if we haven't already initialised the
+ -- module graph. We can construct the module graph for those here by calling loopUnit.
+ External uid -> do
+ let edge = ModuleNodeEdge lvl (NodeKey_ExternalUnit uid)
+ return (Just edge, [DSUnit{node_uid=uid, home_context_uid=homeUnitId home_unit}])
+ -- And if it's not found.. just carry on and hope.
+ _ -> return (Nothing, [])
+
+ (module_edges, todo) <- unzip <$> mapM mkEdge imps
+ pure $ Just
+ ( ModuleNode (catMaybes module_edges) node_type, concat todo )
where
- k = NodeKey_Module (msKey ms)
+ -- No sensible value for ModLocation.. if you hit this panic then you probably
+ -- need to add proper support for modules without any source files to the driver.
+ ml = pprPanic "modLocation" (ppr imod <+> ppr imps)
+ key = moduleToMnk imod NotBoot
+ node_type = ModuleNodeFixed key ml
- hs_file_for_boot
- | HsBootFile <- ms_hsc_src ms
- = Just (NormalLevel, NoPkgQual, (GWIB (noLoc $ ms_mod_name ms) NotBoot))
- | otherwise
- = Nothing
-
-loopModuleNodeInfos :: [ModuleNodeInfo] -> (M.Map NodeKey ModuleGraphNode, DownsweepCache) -> DownsweepM (M.Map NodeKey ModuleGraphNode, DownsweepCache)
-loopModuleNodeInfos is cache = foldM (flip loopModuleNodeInfo) cache is
-
-loopModuleNodeInfo :: ModuleNodeInfo -> (M.Map NodeKey ModuleGraphNode, DownsweepCache) -> DownsweepM (M.Map NodeKey ModuleGraphNode, DownsweepCache)
-loopModuleNodeInfo mod_node_info (done, summarised) = do
- case mod_node_info of
- ModuleNodeCompile ms -> do
- loopSummaries [ms] (done, summarised)
- ModuleNodeFixed mod ml -> do
- done' <- loopFixedModule mod ml done
- return (done', summarised)
-
--- NB: loopFixedModule does not take a downsweep cache, because if you
--- ever reach a Fixed node, everything under that also must be fixed.
-loopFixedModule :: ModNodeKeyWithUid -> ModLocation
- -> M.Map NodeKey ModuleGraphNode
- -> DownsweepM (M.Map NodeKey ModuleGraphNode)
-loopFixedModule key loc done = do
- let nk = NodeKey_Module key
- hsc_env <- asks downsweep_hsc_env
- case M.lookup nk done of
- Just {} -> return done
- Nothing -> do
- -- MP: TODO, we should just read the dependency info from the interface rather than either
- -- a. Loading the whole thing into the EPS (this might never nececssary and causes lots of things to be permanently loaded into memory)
- -- b. Loading the whole interface into a buffer before discarding it. (wasted allocation and deserialisation)
- read_result <- liftIO $
- -- 1. Check if the interface is already loaded into the EPS by some other
- -- part of the compiler.
- lookupIfaceByModuleHsc hsc_env (mnkToModule key) >>= \case
- Just iface -> return (M.Succeeded iface)
- Nothing -> readIface (hsc_hooks hsc_env) (hsc_logger hsc_env) (hsc_dflags hsc_env) (hsc_NC hsc_env) (mnkToModule key) (ml_hi_file loc)
- case read_result of
- M.Succeeded iface -> do
- -- Computer information about this node
- let node_deps = ifaceDeps (mi_deps iface)
- edges = map mkFixedEdge node_deps
- node = ModuleNode edges (ModuleNodeFixed key loc)
- foldM (loopFixedNodeKey (mnkUnitId key)) (M.insert nk node done) (bimap snd snd <$> node_deps)
- -- Ignore any failure, we might try to read a .hi-boot file for
- -- example, even if there is not one.
- M.Failed {} ->
- return done
-
-loopFixedNodeKey :: UnitId -> M.Map NodeKey ModuleGraphNode -> Either ModNodeKeyWithUid UnitId -> DownsweepM (M.Map NodeKey ModuleGraphNode)
-loopFixedNodeKey _ done (Left key) = do
- loopFixedImports [key] done
-loopFixedNodeKey home_uid done (Right uid) = do
- -- Set active unit so that looking loopUnit finds the correct
- -- -package flags in the unit state.
- hsc_env <- asks downsweep_hsc_env
- let hsc_env' = hscSetActiveUnitId home_uid hsc_env
- return $ loopUnit hsc_env' done [uid]
+--------------------------------------------------------------------------------
mkFixedEdge :: Either (ImportLevel, ModNodeKeyWithUid) (ImportLevel, UnitId) -> ModuleNodeEdge
mkFixedEdge (Left (lvl, key)) = mkModuleEdge lvl (NodeKey_Module key)
@@ -569,27 +691,6 @@ ifaceDeps deps =
| (lvl, uid) <- Set.toList (dep_direct_pkgs deps)
]
--- Like loopImports, but we already know exactly which module we are looking for.
-loopFixedImports :: [ModNodeKeyWithUid]
- -> M.Map NodeKey ModuleGraphNode
- -> DownsweepM (M.Map NodeKey ModuleGraphNode)
-loopFixedImports [] done = pure done
-loopFixedImports (key:keys) done = do
- let nk = NodeKey_Module key
- hsc_env <- asks downsweep_hsc_env
- case M.lookup nk done of
- Just {} -> loopFixedImports keys done
- Nothing -> do
- read_result <- liftIO $ findExactModule hsc_env (mnkToInstalledModule key) (mnkIsBoot key)
- case read_result of
- InstalledFound loc -> do
- done' <- loopFixedModule key loc done
- loopFixedImports keys done'
- _otherwise ->
- -- If the finder fails, just keep going, there will be another
- -- error later.
- loopFixedImports keys done
-
downsweepSummarise :: HomeUnit
-> IsBootInterface
-> Located ModuleName
@@ -597,90 +698,22 @@ downsweepSummarise :: HomeUnit
-> Maybe (StringBuffer, UTCTime)
-> DownsweepM SummariseResult
downsweepSummarise home_unit is_boot wanted_mod mb_pkg maybe_buf = do
- DownsweepEnv hsc_env mode old_summaries excl_mods <- ask
- case mode of
- DownsweepUseCompile -> liftIO $ summariseModule hsc_env home_unit old_summaries is_boot wanted_mod mb_pkg maybe_buf excl_mods
- DownsweepUseFixed -> liftIO $ summariseModuleInterface hsc_env home_unit is_boot wanted_mod mb_pkg excl_mods
-
-
--- This loops over each import in each summary. It is mutually recursive with
--- loopSummaries if we discover a new module by doing this.
-loopImports
- :: UnitId
- -- ^ UnitId of home unit of summary whose imports are being processed
- -> [(ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))]
- -- ^ Work list: process these modules
- -> M.Map NodeKey ModuleGraphNode
- -> DownsweepCache
- -- ^ Visited set; the range is a list because
- -- the roots can have the same module names
- -- if allow_dup_roots is True
- -> DownsweepM ([ModuleNodeEdge],
- M.Map NodeKey ModuleGraphNode, DownsweepCache)
- -- ^ The result is the completed NodeMap
-loopImports _ [] done summarised = return ([], done, summarised)
-loopImports home_uid ((imp, mb_pkg, gwib) : ss) done summarised
- | Just summs <- M.lookup cache_key summarised
- = case summs of
- [Right ms] -> do
- let nk = mkModuleEdge imp (NodeKey_Module (mnKey ms))
- (rest, summarised', done') <- loopImportsNext done summarised
- return (nk: rest, summarised', done')
- [Left _err] ->
- loopImportsNext done summarised
- _errs -> do
- loopImportsNext done summarised
- | otherwise
- = do
- hsc_env <- asks downsweep_hsc_env
- let home_unit = ue_unitHomeUnit home_uid (hsc_unit_env hsc_env)
- mb_s <- downsweepSummarise home_unit
- is_boot wanted_mod mb_pkg
- Nothing
- case mb_s of
- NotThere -> loopImportsNext done summarised
- External uid -> do
- -- Pass an updated hsc_env to loopUnit, as each unit might
- -- have a different visible package database.
- let hsc_env' = hscSetActiveHomeUnit home_unit hsc_env
- let done' = loopUnit hsc_env' done [uid]
- (other_deps, done'', summarised') <- loopImportsNext done' summarised
- return (mkModuleEdge imp (NodeKey_ExternalUnit uid) : other_deps, done'', summarised')
- FoundInstantiation iud -> do
- (other_deps, done', summarised') <- loopImportsNext done summarised
- return (mkModuleEdge imp (NodeKey_Unit iud) : other_deps, done', summarised')
- FoundHomeWithError (_uid, e) -> loopImportsNext done (Map.insert cache_key [(Left e)] summarised)
- FoundHome s -> do
- (done', summarised') <-
- loopModuleNodeInfo s (done, Map.insert cache_key [Right s] summarised)
- (other_deps, final_done, final_summarised) <- loopImportsNext done' summarised'
-
- -- MP: This assumes that we can only instantiate non home units, which is probably fair enough for now.
- return (mkModuleEdge imp (NodeKey_Module (mnKey s)) : other_deps, final_done, final_summarised)
- where
- loopImportsNext = loopImports home_uid ss
- cache_key = (home_uid, mb_pkg, unLoc <$> gwib)
- GWIB { gwib_mod = L loc mod, gwib_isBoot = is_boot } = gwib
- wanted_mod = L loc mod
-
-loopUnit :: HscEnv -> Map.Map NodeKey ModuleGraphNode -> [UnitId] -> Map.Map NodeKey ModuleGraphNode
-loopUnit _ cache [] = cache
-loopUnit lcl_hsc_env cache (u:uxs) = do
- let nk = (NodeKey_ExternalUnit u)
- case Map.lookup nk cache of
- Just {} -> loopUnit lcl_hsc_env cache uxs
- Nothing -> case unitDepends <$> lookupUnitId (hsc_units lcl_hsc_env) u of
- Just us -> loopUnit lcl_hsc_env (loopUnit lcl_hsc_env (Map.insert nk (UnitNode us u) cache) us) uxs
- Nothing -> pprPanic "loopUnit" (text "Malformed package database, missing " <+> ppr u)
-
-multiRootsErr :: SourceErrorContext -> [ModuleNodeInfo] -> IO ()
-multiRootsErr _ [] = panic "multiRootsErr"
-multiRootsErr sec summs@(summ1:_)
+ DownsweepEnv hsc_env mode summaries_cache_ref imports_cache_ref excl_mods <- ask
+ liftIO $ case mode of
+ DownsweepUseCompile ->
+ summariseModule hsc_env home_unit summaries_cache_ref imports_cache_ref
+ is_boot wanted_mod mb_pkg maybe_buf excl_mods
+ DownsweepUseFixed ->
+ summariseModuleInterface hsc_env home_unit imports_cache_ref is_boot
+ wanted_mod mb_pkg excl_mods
+
+multiRootsErr :: SourceErrorContext -> NE.NonEmpty ModuleNodeInfo -> IO ()
+multiRootsErr sec (summ1 NE.:| summs)
= throwOneError sec $ fmap GhcDriverMessage $
mkPlainErrorMsgEnvelope noSrcSpan $ DriverDuplicatedModuleDeclaration mod files
where
mod = moduleNodeInfoModule summ1
- files = mapMaybe (ml_hs_file . moduleNodeInfoLocation) summs
+ files = mapMaybe (ml_hs_file . moduleNodeInfoLocation) (summ1:summs)
moduleNotFoundErr :: UnitId -> ModuleName -> DriverMessages
moduleNotFoundErr uid mod = singleMessage $ mkPlainErrorMsgEnvelope noSrcSpan (DriverModuleNotFound uid mod)
@@ -734,24 +767,25 @@ linkNodes summaries uid hue =
getRootSummary ::
[ModuleName] ->
- M.Map (UnitId, OsPath) ModSummary ->
+ ModSummaryCache ->
+ ImportsCache ->
HscEnv ->
Target ->
IO (Either DriverMessages ModSummary)
-getRootSummary excl_mods old_summary_map hsc_env target
+getRootSummary excl_mods summ_cache imports_cache hsc_env target
| TargetFile file mb_phase <- targetId
= do
let offset_file = augmentByWorkingDirectory dflags file
exists <- liftIO $ doesFileExist offset_file
if exists || isJust maybe_buf
- then summariseFile hsc_env home_unit old_summary_map offset_file mb_phase
+ then summariseFile hsc_env home_unit summ_cache offset_file mb_phase
maybe_buf
else
return $ Left $ singleMessage $
mkPlainErrorMsgEnvelope noSrcSpan (DriverFileNotFound offset_file)
| TargetModule modl <- targetId
= do
- maybe_summary <- summariseModule hsc_env home_unit old_summary_map NotBoot
+ maybe_summary <- summariseModule hsc_env home_unit summ_cache imports_cache NotBoot
(L rootLoc modl) (ThisPkg (homeUnitId home_unit))
maybe_buf excl_mods
pure case maybe_summary of
@@ -1179,13 +1213,6 @@ Potential TODOS:
generating temporary ones.
-}
--- | Populate the Downsweep cache with the root modules.
-mkRootMap
- :: [ModuleNodeInfo]
- -> DownsweepCache
-mkRootMap summaries = Map.fromListWith (flip (++))
- [ ((moduleNodeInfoUnitId s, NoPkgQual, moduleNodeInfoMnwib s), [Right s]) | s <- summaries ]
-
-----------------------------------------------------------------------------
-- Summarising modules
@@ -1202,33 +1229,35 @@ mkRootMap summaries = Map.fromListWith (flip (++))
summariseFile
:: HscEnv
-> HomeUnit
- -> M.Map (UnitId, OsPath) ModSummary -- old summaries
+ -> ModSummaryCache
-> FilePath -- source file name
-> Maybe Phase -- start phase
-> Maybe (StringBuffer,UTCTime)
-> IO (Either DriverMessages ModSummary)
-summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf
- -- we can use a cached summary if one is available and the
- -- source file hasn't changed,
- | Just old_summary <- M.lookup (homeUnitId home_unit, src_fn_os) old_summaries
- = do
- let location = ms_location $ old_summary
-
- src_hash <- get_src_hash
- -- The file exists; we checked in getRootSummary above.
- -- If it gets removed subsequently, then this
- -- getFileHash may fail, but that's the right
- -- behaviour.
-
- -- return the cached summary if the source didn't change
- checkSummaryHash
- hsc_env (new_summary src_fn)
- old_summary location src_hash
-
- | otherwise
- = do src_hash <- get_src_hash
- new_summary src_fn src_hash
+summariseFile hsc_env' home_unit summ_cache_ref src_fn mb_phase maybe_buf
+ = do file_summ_cache <- readIORef summ_cache_ref
+ case M.lookup (homeUnitId home_unit, src_fn_os) file_summ_cache of
+ Just (Right (chd_summary, SummFresh)) ->
+ -- Fresh: use it straight away
+ pure (Right chd_summary)
+ Just (Right (old_summary, SummOld)) -> do
+ -- we can use a cached summary if one is available and the
+ -- source file hasn't changed,
+ let location = ms_location $ old_summary
+
+ src_hash <- get_src_hash
+ -- The file exists; we checked in getRootSummary above.
+ -- If it gets removed subsequently, then this
+ -- getFileHash may fail, but that's the right
+ -- behaviour.
+
+ -- return the cached summary if the source didn't change
+ checkSummaryHash
+ hsc_env (new_summary src_fn)
+ old_summary location src_hash
+ _ -> do src_hash <- get_src_hash
+ new_summary src_fn src_hash
where
-- change the main active unit so all operations happen relative to the given unit
hsc_env = hscSetActiveHomeUnit home_unit hsc_env'
@@ -1239,7 +1268,8 @@ summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf
Just (buf,_) -> return $ fingerprintStringBuffer buf
Nothing -> liftIO $ getFileHash src_fn
- new_summary src_fn src_hash = runExceptT $ do
+ new_summary src_fn src_hash = do
+ res <- runExceptT $ do
preimps@PreprocessedImports {..}
<- getPreprocessedImports hsc_env src_fn mb_phase maybe_buf
@@ -1270,6 +1300,10 @@ summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf
, nms_mod = mod
, nms_preimps = preimps
}
+ modifySummCache summ_cache_ref $ case res of
+ Left e -> M.insert (homeUnitId home_unit, src_fn_os) (Left e)
+ Right ms -> addModSummaryCache ms SummFresh
+ return res
checkSummaryHash
:: HscEnv
@@ -1322,15 +1356,16 @@ data SummariseResult =
-- --make mode.
summariseModule :: HscEnv
-> HomeUnit
- -> M.Map (UnitId, OsPath) ModSummary
+ -> ModSummaryCache
+ -> ImportsCache
-> IsBootInterface
-> Located ModuleName
-> PkgQual
-> Maybe (StringBuffer, UTCTime)
-> [ModuleName]
-> IO SummariseResult
-summariseModule hsc_env home_unit old_summaries is_boot wanted_mod mb_pkg maybe_buf excl_mods =
- summariseModuleDispatch k hsc_env home_unit is_boot wanted_mod mb_pkg excl_mods
+summariseModule hsc_env home_unit old_summaries imps_cache is_boot wanted_mod mb_pkg maybe_buf excl_mods =
+ summariseModuleDispatch k hsc_env imps_cache home_unit is_boot wanted_mod mb_pkg excl_mods
where
k = summariseModuleWithSource home_unit old_summaries is_boot maybe_buf
@@ -1339,13 +1374,14 @@ summariseModule hsc_env home_unit old_summaries is_boot wanted_mod mb_pkg maybe_
-- This version always returns a ModuleNodeFixed node.
summariseModuleInterface :: HscEnv
-> HomeUnit
+ -> ImportsCache
-> IsBootInterface
-> Located ModuleName
-> PkgQual
-> [ModuleName]
-> IO SummariseResult
-summariseModuleInterface hsc_env home_unit is_boot wanted_mod mb_pkg excl_mods =
- summariseModuleDispatch k hsc_env home_unit is_boot wanted_mod mb_pkg excl_mods
+summariseModuleInterface hsc_env home_unit imps_cache is_boot wanted_mod mb_pkg excl_mods =
+ summariseModuleDispatch k hsc_env imps_cache home_unit is_boot wanted_mod mb_pkg excl_mods
where
k _hsc_env loc mod = do
-- The finder will return a path to the .hi-boot even if it doesn't actually
@@ -1362,6 +1398,7 @@ summariseModuleInterface hsc_env home_unit is_boot wanted_mod mb_pkg excl_mods =
summariseModuleDispatch
:: (HscEnv -> ModLocation -> Module -> IO SummariseResult) -- ^ Continuation about how to summarise a home module.
-> HscEnv
+ -> ImportsCache
-> HomeUnit
-> IsBootInterface -- True <=> a {-# SOURCE #-} import
-> Located ModuleName -- Imported module to be summarised
@@ -1370,7 +1407,7 @@ summariseModuleDispatch
-> IO SummariseResult
-summariseModuleDispatch k hsc_env' home_unit is_boot (L _ wanted_mod) mb_pkg excl_mods
+summariseModuleDispatch k hsc_env' imps_cache_ref home_unit is_boot (L _ wanted_mod) mb_pkg excl_mods
| wanted_mod `elem` excl_mods
= return NotThere
| otherwise = find_it
@@ -1380,37 +1417,44 @@ summariseModuleDispatch k hsc_env' home_unit is_boot (L _ wanted_mod) mb_pkg exc
hsc_env = hscSetActiveHomeUnit home_unit hsc_env'
find_it :: IO SummariseResult
-
find_it = do
- found <- findImportedModuleWithIsBoot hsc_env wanted_mod is_boot mb_pkg
- case found of
- Found location mod
- | moduleUnitId mod `Set.member` hsc_all_home_unit_ids hsc_env ->
- -- Home package
- k hsc_env location mod
- | VirtUnit iud <- moduleUnit mod
- , not (isHomeModule home_unit mod)
- -> return $ FoundInstantiation iud
- | otherwise -> return $ External (moduleUnitId mod)
- _ -> return NotThere
- -- Not found
- -- (If it is TRULY not found at all, we'll
- -- error when we actually try to compile)
-
+ imps_cache <- readIORef imps_cache_ref
+ case M.lookup cache_key imps_cache of
+ Just result -> return result
+ Nothing -> do
+ found <- findImportedModuleWithIsBoot hsc_env wanted_mod is_boot mb_pkg
+ r <- case found of
+ Found location mod
+ | moduleUnitId mod `Set.member` hsc_all_home_unit_ids hsc_env ->
+ -- Home package
+ k hsc_env location mod
+ | VirtUnit iud <- moduleUnit mod
+ , not (isHomeModule home_unit mod)
+ -> return $ FoundInstantiation iud
+ | otherwise -> return $ External (moduleUnitId mod)
+ _ -> return NotThere
+ -- Not found
+ -- (If it is TRULY not found at all, we'll
+ -- error when we actually try to compile)
+ modifyImpsCache imps_cache_ref (M.insert cache_key r)
+ return r
+
+ cache_key = ( homeUnitId home_unit, mb_pkg
+ , GWIB{ gwib_mod = wanted_mod, gwib_isBoot = is_boot })
-- | The continuation to summarise a home module if we want to find the source file
-- for it and potentially compile it.
summariseModuleWithSource
:: HomeUnit
- -> M.Map (UnitId, OsPath) ModSummary
- -- ^ Map of old summaries
+ -> ModSummaryCache
+ -- ^ Cache of constructed summaries
-> IsBootInterface -- True <=> a {-# SOURCE #-} import
-> Maybe (StringBuffer, UTCTime)
-> HscEnv
-> ModLocation
-> Module
-> IO SummariseResult
-summariseModuleWithSource home_unit old_summary_map is_boot maybe_buf hsc_env location mod = do
+summariseModuleWithSource home_unit summ_cache_ref is_boot maybe_buf hsc_env location mod = do
-- Adjust location to point to the hs-boot source file,
-- hi file, object file, when is_boot says so
let src_fn = expectJust (ml_hs_file location)
@@ -1430,20 +1474,22 @@ summariseModuleWithSource home_unit old_summary_map is_boot maybe_buf hsc_env lo
where
dflags = hsc_dflags hsc_env
- new_summary_cache_check loc mod src_fn h
- | Just old_summary <- Map.lookup ((toUnitId (moduleUnit mod), src_fn_os)) old_summary_map =
-
- -- check the hash on the source file, and
- -- return the cached summary if it hasn't changed. If the
- -- file has changed then need to resummarise.
- case maybe_buf of
- Just (buf,_) ->
- checkSummaryHash hsc_env (new_summary loc mod src_fn) old_summary loc (fingerprintStringBuffer buf)
- Nothing ->
- checkSummaryHash hsc_env (new_summary loc mod src_fn) old_summary loc h
- | otherwise = new_summary loc mod src_fn h
- where
- src_fn_os = unsafeEncodeUtf src_fn
+ new_summary_cache_check loc mod src_fn h = do
+ summ_cache <- readIORef summ_cache_ref
+ case ml_hs_file_ospath loc >>= \p -> M.lookup (moduleUnitId mod, p) summ_cache of
+ Just (Right (chd_summary, SummFresh)) ->
+ -- Fresh! just return it
+ pure (Right chd_summary)
+ Just (Right (old_summary, SummOld)) -> do
+ -- check the hash on the source file, and
+ -- return the cached summary if it hasn't changed. If the
+ -- file has changed then need to resummarise.
+ case maybe_buf of
+ Just (buf,_) ->
+ checkSummaryHash hsc_env (new_summary loc mod src_fn) old_summary loc (fingerprintStringBuffer buf)
+ Nothing ->
+ checkSummaryHash hsc_env (new_summary loc mod src_fn) old_summary loc h
+ _ -> new_summary loc mod src_fn h
new_summary :: ModLocation
-> Module
@@ -1451,41 +1497,48 @@ summariseModuleWithSource home_unit old_summary_map is_boot maybe_buf hsc_env lo
-> Fingerprint
-> IO (Either DriverMessages ModSummary)
new_summary location mod src_fn src_hash
- = runExceptT $ do
- preimps@PreprocessedImports {..}
- -- Remember to set the active unit here, otherwise the wrong include paths are passed to CPP
- -- See multiHomeUnits_cpp2 test
- <- getPreprocessedImports (hscSetActiveUnitId (moduleUnitId mod) hsc_env) src_fn Nothing maybe_buf
-
- -- NB: Despite the fact that is_boot is a top-level parameter, we
- -- don't actually know coming into this function what the HscSource
- -- of the module in question is. This is because we may be processing
- -- this module because another module in the graph imported it: in this
- -- case, we know if it's a boot or not because of the {-# SOURCE #-}
- -- annotation, but we don't know if it's a signature or a regular
- -- module until we actually look it up on the filesystem.
- let hsc_src
- | is_boot == IsBoot = HsBootFile
- | isHaskellSigFilename src_fn = HsigFile
- | otherwise = HsSrcFile
-
- when (pi_mod_name /= moduleName mod) $
- throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc
- $ DriverFileModuleNameMismatch pi_mod_name (moduleName mod)
-
- let instantiations = homeUnitInstantiations home_unit
- when (hsc_src == HsigFile && isNothing (lookup pi_mod_name instantiations)) $
- throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc
- $ DriverUnexpectedSignature pi_mod_name (checkBuildingCabalPackage dflags) instantiations
-
- liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary
- { nms_src_fn = src_fn
- , nms_src_hash = src_hash
- , nms_hsc_src = hsc_src
- , nms_location = location
- , nms_mod = mod
- , nms_preimps = preimps
- }
+ = do
+ res <- runExceptT $ do
+ preimps@PreprocessedImports {..}
+ -- Remember to set the active unit here, otherwise the wrong include paths are passed to CPP
+ -- See multiHomeUnits_cpp2 test
+ <- getPreprocessedImports (hscSetActiveUnitId (moduleUnitId mod) hsc_env) src_fn Nothing maybe_buf
+
+ -- NB: Despite the fact that is_boot is a top-level parameter, we
+ -- don't actually know coming into this function what the HscSource
+ -- of the module in question is. This is because we may be processing
+ -- this module because another module in the graph imported it: in this
+ -- case, we know if it's a boot or not because of the {-# SOURCE #-}
+ -- annotation, but we don't know if it's a signature or a regular
+ -- module until we actually look it up on the filesystem.
+ let hsc_src
+ | is_boot == IsBoot = HsBootFile
+ | isHaskellSigFilename src_fn = HsigFile
+ | otherwise = HsSrcFile
+
+ when (pi_mod_name /= moduleName mod) $
+ throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc
+ $ DriverFileModuleNameMismatch pi_mod_name (moduleName mod)
+
+ let instantiations = homeUnitInstantiations home_unit
+ when (hsc_src == HsigFile && isNothing (lookup pi_mod_name instantiations)) $
+ throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc
+ $ DriverUnexpectedSignature pi_mod_name (checkBuildingCabalPackage dflags) instantiations
+
+ liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary
+ { nms_src_fn = src_fn
+ , nms_src_hash = src_hash
+ , nms_hsc_src = hsc_src
+ , nms_location = location
+ , nms_mod = mod
+ , nms_preimps = preimps
+ }
+ modifySummCache summ_cache_ref $ case res of
+ Left e -> case ml_hs_file_ospath location of
+ Just p -> M.insert (moduleUnitId mod, p) (Left e)
+ Nothing -> id
+ Right ms -> addModSummaryCache ms SummFresh
+ return res
-- | Convenience named arguments for 'makeNewModSummary' only used to make
-- code more readable, not exported.
@@ -1568,3 +1621,78 @@ getPreprocessedImports hsc_env src_fn mb_phase maybe_buf = do
let pi_srcimps = pi_srcimps'
let pi_theimps = rn_imps pi_theimps'
return PreprocessedImports {..}
+
+--------------------------------------------------------------------------------
+
+-- | In a depth-first order, and starting from the given roots, traverse a
+-- graph by iteratively expanding the visited nodes and accumulating a payload
+-- for each explored node.
+--
+-- The same node is NEVER visited more than once, as long as the the node key
+-- @k@, computed from the node @n@, uniquely identifies that node.
+--
+-- Example: @n@ is instanced to @DownsweepNode@, @k@ is @NodeKey@, and @v@ is @ModuleNodeEdge@.
+--
+-- Returning 'Nothing' in the @expand@ function means that node couldn't be
+-- expanded yet, and we should continue without failure. We do not cache a
+-- "negative" result for the 'Nothing', because we may yet discover new
+-- information (in the monadic context) and try to expand that node in the
+-- future again, then successfully.
+--
+-- See also Note [Downsweep Control Flow and Caching]
+dfsBuild :: (Ord k, Monad m, Outputable n) => Maybe (Map.Map k v) -> [n] -> (n -> k) -> (n -> m (Maybe (v,[n]))) -> m (Map.Map k v)
+dfsBuild base_map roots key expand = go roots (fromMaybe Map.empty base_map)
+ where
+ go [] visited = pure visited
+ go (s:ss) visited
+ | k `Map.member` visited
+ = go ss visited
+ | otherwise
+ = do r <- expand s
+ case r of
+ Nothing -> go ss visited -- Skip!
+ Just (v,ns) ->
+ go (ns ++ ss {- todo: not use ++ here? -})
+ (Map.insert k v visited)
+ where
+ k = key s
+
+{-
+Note [Downsweep Control Flow and Caching]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The control flow of downsweep is extracted into a single function `dfsBuild`,
+which takes care of iteratively expanding and traversing all nodes of the
+in-construction module graph necessary to build a full `ModuleGraph` at the
+end.
+
+There are three levels of caching going on, all of which are necessary
+to make sure we don't do repeated work (specifically: NEVER summarise
+the same module twice).
+
+1. `dfsBuild` accumulates the final module graph and never revisits the
+ same node of the module graph. Cache is keyed by the final
+ `ModuleGraph`s `NodeKey`s.
+
+2. For Module A in home-unit u1, each import in the list of imports
+ needs to be *found* (call to `findImportedModuleWithIsBoot`): at this
+ point, we only have the `ModuleName` of the import, not the `Module`.
+ This *finding* is somewhat expensive, so we cache it as well
+ (`ImportsCache`). The cache key is the home-unit to which the module
+ belongs~[1], the import package qualifier, and the ModuleName.
+
+ [1] Different home-units will have different package flags, which means
+ potentially different `Module` resolution for the same `ModuleName`.
+
+3. The most expensive operation we want to avoid is summarising a
+ `Module` into a `ModSummary`, which notably involves parsing the
+ module header from scratch.
+ The third cache, in essence, maps a `Module` to its `ModSummary`
+ (named `ModSummaryCache`). This cache upholds the invariant: we NEVER
+ summarise the same module twice. In practice, the cache key is the
+ Module's UnitId and the Source path; the reason is we need to
+ distinguish between `.hs` and `.hs-boot` files, as their summaries
+ will differ.
+
+ Note that (2) can't guarantee this alone: Two ModuleName imports in
+ separate units can (and likely do) map to the same `Module`.
+-}
=====================================
utils/check-ppr/Main.hs
=====================================
@@ -18,6 +18,7 @@ import System.Environment( getArgs )
import System.Exit
import System.FilePath
import System.IO
+import Data.IORef
usage :: String
usage = unlines
@@ -85,7 +86,8 @@ parseOneFile libdir fileName = do
let dflags2 = dflags `gopt_set` Opt_KeepRawTokenStream
_ <- setSessionDynFlags dflags2
hsc_env <- getSession
- mms <- liftIO $ summariseFile hsc_env (hsc_home_unit hsc_env) mempty fileName Nothing Nothing
+ cache <- liftIO $ newIORef mempty
+ mms <- liftIO $ summariseFile hsc_env (hsc_home_unit hsc_env) cache fileName Nothing Nothing
case mms of
Left _err -> error "parseOneFile"
Right ms -> parseModule ms
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/513ff655640914d3612c0f6d5ab5151…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/513ff655640914d3612c0f6d5ab5151…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/sjakobi/unbox-enums] 3 commits: testsuite: accept goldens for the -funbox-strict-enums default
by Simon Jakobi (＠sjakobi2) 11 Jul '26
by Simon Jakobi (＠sjakobi2) 11 Jul '26
11 Jul '26
Simon Jakobi pushed to branch wip/sjakobi/unbox-enums at Glasgow Haskell Compiler / GHC
Commits:
936ffa57 by Simon Jakobi at 2026-07-11T09:46:46+02:00
testsuite: accept goldens for the -funbox-strict-enums default
The Cmm dumps of inferTags002/inferTags003 and the static closure
layout in T25166 change now that strict Bool fields are unpacked
without an UNPACK pragma. The tests' original concerns are unaffected;
T25166's static closure demonstrates the improvement, shrinking from
4 words to 2.
Assisted-by: Claude Fable 5
- - - - -
b5ba02a8 by Simon Jakobi at 2026-07-11T09:47:04+02:00
x86 NCG: use scaled-index addressing for shifted indices with a literal base
getAmode only used a scaled-index addressing mode for (y << shift)
when combined with a base register, so (y << shift) + lit computed the
shift in a separate instruction. Match this pattern directly, folding a
constant index adjustment ((y +/- c) << shift) into the displacement.
This particularly benefits tagToEnum#'s closure-table lookup, which
indexes with a 1-based tag: boxing an unpacked enum field previously
took movzbl; dec; shl; mov and is now movzbl; mov with the -1
folded into the table label's offset.
Assisted-by: Claude Fable 5
- - - - -
6fef1d8b by Simon Jakobi at 2026-07-11T09:56:00+02:00
testsuite: give T26537 a compile timeout multiplier
With a non-perf (e.g. quick-flavour) compiler, -fregs-graph takes
~260s on this test, so it flaps against the default 300s timeout
whenever the machine is loaded.
Assisted-by: Claude Fable 5
- - - - -
8 changed files:
- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- testsuite/tests/codeGen/should_compile/T25166.stdout-ws-64
- testsuite/tests/codeGen/should_gen_asm/all.T
- + testsuite/tests/codeGen/should_gen_asm/enum-closure-tbl-amode.asm
- + testsuite/tests/codeGen/should_gen_asm/enum-closure-tbl-amode.hs
- testsuite/tests/codeGen/should_run/all.T
- testsuite/tests/simplStg/should_compile/inferTags002.stderr
- testsuite/tests/simplStg/should_compile/inferTags003.stderr
Changes:
=====================================
compiler/GHC/CmmToAsm/X86/CodeGen.hs
=====================================
@@ -3491,6 +3491,28 @@ getAmode e = do
let off = ImmInt (-(fromInteger i))
return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code)
+ -- Matches: (y << shift) + lit, e.g. indexing a closure table by an
+ -- enum's tag: use a scaled-index addressing mode with no base register.
+ -- A constant adjustment of the index, ((y ± c) << shift) + lit, is
+ -- folded into the displacement: lit ± (c << shift).
+ -- Must come before the generic (x + lit) case below, which would
+ -- compute the shift in a separate instruction.
+ CmmMachOp (MO_Add _) [CmmMachOp (MO_Shl _) [y0, CmmLit (CmmInt shift _)], CmmLit lit0]
+ | shift == 0 || shift == 1 || shift == 2 || shift == 3
+ , (y, lit) <- case y0 of
+ CmmMachOp (MO_Add _) [y', CmmLit (CmmInt c _)]
+ | let off = c * 2 ^ shift, abs off < 2 ^ (31 :: Int)
+ -> (y', cmmOffsetLit lit0 (fromInteger off))
+ CmmMachOp (MO_Sub _) [y', CmmLit (CmmInt c _)]
+ | let off = negate c * 2 ^ shift, abs off < 2 ^ (31 :: Int)
+ -> (y', cmmOffsetLit lit0 (fromInteger off))
+ _ -> (y0, lit0)
+ , is32BitLit platform lit
+ -> do
+ (y_reg, y_code) <- getSomeReg y
+ let scale = case shift of 0 -> 1; 1 -> 2; 2 -> 4; _ -> 8
+ return (Amode (AddrBaseIndex EABaseNone (EAIndex y_reg scale) (litToImm lit)) y_code)
+
CmmMachOp (MO_Add _rep) [x, CmmLit lit]
| is32BitLit platform lit
-- assert (rep == II32)???
=====================================
testsuite/tests/codeGen/should_compile/T25166.stdout-ws-64
=====================================
@@ -1,9 +1,7 @@
[section ""data" . Test.foo_closure" {
Test.foo_closure:
const Test.D_con_info;
- const GHC.Internal.Types.True_closure+2;
const 2 :: W8;
- const 0 :: W8;
+ const 2 :: W8;
const 0 :: W16;
const 0 :: W32;
- const 3;
=====================================
testsuite/tests/codeGen/should_gen_asm/all.T
=====================================
@@ -33,3 +33,6 @@ test('aarch64-ushr-subword', is_aarch64_codegen, compile_grep_asm, ['hs', True,
test('aarch64-shl-subword', is_aarch64_codegen, compile_grep_asm, ['hs', True, '-O'])
test('aarch64-sxtw', is_aarch64_codegen, compile_grep_asm, ['cmm', True, ''])
test('aarch64-sxth-mul2', is_aarch64_codegen, compile_grep_asm, ['cmm', True, ''])
+
+# Scaled-index addressing for tagToEnum# closure-table lookups
+test('enum-closure-tbl-amode', is_amd64_codegen, compile_grep_asm, ['hs', False, ''])
=====================================
testsuite/tests/codeGen/should_gen_asm/enum-closure-tbl-amode.asm
=====================================
@@ -0,0 +1 @@
+Color_closure_tbl\+-8\(,%r[a-z0-9]+,8\)
=====================================
testsuite/tests/codeGen/should_gen_asm/enum-closure-tbl-amode.hs
=====================================
@@ -0,0 +1,11 @@
+-- Boxing an automatically unpacked enum field (tagToEnum#) should index the
+-- closure table in a single scaled-index addressing mode, with the 1-based
+-- tag adjustment folded into the label offset.
+module EnumClosureTblAmode where
+
+data Color = Red | Green | Blue | Yellow | Purple
+
+data Rec = Rec !Bool !Color
+
+getColor :: Rec -> Color
+getColor (Rec _ c) = c
=====================================
testsuite/tests/codeGen/should_run/all.T
=====================================
@@ -258,7 +258,9 @@ test('T24893', normal, compile_and_run, ['-O'])
test('CCallConv', [req_c], compile_and_run, ['CCallConv_c.c'])
test('T25364', normal, compile_and_run, [''])
test('T26061', normal, compile_and_run, [''])
-test('T26537', normal, compile_and_run, ['-O2 -fregs-graph'])
+# The graph allocator needs several minutes for this on a non-perf
+# (e.g. quick-flavour) compiler, close to the default timeout.
+test('T26537', compile_timeout_multiplier(3), compile_and_run, ['-O2 -fregs-graph'])
test('T24016', normal, compile_and_run, ['-O1 -fPIC'])
test('T27046',
[ req_cmm
=====================================
testsuite/tests/simplStg/should_compile/inferTags002.stderr
=====================================
@@ -1,88 +1,98 @@
==================== Output Cmm ====================
-[M.f_entry() { // [R2]
- { info_tbls: [(cAs,
+[M.$WMkT_entry() { // [R3, R2]
+ { info_tbls: [(co3,
label: block_info
- rep: StackRep []
+ rep: StackRep [False]
srt: Nothing),
- (cAv,
- label: M.f_info
- rep: HeapRep static { Fun {arity: 1 fun_type: ArgSpec 5} }
+ (co6,
+ label: M.$WMkT_info
+ rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 15} }
+ srt: Nothing),
+ (cok,
+ label: block_info
+ rep: StackRep [True]
srt: Nothing)]
stack_info: arg_space: 8
}
{offset
_lbl_: // global
- if ((Sp + -8) < SpLim) (likely: False) goto cAw; else goto cAx;
+ if ((Sp + -16) < SpLim) (likely: False) goto con; else goto coo;
_lbl_: // global
- R1 = M.f_closure;
- call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8;
+ R1 = M.$WMkT_closure;
+ call (stg_gc_fun)(R3, R2, R1) args: 8, res: 0, upd: 8;
_lbl_: // global
- I64[Sp - 8] = cAs;
+ I64[Sp - 16] = co3;
R1 = R2;
- Sp = Sp - 8;
- if (R1 & 7 != 0) goto cAs; else goto cAt;
+ P64[Sp - 8] = R3;
+ Sp = Sp - 16;
+ if (R1 & 7 != 0) goto co3; else goto co4;
_lbl_: // global
- call (I64[R1])(R1) returns to cAs, args: 8, res: 8, upd: 8;
+ call (I64![R1])(R1) returns to co3, args: 8, res: 8, upd: 8;
_lbl_: // global
- R1 = P64[R1 + 15];
- Sp = Sp + 8;
+ I64[Sp] = cok;
+ __locVar_::I8 = %MO_UU_Conv_W64_W8(R1 & 7 - 1 + 1);
+ R1 = P64[Sp + 8];
+ I8[Sp + 8] = __locVar_::I8;
+ call stg_ap_0_fast(R1) returns to cok, args: 8, res: 8, upd: 8;
+ _lbl_: // global
+ Hp = Hp + 24;
+ if (Hp > HpLim) (likely: False) goto cos; else goto cor;
+ _lbl_: // global
+ HpAlloc = 24;
+ call stg_gc_unpt_r1(R1) returns to cok, args: 8, res: 8, upd: 8;
+ _lbl_: // global
+ I64[Hp - 16] = M.MkT_con_info;
+ P64[Hp - 8] = R1;
+ I8[Hp] = I8[Sp + 8];
+ R1 = Hp - 15;
+ Sp = Sp + 16;
call (P64[Sp])(R1) args: 8, res: 0, upd: 8;
}
},
- section ""data" . M.f_closure" {
- M.f_closure:
- const M.f_info;
+ section ""data" . M.$WMkT_closure" {
+ M.$WMkT_closure:
+ const M.$WMkT_info;
}]
==================== Output Cmm ====================
[M.MkT_entry() { // [R3, R2]
- { info_tbls: [(cAJ,
+ { info_tbls: [(cox,
label: block_info
- rep: StackRep [False]
+ rep: StackRep [True]
srt: Nothing),
- (cAM,
+ (coA,
label: M.MkT_info
- rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 15} }
- srt: Nothing),
- (cAP,
- label: block_info
- rep: StackRep [False]
+ rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 13} }
srt: Nothing)]
stack_info: arg_space: 8
}
{offset
_lbl_: // global
- if ((Sp + -16) < SpLim) (likely: False) goto cAS; else goto cAT;
+ __locVar_::I8 = %MO_XX_Conv_W64_W8(R2);
+ if ((Sp + -16) < SpLim) (likely: False) goto coB; else goto coC;
_lbl_: // global
+ R2 = %MO_XX_Conv_W8_W64(__locVar_::I8);
R1 = M.MkT_closure;
call (stg_gc_fun)(R3, R2, R1) args: 8, res: 0, upd: 8;
_lbl_: // global
- I64[Sp - 16] = cAJ;
- R1 = R2;
- P64[Sp - 8] = R3;
+ I64[Sp - 16] = cox;
+ R1 = R3;
+ I8[Sp - 8] = __locVar_::I8;
Sp = Sp - 16;
- if (R1 & 7 != 0) goto cAJ; else goto cAK;
- _lbl_: // global
- call (I64[R1])(R1) returns to cAJ, args: 8, res: 8, upd: 8;
- _lbl_: // global
- I64[Sp] = cAP;
- __locVar_::P64 = R1;
- R1 = P64[Sp + 8];
- P64[Sp + 8] = __locVar_::P64;
- call stg_ap_0_fast(R1) returns to cAP, args: 8, res: 8, upd: 8;
+ call stg_ap_0_fast(R1) returns to cox, args: 8, res: 8, upd: 8;
_lbl_: // global
Hp = Hp + 24;
- if (Hp > HpLim) (likely: False) goto cAX; else goto cAW;
+ if (Hp > HpLim) (likely: False) goto coF; else goto coE;
_lbl_: // global
HpAlloc = 24;
- call stg_gc_unpt_r1(R1) returns to cAP, args: 8, res: 8, upd: 8;
+ call stg_gc_unpt_r1(R1) returns to cox, args: 8, res: 8, upd: 8;
_lbl_: // global
I64[Hp - 16] = M.MkT_con_info;
- P64[Hp - 8] = P64[Sp + 8];
- P64[Hp] = R1;
+ P64[Hp - 8] = R1;
+ I8[Hp] = I8[Sp + 8];
R1 = Hp - 15;
Sp = Sp + 16;
call (P64[Sp])(R1) args: 8, res: 0, upd: 8;
@@ -95,11 +105,49 @@
+==================== Output Cmm ====================
+[M.f_entry() { // [R2]
+ { info_tbls: [(coK,
+ label: block_info
+ rep: StackRep []
+ srt: Nothing),
+ (coN,
+ label: M.f_info
+ rep: HeapRep static { Fun {arity: 1 fun_type: ArgSpec 5} }
+ srt: Nothing)]
+ stack_info: arg_space: 8
+ }
+ {offset
+ _lbl_: // global
+ if ((Sp + -8) < SpLim) (likely: False) goto coO; else goto coP;
+ _lbl_: // global
+ R1 = M.f_closure;
+ call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8;
+ _lbl_: // global
+ I64[Sp - 8] = coK;
+ R1 = R2;
+ Sp = Sp - 8;
+ if (R1 & 7 != 0) goto coK; else goto coL;
+ _lbl_: // global
+ call (I64![R1])(R1) returns to coK, args: 8, res: 8, upd: 8;
+ _lbl_: // global
+ R1 = P64[R1 + 7];
+ Sp = Sp + 8;
+ call (P64[Sp])(R1) args: 8, res: 0, upd: 8;
+ }
+ },
+ section ""data" . M.f_closure" {
+ M.f_closure:
+ const M.f_info;
+ }]
+
+
+
==================== Output Cmm ====================
[M.MkT_con_entry() { // []
- { info_tbls: [(cB3,
+ { info_tbls: [(coT,
label: M.MkT_con_info
- rep: HeapRep 2 ptrs { Con {tag: 0 descr:"main:M.MkT"} }
+ rep: HeapRep 1 ptrs 1 nonptrs { Con {tag: 0 descr:"main:M.MkT"} }
srt: Nothing)]
stack_info: arg_space: 8
}
=====================================
testsuite/tests/simplStg/should_compile/inferTags003.stderr
=====================================
@@ -1,88 +1,98 @@
==================== Output Cmm ====================
-[M.fun_entry() { // [R2]
- { info_tbls: [(cB9,
- label: block_cB9_info
- rep: StackRep []
+[M.$WMkT_entry() { // [R3, R2]
+ { info_tbls: [(cuS,
+ label: block_cuS_info
+ rep: StackRep [False]
srt: Nothing),
- (cBc,
- label: M.fun_info
- rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 5} }
+ (cuV,
+ label: M.$WMkT_info
+ rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 15} }
+ srt: Nothing),
+ (cv9,
+ label: block_cv9_info
+ rep: StackRep [True]
srt: Nothing)]
stack_info: arg_space: 8
}
{offset
- cBc: // global
- if ((Sp + -8) < SpLim) (likely: False) goto cBd; else goto cBe;
- cBd: // global
- R1 = M.fun_closure;
- call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8;
- cBe: // global
- I64[Sp - 8] = cB9;
+ cuV: // global
+ if ((Sp + -16) < SpLim) (likely: False) goto cvc; else goto cvd;
+ cvc: // global
+ R1 = M.$WMkT_closure;
+ call (stg_gc_fun)(R3, R2, R1) args: 8, res: 0, upd: 8;
+ cvd: // global
+ I64[Sp - 16] = cuS;
R1 = R2;
- Sp = Sp - 8;
- if (R1 & 7 != 0) goto cB9; else goto cBa;
- cBa: // global
- call (I64![R1])(R1) returns to cB9, args: 8, res: 8, upd: 8;
- cB9: // global
- R1 = P64[R1 + 15];
- Sp = Sp + 8;
+ P64[Sp - 8] = R3;
+ Sp = Sp - 16;
+ if (R1 & 7 != 0) goto cuS; else goto cuT;
+ cuT: // global
+ call (I64![R1])(R1) returns to cuS, args: 8, res: 8, upd: 8;
+ cuS: // global
+ I64[Sp] = cv9;
+ _tuy::I8 = %MO_UU_Conv_W64_W8(R1 & 7 - 1 + 1);
+ R1 = P64[Sp + 8];
+ I8[Sp + 8] = _tuy::I8;
+ call stg_ap_0_fast(R1) returns to cv9, args: 8, res: 8, upd: 8;
+ cv9: // global
+ Hp = Hp + 24;
+ if (Hp > HpLim) (likely: False) goto cvh; else goto cvg;
+ cvh: // global
+ HpAlloc = 24;
+ call stg_gc_unpt_r1(R1) returns to cv9, args: 8, res: 8, upd: 8;
+ cvg: // global
+ I64[Hp - 16] = M.MkT_con_info;
+ P64[Hp - 8] = R1;
+ I8[Hp] = I8[Sp + 8];
+ R1 = Hp - 15;
+ Sp = Sp + 16;
call (P64[Sp])(R1) args: 8, res: 0, upd: 8;
}
},
- section ""data" . M.fun_closure" {
- M.fun_closure:
- const M.fun_info;
+ section ""data" . M.$WMkT_closure" {
+ M.$WMkT_closure:
+ const M.$WMkT_info;
}]
==================== Output Cmm ====================
[M.MkT_entry() { // [R3, R2]
- { info_tbls: [(cBx,
- label: block_cBx_info
- rep: StackRep [False]
+ { info_tbls: [(cvm,
+ label: block_cvm_info
+ rep: StackRep [True]
srt: Nothing),
- (cBA,
+ (cvp,
label: M.MkT_info
- rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 15} }
- srt: Nothing),
- (cBD,
- label: block_cBD_info
- rep: StackRep [False]
+ rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 13} }
srt: Nothing)]
stack_info: arg_space: 8
}
{offset
- cBA: // global
- if ((Sp + -16) < SpLim) (likely: False) goto cBG; else goto cBH;
- cBG: // global
+ cvp: // global
+ _B0::I8 = %MO_XX_Conv_W64_W8(R2);
+ if ((Sp + -16) < SpLim) (likely: False) goto cvq; else goto cvr;
+ cvq: // global
+ R2 = %MO_XX_Conv_W8_W64(_B0::I8);
R1 = M.MkT_closure;
call (stg_gc_fun)(R3, R2, R1) args: 8, res: 0, upd: 8;
- cBH: // global
- I64[Sp - 16] = cBx;
- R1 = R2;
- P64[Sp - 8] = R3;
+ cvr: // global
+ I64[Sp - 16] = cvm;
+ R1 = R3;
+ I8[Sp - 8] = _B0::I8;
Sp = Sp - 16;
- if (R1 & 7 != 0) goto cBx; else goto cBy;
- cBy: // global
- call (I64![R1])(R1) returns to cBx, args: 8, res: 8, upd: 8;
- cBx: // global
- I64[Sp] = cBD;
- _tB0::P64 = R1;
- R1 = P64[Sp + 8];
- P64[Sp + 8] = _tB0::P64;
- call stg_ap_0_fast(R1) returns to cBD, args: 8, res: 8, upd: 8;
- cBD: // global
+ call stg_ap_0_fast(R1) returns to cvm, args: 8, res: 8, upd: 8;
+ cvm: // global
Hp = Hp + 24;
- if (Hp > HpLim) (likely: False) goto cBL; else goto cBK;
- cBL: // global
+ if (Hp > HpLim) (likely: False) goto cvu; else goto cvt;
+ cvu: // global
HpAlloc = 24;
- call stg_gc_unpt_r1(R1) returns to cBD, args: 8, res: 8, upd: 8;
- cBK: // global
+ call stg_gc_unpt_r1(R1) returns to cvm, args: 8, res: 8, upd: 8;
+ cvt: // global
I64[Hp - 16] = M.MkT_con_info;
- P64[Hp - 8] = P64[Sp + 8];
- P64[Hp] = R1;
+ P64[Hp - 8] = R1;
+ I8[Hp] = I8[Sp + 8];
R1 = Hp - 15;
Sp = Sp + 16;
call (P64[Sp])(R1) args: 8, res: 0, upd: 8;
@@ -95,16 +105,54 @@
+==================== Output Cmm ====================
+[M.fun_entry() { // [R2]
+ { info_tbls: [(cvz,
+ label: block_cvz_info
+ rep: StackRep []
+ srt: Nothing),
+ (cvC,
+ label: M.fun_info
+ rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 5} }
+ srt: Nothing)]
+ stack_info: arg_space: 8
+ }
+ {offset
+ cvC: // global
+ if ((Sp + -8) < SpLim) (likely: False) goto cvD; else goto cvE;
+ cvD: // global
+ R1 = M.fun_closure;
+ call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8;
+ cvE: // global
+ I64[Sp - 8] = cvz;
+ R1 = R2;
+ Sp = Sp - 8;
+ if (R1 & 7 != 0) goto cvz; else goto cvA;
+ cvA: // global
+ call (I64![R1])(R1) returns to cvz, args: 8, res: 8, upd: 8;
+ cvz: // global
+ R1 = P64[R1 + 7];
+ Sp = Sp + 8;
+ call (P64[Sp])(R1) args: 8, res: 0, upd: 8;
+ }
+ },
+ section ""data" . M.fun_closure" {
+ M.fun_closure:
+ const M.fun_info;
+ }]
+
+
+
==================== Output Cmm ====================
[M.MkT_con_entry() { // []
- { info_tbls: [(cBX,
+ { info_tbls: [(cvI,
label: M.MkT_con_info
- rep: HeapRep 2 ptrs { Con {tag: 0 descr:"main:M.MkT"} }
+ rep: HeapRep 1 ptrs 1 nonptrs { Con {tag: 0 descr:"main:M.MkT"} }
srt: Nothing)]
stack_info: arg_space: 8
}
{offset
- cBX: // global
+ cvI: // global
R1 = R1 + 1;
call (P64[Sp])(R1) args: 8, res: 0, upd: 8;
}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a268b2dbefce33a868b0c226f0d2c3…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a268b2dbefce33a868b0c226f0d2c3…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/sjakobi/mr16259] 2 commits: wasm: untag the Weak# obtained through a StablePtr in rts_promiseThrowTo
by Simon Jakobi (＠sjakobi2) 11 Jul '26
by Simon Jakobi (＠sjakobi2) 11 Jul '26
11 Jul '26
Simon Jakobi pushed to branch wip/sjakobi/mr16259 at Glasgow Haskell Compiler / GHC
Commits:
201c4864 by Simon Jakobi at 2026-07-11T09:00:05+02:00
wasm: untag the Weak# obtained through a StablePtr in rts_promiseThrowTo
Same defect class as the hs_try_putmvar fixes: the Weak# created around
a JSFFI export's TSO now carries tag 1 (#23173) and makeStablePtr#
stores it tagged, so rts_promiseThrowTo read all StgWeak fields one
byte off and crashed in throwToMsg (jsffi/cancel in the second CI run
of !16329). The resolve/reject paths were already covered by the
hs_try_putmvar_with_value fix.
Assisted-by: Claude Fable 5
- - - - -
4dde58bb by Simon Jakobi at 2026-07-11T09:00:05+02:00
Accept remaining compile-time metric increases from enter-taggable enforcement
Second CI run of !16329 flagged three more compile-time allocation
increases beyond T13960: T20049 (+2.0%, right at the window edge, on
x86_64 validate jobs) and, on the wasm cross job only, T6048 (+2.2%)
and T16577 (+5.7%). These are the emitEnter tag-test cost of the
invariant enforcement (#23173); the wasm numbers suggest the cost is
higher without TablesNextToCode.
The perf driver reads the Metric Increase block from the HEAD commit
only, hence this empty commit at the branch tip; it supersedes the
earlier one for T13960.
-------------------------
Metric Increase:
T13960
T16577
T20049
T6048
-------------------------
Assisted-by: Claude Fable 5
- - - - -
1 changed file:
- rts/wasm/JSFFI.c
Changes:
=====================================
rts/wasm/JSFFI.c
=====================================
@@ -297,7 +297,9 @@ __attribute__((export_name("rts_promiseThrowTo")))
void rts_promiseThrowTo(HsStablePtr, HsJSVal);
void rts_promiseThrowTo(HsStablePtr sp, HsJSVal js_err) {
Capability *cap = &MainCapability;
- StgWeak *w = (StgWeak *)deRefStablePtr(sp);
+ // Weak# pointers carry tag 1; see Note [Pointer tagging of unlifted boxed
+ // primitives] in GHC.StgToCmm.Prim. (The key field is stored untagged.)
+ StgWeak *w = (StgWeak *)UNTAG_CLOSURE((StgClosure *)deRefStablePtr(sp));
if (w->header.info == &stg_DEAD_WEAK_info) {
return;
}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c00b949fbead911ff11b5c4f5e7b67…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c00b949fbead911ff11b5c4f5e7b67…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
10 Jul '26
Simon Jakobi pushed new branch wip/sjakobi/unbox-enums at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sjakobi/unbox-enums
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/romes/27461] downsweep: make control flow simpler and cache correct
by Rodrigo Mesquita (＠alt-romes) 10 Jul '26
by Rodrigo Mesquita (＠alt-romes) 10 Jul '26
10 Jul '26
Rodrigo Mesquita pushed to branch wip/romes/27461 at Glasgow Haskell Compiler / GHC
Commits:
567af5be by Rodrigo Mesquita at 2026-07-10T22:31:22+01:00
downsweep: make control flow simpler and cache correct
This refactor extracts the control flow of downsweep into a single
function `dfsBuild`, which takes care of iteratively expanding and
traversing all nodes of the in-construction module graph necessary to
build a full `ModuleGraph`.
There are three levels of caching going on, all of which are necessary
to make sure we don't do repeated work (specifically: NEVER summarise
the same module twice).
1. `dfsBuild` accumulates the final module graph and never revisits the
same node of the module graph. Cache is keyed by the final
`ModuleGraph`s `NodeKey`s.
2. For Module A in home-unit u1, each import in the list of imports
needs to be *found* (call to `findImportedModuleWithIsBoot`): at this
point, we only have the `ModuleName` of the import, not the `Module`.
This *finding* is somewhat expensive, so we cache it as well
(`ImportsCache`). The cache key is the home-unit to which the module
belongs~[1], the import package qualifier, and the ModuleName.
[1] Different home-units will have different package flags, which means
potentially different `Module` resolution for the same `ModuleName`.
3. The most expensive operation we want to avoid is summarising a
`Module` into a `ModSummary`, which notably involves parsing the
module header from scratch.
The third cache, in essence, maps a `Module` to its `ModSummary`
(named `ModSummaryCache`). This cache upholds the invariant: we NEVER
summarise the same module twice. In practice, the cache key is the
Module's UnitId and the Source path; the reason is we need to
distinguish between `.hs` and `.hs-boot` files, as their summaries
will differ.
Note that (2) can't guarantee this alone: Two ModuleName imports in
separate units can (and likely do) map to the same `Module`.
Note that the previous implementation failed to achieve the
no-duplicate-work summarisation invariant, and we ended up doing a
quadratic amount of processing in scenarios like test
`MultiComponentModules100`.
See also Note [Downsweep Control Flow and Caching]
Fixes #27461
- - - - -
2 changed files:
- compiler/GHC/Driver/Downsweep.hs
- utils/check-ppr/Main.hs
Changes:
=====================================
compiler/GHC/Driver/Downsweep.hs
=====================================
@@ -5,6 +5,8 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FunctionalDependencies #-}
module GHC.Driver.Downsweep
( downsweep
, downsweepThunk
@@ -91,7 +93,7 @@ import GHC.Unit.Module.Deps
import qualified GHC.Unit.Home.Graph as HUG
import GHC.Unit.Module.Stage
-import Data.Either ( rights, partitionEithers, lefts )
+import Data.Either ( partitionEithers, lefts )
import qualified Data.Map as Map
import qualified Data.Set as Set
@@ -111,6 +113,8 @@ import Control.Monad.Trans.Reader
import qualified Data.Map.Strict as M
import Control.Monad.Trans.Class
import System.IO.Unsafe (unsafeInterleaveIO)
+import Data.IORef
+import qualified Data.List.NonEmpty as NE
{-
Note [Downsweep and the ModuleGraph]
@@ -142,14 +146,6 @@ The result is having a uniform graph available for the whole compilation pipelin
-}
--- This caches the answer to the question, if we are in this unit, what does
--- an import of this module mean.
-type DownsweepCache = M.Map (UnitId, PkgQual, ModuleNameWithIsBoot) [Either DriverMessages ModuleNodeInfo]
-
-moduleGraphNodeMap :: ModuleGraph -> M.Map NodeKey ModuleGraphNode
-moduleGraphNodeMap graph
- = M.fromList [(mkNodeKey node, node) | node <- mgModSummaries' graph]
-
-----------------------------------------------------------------------------
--
-- | Downsweep (dependency analysis) for --make mode
@@ -195,8 +191,11 @@ downsweep :: HscEnv
-- (Modules, IsBoot) identifiers, unless the Bool is true in
-- which case there can be repeats
downsweep hsc_env diag_wrapper msg old_summaries maybe_base_graph excl_mods allow_dup_roots = do
- n_jobs <- mkWorkerLimit (hsc_dflags hsc_env)
- (root_errs, root_summaries) <- rootSummariesParallel n_jobs hsc_env diag_wrapper msg summary
+ n_jobs <- mkWorkerLimit (hsc_dflags hsc_env)
+ summ_cache <- newIORef (mkModSummaryCache (zip old_summaries (repeat SummOld)))
+ imps_cache <- newIORef Map.empty
+ (root_errs, root_summaries) <- rootSummariesParallel n_jobs hsc_env diag_wrapper msg
+ (getRootSummary excl_mods summ_cache imps_cache)
let closure_errs = checkHomeUnitsClosed unit_env
unit_env = hsc_unit_env hsc_env
@@ -204,9 +203,13 @@ downsweep hsc_env diag_wrapper msg old_summaries maybe_base_graph excl_mods allo
case all_errs of
[] -> do
- (downsweep_errs, downsweep_nodes) <- downsweepFromRootNodes hsc_env old_summary_map maybe_base_graph excl_mods allow_dup_roots DownsweepUseCompile (map ModuleNodeCompile root_summaries) []
+ (downsweep_errs, downsweep_nodes) <-
+ downsweepFromRootNodes hsc_env summ_cache imps_cache maybe_base_graph
+ excl_mods allow_dup_roots DownsweepUseCompile (map ModuleNodeCompile root_summaries) []
- let (other_errs, unit_nodes) = partitionEithers $ HUG.unitEnv_foldWithKey (\nodes uid hue -> nodes ++ unitModuleNodes downsweep_nodes uid hue) [] (hsc_HUG hsc_env)
+ let (other_errs, unit_nodes) = partitionEithers $
+ HUG.unitEnv_foldWithKey (\nodes uid hue -> nodes ++ unitModuleNodes downsweep_nodes uid hue) []
+ (hsc_HUG hsc_env)
let all_nodes = downsweep_nodes ++ unit_nodes
let all_errs = downsweep_errs ++ other_errs
@@ -222,17 +225,6 @@ downsweep hsc_env diag_wrapper msg old_summaries maybe_base_graph excl_mods allo
return (all_errs, th_configured_nodes)
_ -> return (all_errs, emptyMG)
where
- summary = getRootSummary excl_mods old_summary_map
-
- -- A cache from file paths to the already summarised modules. The same file
- -- can be used in multiple units so the map is also keyed by which unit the
- -- file was used in.
- -- Reuse these if we can because the most expensive part of downsweep is
- -- reading the headers.
- old_summary_map :: M.Map (UnitId, OsPath) ModSummary
- old_summary_map =
- M.fromList [((ms_unitid ms, msHsFileOsPath ms), ms) | ms <- old_summaries]
-
-- Dependencies arising on a unit (backpack and module linking deps)
unitModuleNodes :: [ModuleGraphNode] -> UnitId -> HomeUnitEnv -> [Either (Messages DriverMessage) ModuleGraphNode]
unitModuleNodes summaries uid hue =
@@ -245,7 +237,9 @@ downsweep hsc_env diag_wrapper msg old_summaries maybe_base_graph excl_mods allo
downsweepThunk :: HscEnv -> ModSummary -> IO ModuleGraph
downsweepThunk hsc_env mod_summary = unsafeInterleaveIO $ do
debugTraceMsg (hsc_logger hsc_env) 3 $ text "Computing Module Graph thunk..."
- ~(errs, mg) <- downsweepFromRootNodes hsc_env mempty Nothing [] True DownsweepUseFixed [ModuleNodeCompile mod_summary] []
+ summs <- newIORef (mkModSummaryCache [(mod_summary,SummOld)])
+ imps <- newIORef mempty
+ ~(errs, mg) <- downsweepFromRootNodes hsc_env summs imps Nothing [] True DownsweepUseFixed [ModuleNodeCompile mod_summary] []
let dflags = hsc_dflags hsc_env
liftIO $ printOrThrowDiagnostics (hsc_logger hsc_env)
(initPrintConfig dflags)
@@ -269,83 +263,22 @@ downsweepInteractiveImports hsc_env ic = unsafeInterleaveIO $ do
debugTraceMsg (hsc_logger hsc_env) 3 $ (text "Computing Interactive Module Graph thunk...")
let imps = ic_imports (hsc_IC hsc_env)
- let interactive_mn = icInteractiveModule ic
- -- No sensible value for ModLocation.. if you hit this panic then you probably
- -- need to add proper support for modules without any source files to the driver.
- let ml = pprPanic "modLocation" (ppr interactive_mn <+> ppr imps)
- let key = moduleToMnk interactive_mn NotBoot
- let node_type = ModuleNodeFixed key ml
+ interactive_mn = icInteractiveModule ic
+ key = dsNodeInfoKey (DSInteractive interactive_mn imps)
-- The existing nodes in the module graph. This will be populated when GHCi runs
-- :load. Any home package modules need to already be in here.
let cached_nodes = Map.fromList [ (mkNodeKey n, n) | n <- mg_mss (hsc_mod_graph hsc_env) ]
- (module_edges, graph) <- loopFromInteractive hsc_env (map mkEdge imps) cached_nodes
- let interactive_node = ModuleNode module_edges node_type
-
- let all_nodes = M.elems graph
+ summ_cache <- newIORef mempty
+ imps_cache <- newIORef mempty
+ let env = DownsweepEnv hsc_env DownsweepUseFixed{-or UseCompiled?-} summ_cache imps_cache []
+ graph <- runDownsweepM env do
+ loopFromInteractive cached_nodes interactive_mn imps
+ let interactive_node = expectJust $ M.lookup key graph
+ all_nodes = M.elems graph
return $ mkModuleGraph (interactive_node : all_nodes)
- where
- --
- mkEdge :: InteractiveImport -> Either ModuleNodeEdge (UnitId, ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))
- -- A simple edge to a module from the same home unit
- mkEdge (IIModule n) =
- let
- mod_node_key = ModNodeKeyWithUid
- { mnkModuleName = GWIB (moduleName n) NotBoot
- , mnkUnitId =
- -- 'toUnitId' is safe here, as we can't import modules that
- -- don't have a 'UnitId'.
- toUnitId (moduleUnit n)
- }
- mod_node_edge =
- ModuleNodeEdge NormalLevel (NodeKey_Module mod_node_key)
- in Left mod_node_edge
- -- A complete import statement
- mkEdge (IIDecl i) =
- let lvl = convImportLevel (ideclLevelSpec i)
- wanted_mod = unLoc (ideclName i)
- is_boot = ideclSource i
- mb_pkg = renameRawPkgQual (hsc_unit_env hsc_env) (unLoc $ ideclName i) (ideclPkgQual i)
- unitId = homeUnitId $ hsc_home_unit hsc_env
- in Right (unitId, lvl, mb_pkg, GWIB (noLoc wanted_mod) is_boot)
-
-loopFromInteractive :: HscEnv
- -> [Either ModuleNodeEdge (UnitId, ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))]
- -> M.Map NodeKey ModuleGraphNode
- -> IO ([ModuleNodeEdge],M.Map NodeKey ModuleGraphNode)
-loopFromInteractive _ [] cached_nodes = return ([], cached_nodes)
-loopFromInteractive hsc_env (edge:edges) cached_nodes =
- case edge of
- Left edge -> do
- (edges, cached_nodes') <- loopFromInteractive hsc_env edges cached_nodes
- return (edge : edges, cached_nodes')
- Right (unitId, lvl, mb_pkg, GWIB wanted_mod is_boot) -> do
- let home_unit = ue_unitHomeUnit unitId (hsc_unit_env hsc_env)
- let k _ loc mod =
- let key = moduleToMnk mod is_boot
- in return $ FoundHome (ModuleNodeFixed key loc)
- found <- liftIO $ summariseModuleDispatch k hsc_env home_unit is_boot wanted_mod mb_pkg []
- case found of
- -- Case 1: Home modules have to already be in the cache.
- FoundHome (ModuleNodeFixed mod _) -> do
- let edge = ModuleNodeEdge lvl (NodeKey_Module mod)
- -- Note: Does not perform any further downsweep as the module must already be in the cache.
- (edges, cached_nodes') <- loopFromInteractive hsc_env edges cached_nodes
- return (edge : edges, cached_nodes')
- -- Case 2: External units may not be in the cache, if we haven't already initialised the
- -- module graph. We can construct the module graph for those here by calling loopUnit.
- External uid -> do
- let hsc_env' = hscSetActiveHomeUnit home_unit hsc_env
- cached_nodes' = loopUnit hsc_env' cached_nodes [uid]
- edge = ModuleNodeEdge lvl (NodeKey_ExternalUnit uid)
- (edges, cached_nodes') <- loopFromInteractive hsc_env edges cached_nodes'
- return (edge : edges, cached_nodes')
- -- And if it's not found.. just carry on and hope.
- _ -> loopFromInteractive hsc_env edges cached_nodes
-
-
-- | Create a module graph from a list of installed modules.
-- This is used by the loader when we need to load modules but there
-- isn't already an existing module graph. For example, when loading plugins
@@ -373,7 +306,9 @@ downsweepInstalledModules hsc_env mods = do
_ -> throwGhcException $ ProgramError $ showSDoc (hsc_dflags hsc_env) $ text "downsweepInstalledModules: Could not find installed module" <+> ppr i
nodes <- mapM process installed_mods
- (errs, mg) <- downsweepFromRootNodes hsc_env mempty Nothing [] True DownsweepUseFixed nodes external_uids
+ summs <- newIORef mempty
+ imps <- newIORef mempty
+ (errs, mg) <- downsweepFromRootNodes hsc_env summs imps Nothing [] True DownsweepUseFixed nodes external_uids
-- Similarly here, we should really not get any errors, but print them out if we do.
let dflags = hsc_dflags hsc_env
@@ -397,7 +332,8 @@ data DownsweepMode = DownsweepUseCompile | DownsweepUseFixed
-- This function will start at the given roots, and traverse downwards to find
-- all the dependencies, all the way to the leaf units.
downsweepFromRootNodes :: HscEnv
- -> M.Map (UnitId, OsPath) ModSummary
+ -> ModSummaryCache
+ -> ImportsCache
-> Maybe ModuleGraph
-> [ModuleName]
-> Bool
@@ -405,44 +341,47 @@ downsweepFromRootNodes :: HscEnv
-> [ModuleNodeInfo] -- ^ The starting ModuleNodeInfo
-> [UnitId] -- ^ The starting units
-> IO ([DriverMessages], [ModuleGraphNode])
-downsweepFromRootNodes hsc_env old_summaries maybe_base_graph excl_mods allow_dup_roots mode root_nodes root_uids
- = do
- let root_map = mkRootMap root_nodes
- checkDuplicates root_map
- let env = DownsweepEnv hsc_env mode old_summaries excl_mods
- (deps', map0) <- runDownsweepM env $ do
- let base_nodes = maybe M.empty moduleGraphNodeMap maybe_base_graph
- (module_deps, map0) <- loopModuleNodeInfos root_nodes (base_nodes, root_map)
- let all_deps = loopUnit hsc_env module_deps root_uids
- let all_instantiations = getHomeUnitInstantiations hsc_env
- deps' <- loopInstantiations all_instantiations all_deps
- return (deps', map0)
-
-
- let downsweep_errs = lefts $ concat $ M.elems map0
- downsweep_nodes = M.elems deps'
-
- return (downsweep_errs, downsweep_nodes)
- where
- getHomeUnitInstantiations :: HscEnv -> [(UnitId, InstantiatedUnit)]
- getHomeUnitInstantiations hsc_env = HUG.unitEnv_foldWithKey (\nodes uid hue -> nodes ++ instantiationNodes uid (homeUnitEnv_units hue)) [] (hsc_HUG hsc_env)
-
- -- In a root module, the filename is allowed to diverge from the module
- -- name, so we have to check that there aren't multiple root files
- -- defining the same module (otherwise the duplicates will be silently
- -- ignored, leading to confusing behaviour).
- checkDuplicates
- :: DownsweepCache
- -> IO ()
- checkDuplicates root_map
- | not allow_dup_roots
- , dup_root:_ <- dup_roots = liftIO $ multiRootsErr sec dup_root
- | otherwise = pure ()
- where
- sec = initSourceErrorContext (hsc_dflags hsc_env)
- dup_roots :: [[ModuleNodeInfo]] -- Each at least of length 2
- dup_roots = filterOut isSingleton $ map rights (M.elems root_map)
-
+downsweepFromRootNodes hsc_env summ_cache imps_cache maybe_base_graph excl_mods allow_dup_roots mode root_nodes root_uids = do
+ when (not allow_dup_roots) $
+ case root_duplicates of
+ [] -> return ()
+ (dup_root:_) -> multiRootsErr sec dup_root
+ let env = DownsweepEnv hsc_env mode summ_cache imps_cache excl_mods
+ deps' <- runDownsweepM env $ do
+ let base_nodes = maybe M.empty moduleGraphNodeMap maybe_base_graph
+ module_deps <- loopModuleNodeInfos base_nodes root_nodes
+ all_deps <- loopUnits module_deps (hscActiveUnitId hsc_env) root_uids
+ deps' <- loopInstantiations all_deps (getHomeUnitInstantiations hsc_env)
+ return deps'
+ f_cache <- readIORef summ_cache
+ let downsweep_errs = lefts (M.elems f_cache)
+ downsweep_nodes = M.elems deps'
+
+ return (downsweep_errs, downsweep_nodes)
+ where
+ getHomeUnitInstantiations :: HscEnv -> [(UnitId, InstantiatedUnit)]
+ getHomeUnitInstantiations hsc_env = HUG.unitEnv_foldWithKey
+ (\nodes uid hue -> nodes ++ instantiationNodes uid (homeUnitEnv_units hue)) [] (hsc_HUG hsc_env)
+
+ -- In a root module, the filename is allowed to diverge from the module
+ -- name, so we have to check that there aren't multiple root files
+ -- defining the same module (otherwise the duplicates will be silently
+ -- ignored, leading to confusing behaviour).
+ root_duplicates :: [NE.NonEmpty ModuleNodeInfo]
+ root_duplicates = mapMaybe takes2 (M.elems root_map)
+ where
+ takes2 (a:as@(_:_)) = Just (a NE.:| as) -- Each at least of length 2
+ takes2 _ = Nothing
+
+ root_map = Map.fromListWith (flip (++))
+ [ ((moduleNodeInfoUnitId s, moduleNodeInfoMnwib s), [s])
+ | s <- root_nodes ]
+
+ moduleGraphNodeMap :: ModuleGraph -> M.Map NodeKey ModuleGraphNode
+ moduleGraphNodeMap graph
+ = M.fromList [(mkNodeKey node, node) | node <- mgModSummaries' graph]
+
+ sec = initSourceErrorContext (hsc_dflags hsc_env)
calcDeps :: ModSummary -> [(ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))]
calcDeps ms =
@@ -457,104 +396,287 @@ type DownsweepM a = ReaderT DownsweepEnv IO a
data DownsweepEnv = DownsweepEnv {
downsweep_hsc_env :: HscEnv
, _downsweep_mode :: DownsweepMode
- , _downsweep_old_summaries :: M.Map (UnitId, OsPath) ModSummary
+ , _downsweep_summaries_cache :: ModSummaryCache
+ , downsweep_imports_cache :: ImportsCache
, _downsweep_excl_mods :: [ModuleName]
}
+type ModSummaryCache = IORef ModSummaryCacheMap
+type ImportsCache = IORef ImportsCacheMap
+
+-- | A cache from file paths to the already summarised modules. The same file
+-- can be used in multiple units so the map is actually also keyed by which
+-- unit the file was used in.
+--
+-- We want to reuse ModSummaries as far as possible because the most expensive
+-- part of downsweep is reading and parsing the headers.
+--
+-- See Note [Downsweep Control Flow and Caching]
+type ModSummaryCacheMap
+ -- The cache can't be keyed by 'Module' because that isn't sufficient to
+ -- distinguish .hs from .hs-boot files. Use path+unit instead.
+ = ( M.Map (UnitId, OsPath) (Either DriverMessages (ModSummary, SummProvenance)) )
+
+data SummProvenance
+ -- | Constructed during this downsweep: trivially up to date
+ = SummFresh
+ -- | Carried over from a previous run: may be stale, must be hash-checked
+ -- (and considered by -fforce-recomp)
+ | SummOld
+
+mkModSummaryCache :: [(ModSummary, SummProvenance)] -> ModSummaryCacheMap
+mkModSummaryCache summs = foldl' (flip (uncurry addModSummaryCache)) M.empty summs
+
+addModSummaryCache :: ModSummary -> SummProvenance -> ModSummaryCacheMap -> ModSummaryCacheMap
+addModSummaryCache ms pr fe = upd_fe fe
+ where
+ upd_fe fe
+ | Just src_fn_os <- ml_hs_file_ospath (ms_location ms)
+ = M.insert (ms_unitid ms, src_fn_os) (Right (ms, pr)) fe
+ | otherwise = fe
+
+modifySummCache :: ModSummaryCache -> (ModSummaryCacheMap -> ModSummaryCacheMap) -> IO ()
+modifyImpsCache :: ImportsCache -> (ImportsCacheMap -> ImportsCacheMap) -> IO ()
+modifySummCache r f = atomicModifyIORef' r (\c -> (f c, ()))
+modifyImpsCache r f = atomicModifyIORef' r (\c -> (f c, ()))
+
+-- | A cache from a module import (in given home unit context, with a package
+-- qualifier, and the imported module name (with or without SOURCE)) to the
+-- result of summarising that import (see 'summariseModuleDispatch').
+--
+-- See Note [Downsweep Control Flow and Caching]
+type ImportsCacheMap
+ = M.Map (UnitId, PkgQual, ModuleNameWithIsBoot) SummariseResult
+
runDownsweepM :: DownsweepEnv -> DownsweepM a -> IO a
runDownsweepM env act = runReaderT act env
+loopDownsweepNodes :: M.Map NodeKey ModuleGraphNode -> [DownsweepNode] -> DownsweepM (M.Map NodeKey ModuleGraphNode)
+loopModuleNodeInfos :: M.Map NodeKey ModuleGraphNode -> [ModuleNodeInfo] -> DownsweepM (M.Map NodeKey ModuleGraphNode)
+loopUnits :: M.Map NodeKey ModuleGraphNode -> UnitId -> [UnitId] -> DownsweepM (M.Map NodeKey ModuleGraphNode)
+loopInstantiations :: M.Map NodeKey ModuleGraphNode -> [(UnitId, InstantiatedUnit)] -> DownsweepM (M.Map NodeKey ModuleGraphNode)
+loopFromInteractive :: M.Map NodeKey ModuleGraphNode -> Module -> [InteractiveImport] -> DownsweepM (M.Map NodeKey ModuleGraphNode)
+loopDownsweepNodes base_map nodes = dfsBuild (Just base_map) nodes dsNodeInfoKey dsNodeExpand
+loopModuleNodeInfos base_map = loopDownsweepNodes base_map . map DSMod
+loopUnits base_map homud = loopDownsweepNodes base_map . map (DSUnit homud)
+loopInstantiations base_map = loopDownsweepNodes base_map . map (uncurry DSInst)
+loopFromInteractive base_map m = loopDownsweepNodes base_map . (:[]) . DSInteractive m
+
+--------------------------------------------------------------------------------
+
+-- | A 'DownsweepNode' is the basic block of the downsweep algorithm which
+-- encompasses the types of nodes we can iteratively expand to construct the
+-- full module graph. See 'loopDownsweepNodes'.
+--
+-- See Note [Downsweep Control Flow and Caching]
+data DownsweepNode
+ -- | A module node to expand
+ = DSMod ModuleNodeInfo
+ -- | A unit node to expand
+ | DSUnit
+ { home_context_uid :: UnitId
+ -- ^ The home unit which introduced the dependency on this 'node_uid'. This
+ -- 'node_uid' can only be expanded in the context ('HscEnv') where
+ -- 'home_context_uid' is the active home unit, to make sure the package flags
+ -- are the ones attributed to the home package that introduced this node.
+ , node_uid :: UnitId
+ -- ^ The unit node to expand
+ }
+ -- | FIXME: document the meaning of 'DSInst'
+ | DSInst
+ { home_context_uid :: UnitId
+ , instantiated_ud :: InstantiatedUnit
+ }
+ -- | A group of interactive imports from this interactive Module
+ | DSInteractive Module [InteractiveImport]
+
+instance Outputable DownsweepNode where
+ ppr = \case
+ DSMod (ModuleNodeCompile ms) -> text "DSModC" <+> ppr (ms_mod_name ms)
+ DSMod (ModuleNodeFixed key _) -> text "DSModF" <+> ppr key
+ DSUnit{node_uid} -> text "DSUnit" <+> ppr node_uid
+ DSInst{instantiated_ud} -> text "DSInst" <+> ppr instantiated_ud
+ DSInteractive mod ii -> text "DSInteractive" <+> ppr mod <+> ppr ii
+
+-- | They key by which to cache previously visited 'DownsweepNode's
+dsNodeInfoKey :: DownsweepNode -> NodeKey
+dsNodeInfoKey = \case
+ DSMod (ModuleNodeCompile ms) -> NodeKey_Module (msKey ms)
+ DSMod (ModuleNodeFixed mod _) -> NodeKey_Module mod
+ DSUnit{node_uid} -> NodeKey_ExternalUnit node_uid
+ DSInst{instantiated_ud} -> NodeKey_Unit instantiated_ud
+ DSInteractive mod _imps -> NodeKey_Module $ moduleToMnk mod NotBoot
+
+dsNodeExpand :: DownsweepNode -> DownsweepM (Maybe (ModuleGraphNode, [DownsweepNode]))
+dsNodeExpand = \case
+ DSMod (ModuleNodeCompile ms) -> expandModuleSummary ms
+ DSMod (ModuleNodeFixed key loc) -> expandFixedModuleNode key loc
+ DSUnit{ node_uid, home_context_uid } -> expandUnitNode node_uid home_context_uid
+ DSInst{ instantiated_ud
+ , home_context_uid } -> expandInstantiatedUnit instantiated_ud home_context_uid
+ DSInteractive imod iis -> expandInteractiveImports imod iis
+
+expandModuleSummary :: ModSummary -> DownsweepM (Maybe (ModuleGraphNode, [DownsweepNode]))
+expandModuleSummary ms = do -- Didn't work out what the imports mean yet, now do that.
+ hsc_env <- asks downsweep_hsc_env
+ let home_uid = ms_unitid ms
+ home_unit = ue_unitHomeUnit home_uid (hsc_unit_env hsc_env)
+ (final_deps, todo) <- fmap unzip $ forM (calcDeps ms) $ \(imp,mb_pkg,gwib) -> do
+ let GWIB { gwib_mod = L loc mod, gwib_isBoot = is_boot } = gwib
+ wanted_mod = L loc mod
+ mb_s <- downsweepSummarise home_unit is_boot wanted_mod mb_pkg Nothing
+ case mb_s of
+ NotThere -> return
+ ( Nothing, [] )
+ External uid -> return
+ ( Just $ mkModuleEdge imp (NodeKey_ExternalUnit uid)
+ -- Specify home unit, as each unit might have a different visible package database.
+ , [DSUnit{node_uid = uid, home_context_uid = home_uid}] )
+ FoundInstantiation iud -> return
+ ( Just (mkModuleEdge imp (NodeKey_Unit iud)), [] )
+ FoundHomeWithError (_uid, _e) -> return
+ ( Nothing, [] )
+ -- the error @e@ is already stored in the summarisation cache,
+ -- (the IORef in DownsweepM) and will get reported at the end.
+ FoundHome s -> return
+ -- MP: This assumes that we can only instantiate non home units, which is probably fair enough for now.
+ ( Just $ mkModuleEdge imp (NodeKey_Module (mnKey s))
+ , [DSMod s] )
+
+ -- This has the effect of finding a .hs file if we are looking at the .hs-boot file.
+ boot_todo <-
+ if | HsBootFile <- ms_hsc_src ms
+ -> do
+ r <- downsweepSummarise home_unit NotBoot (noLoc $ ms_mod_name ms) NoPkgQual Nothing
+ case r of
+ FoundHome s -> pure [DSMod s]
+ _ -> pure []
+ | otherwise -> pure []
+
+ return $ Just
+ ( ModuleNode (catMaybes final_deps) (ModuleNodeCompile ms)
+ , boot_todo ++ concat todo
+ )
+
+-- | Expand a 'ModuleNodeFixed' node
+-- NB: If you ever reach a Fixed node, everything under that also must be fixed.
+expandFixedModuleNode :: ModNodeKeyWithUid -> ModLocation -> DownsweepM (Maybe (ModuleGraphNode, [DownsweepNode]))
+expandFixedModuleNode key loc = do
+ hsc_env <- asks downsweep_hsc_env
+ -- MP: TODO, we should just read the dependency info from the interface rather than either
+ -- a. Loading the whole thing into the EPS (this might never nececssary and causes lots of things to be permanently loaded into memory)
+ -- b. Loading the whole interface into a buffer before discarding it. (wasted allocation and deserialisation)
+ read_result <- liftIO $
+ -- 1. Check if the interface is already loaded into the EPS by some other
+ -- part of the compiler.
+ lookupIfaceByModuleHsc hsc_env (mnkToModule key) >>= \case
+ Just iface -> return (M.Succeeded iface)
+ Nothing -> readIface (hsc_hooks hsc_env) (hsc_logger hsc_env) (hsc_dflags hsc_env) (hsc_NC hsc_env) (mnkToModule key) (ml_hi_file loc)
+ case read_result of
+ M.Succeeded iface -> do
+ -- Computer information about this node
+ let node_deps = ifaceDeps (mi_deps iface)
+ edges = map mkFixedEdge node_deps
+ node = ModuleNode edges (ModuleNodeFixed key loc)
+ deps' <- catMaybes <$> mapM (mk_dep hsc_env) (bimap snd snd <$> node_deps)
+ pure $ Just (node, deps')
+
+ -- Ignore any failure, we might try to read a .hi-boot file for
+ -- example, even if there is not one.
+ M.Failed {} ->
+ pure Nothing
+ where
+ mk_dep hsc_env (Left key) = do
+ -- Like expandImports, but we already know exactly which module we are looking for.
+ read_result <- liftIO $ findExactModule hsc_env (mnkToInstalledModule key) (mnkIsBoot key)
+ case read_result of
+ InstalledFound loc -> do
+ pure $ Just $ DSMod (ModuleNodeFixed key loc)
+ _otherwise ->
+ -- If the finder fails, just keep going, there will be another
+ -- error later.
+ pure Nothing
+ mk_dep _ (Right uid_dep) = do
+ -- Set active unit so that looking loopUnit finds the correct
+ -- -package flags in the unit state.
+ let home_uid = mnkUnitId key
+ pure (Just DSUnit{node_uid=uid_dep, home_context_uid=home_uid})
+
+-- | Expand a unit id under the context of a certain home unit
+expandUnitNode :: UnitId {-^ @node_uid@ -} -> UnitId {-^ Home unit from where @node_uid@ was introduced -}
+ -> DownsweepM (Maybe (ModuleGraphNode, [DownsweepNode]))
+expandUnitNode node_uid home_context_uid = do
+ -- Set active unit so that looking loopUnit finds the correct
+ -- -package flags in the unit state.
+ hsc_env <- asks downsweep_hsc_env
+ let lcl_hsc_env = hscSetActiveUnitId home_context_uid hsc_env
+ case unitDepends <$> lookupUnitId (hsc_units lcl_hsc_env) node_uid of
+ Just us -> pure $ Just ((UnitNode us node_uid), map (\u -> DSUnit{node_uid=u, home_context_uid{-inherit-}}) us)
+ Nothing -> pprPanic "loopUnit" (text "Malformed package database, missing " <+> ppr node_uid)
+
+expandInstantiatedUnit :: InstantiatedUnit -> UnitId {-^ Home unit -} -> DownsweepM (Maybe (ModuleGraphNode, [DownsweepNode]))
+expandInstantiatedUnit iud home_uid = pure $ Just
+ ( InstantiationNode home_uid iud
+ , [DSUnit{node_uid=instUnitInstanceOf iud, home_context_uid=home_uid}] )
+
+expandInteractiveImports :: Module -> [InteractiveImport] -> DownsweepM (Maybe (ModuleGraphNode, [DownsweepNode]))
+expandInteractiveImports imod imps = do
+ hsc_env <- asks downsweep_hsc_env
+ imps_cache <- asks downsweep_imports_cache
+
+ let
+ -- A simple edge to a module from the same home unit
+ mkEdge (IIModule n) = return $
+ let
+ mod_node_key = ModNodeKeyWithUid
+ { mnkModuleName = GWIB (moduleName n) NotBoot
+ , mnkUnitId =
+ -- 'toUnitId' is safe here, as we can't import modules that
+ -- don't have a 'UnitId'.
+ toUnitId (moduleUnit n)
+ }
+ in (Just $ ModuleNodeEdge NormalLevel (NodeKey_Module mod_node_key), [])
-loopInstantiations :: [(UnitId, InstantiatedUnit)]
- -> M.Map NodeKey ModuleGraphNode
- -> DownsweepM (M.Map NodeKey ModuleGraphNode)
-loopInstantiations [] done = pure done
-loopInstantiations ((home_uid, iud) :xs) done = do
- hsc_env <- asks downsweep_hsc_env
- let home_unit = ue_unitHomeUnit home_uid (hsc_unit_env hsc_env)
- let hsc_env' = hscSetActiveHomeUnit home_unit hsc_env
- done' = loopUnit hsc_env' done [instUnitInstanceOf iud]
- payload = InstantiationNode home_uid iud
- loopInstantiations xs (M.insert (mkNodeKey payload) payload done')
-
-
--- This loops over all the mod summaries in the dependency graph, accumulates the actual dependencies for each module/unit
-loopSummaries :: [ModSummary]
- -> (M.Map NodeKey ModuleGraphNode,
- DownsweepCache)
- -> DownsweepM ((M.Map NodeKey ModuleGraphNode), DownsweepCache)
-loopSummaries [] done = pure done
-loopSummaries (ms:next) (done, summarised)
- | Just {} <- M.lookup k done
- = loopSummaries next (done, summarised)
- -- Didn't work out what the imports mean yet, now do that.
- | otherwise = do
- (final_deps, done', summarised') <- loopImports (ms_unitid ms) (calcDeps ms) done summarised
- -- This has the effect of finding a .hs file if we are looking at the .hs-boot file.
- (_, done'', summarised'') <- loopImports (ms_unitid ms) (maybeToList hs_file_for_boot) done' summarised'
- loopSummaries next (M.insert k (ModuleNode final_deps (ModuleNodeCompile ms)) done'', summarised'')
+ -- A complete import statement
+ mkEdge (IIDecl i) =
+ let lvl = convImportLevel (ideclLevelSpec i)
+ wanted_mod = unLoc (ideclName i)
+ is_boot = ideclSource i
+ mb_pkg = renameRawPkgQual (hsc_unit_env hsc_env) (unLoc $ ideclName i) (ideclPkgQual i)
+ unitId = homeUnitId $ hsc_home_unit hsc_env
+ in do
+ let home_unit = ue_unitHomeUnit unitId (hsc_unit_env hsc_env)
+ let k _ loc mod =
+ let key = moduleToMnk mod is_boot
+ in return $ FoundHome (ModuleNodeFixed key loc)
+
+ found <- liftIO $ summariseModuleDispatch k hsc_env imps_cache
+ home_unit is_boot (noLoc wanted_mod) mb_pkg []
+ case found of
+ -- Case 1: Home modules have to already be in the cache.
+ FoundHome (ModuleNodeFixed mod _) -> do
+ let edge = ModuleNodeEdge lvl (NodeKey_Module mod)
+ -- Note: Does not perform any further downsweep as the module must already be in the cache.
+ return (Just edge, [])
+ -- Case 2: External units may not be in the cache, if we haven't already initialised the
+ -- module graph. We can construct the module graph for those here by calling loopUnit.
+ External uid -> do
+ let edge = ModuleNodeEdge lvl (NodeKey_ExternalUnit uid)
+ return (Just edge, [DSUnit{node_uid=uid, home_context_uid=homeUnitId home_unit}])
+ -- And if it's not found.. just carry on and hope.
+ _ -> return (Nothing, [])
+
+ (module_edges, todo) <- unzip <$> mapM mkEdge imps
+ pure $ Just
+ ( ModuleNode (catMaybes module_edges) node_type, concat todo )
where
- k = NodeKey_Module (msKey ms)
+ -- No sensible value for ModLocation.. if you hit this panic then you probably
+ -- need to add proper support for modules without any source files to the driver.
+ ml = pprPanic "modLocation" (ppr imod <+> ppr imps)
+ key = moduleToMnk imod NotBoot
+ node_type = ModuleNodeFixed key ml
- hs_file_for_boot
- | HsBootFile <- ms_hsc_src ms
- = Just (NormalLevel, NoPkgQual, (GWIB (noLoc $ ms_mod_name ms) NotBoot))
- | otherwise
- = Nothing
-
-loopModuleNodeInfos :: [ModuleNodeInfo] -> (M.Map NodeKey ModuleGraphNode, DownsweepCache) -> DownsweepM (M.Map NodeKey ModuleGraphNode, DownsweepCache)
-loopModuleNodeInfos is cache = foldM (flip loopModuleNodeInfo) cache is
-
-loopModuleNodeInfo :: ModuleNodeInfo -> (M.Map NodeKey ModuleGraphNode, DownsweepCache) -> DownsweepM (M.Map NodeKey ModuleGraphNode, DownsweepCache)
-loopModuleNodeInfo mod_node_info (done, summarised) = do
- case mod_node_info of
- ModuleNodeCompile ms -> do
- loopSummaries [ms] (done, summarised)
- ModuleNodeFixed mod ml -> do
- done' <- loopFixedModule mod ml done
- return (done', summarised)
-
--- NB: loopFixedModule does not take a downsweep cache, because if you
--- ever reach a Fixed node, everything under that also must be fixed.
-loopFixedModule :: ModNodeKeyWithUid -> ModLocation
- -> M.Map NodeKey ModuleGraphNode
- -> DownsweepM (M.Map NodeKey ModuleGraphNode)
-loopFixedModule key loc done = do
- let nk = NodeKey_Module key
- hsc_env <- asks downsweep_hsc_env
- case M.lookup nk done of
- Just {} -> return done
- Nothing -> do
- -- MP: TODO, we should just read the dependency info from the interface rather than either
- -- a. Loading the whole thing into the EPS (this might never nececssary and causes lots of things to be permanently loaded into memory)
- -- b. Loading the whole interface into a buffer before discarding it. (wasted allocation and deserialisation)
- read_result <- liftIO $
- -- 1. Check if the interface is already loaded into the EPS by some other
- -- part of the compiler.
- lookupIfaceByModuleHsc hsc_env (mnkToModule key) >>= \case
- Just iface -> return (M.Succeeded iface)
- Nothing -> readIface (hsc_hooks hsc_env) (hsc_logger hsc_env) (hsc_dflags hsc_env) (hsc_NC hsc_env) (mnkToModule key) (ml_hi_file loc)
- case read_result of
- M.Succeeded iface -> do
- -- Computer information about this node
- let node_deps = ifaceDeps (mi_deps iface)
- edges = map mkFixedEdge node_deps
- node = ModuleNode edges (ModuleNodeFixed key loc)
- foldM (loopFixedNodeKey (mnkUnitId key)) (M.insert nk node done) (bimap snd snd <$> node_deps)
- -- Ignore any failure, we might try to read a .hi-boot file for
- -- example, even if there is not one.
- M.Failed {} ->
- return done
-
-loopFixedNodeKey :: UnitId -> M.Map NodeKey ModuleGraphNode -> Either ModNodeKeyWithUid UnitId -> DownsweepM (M.Map NodeKey ModuleGraphNode)
-loopFixedNodeKey _ done (Left key) = do
- loopFixedImports [key] done
-loopFixedNodeKey home_uid done (Right uid) = do
- -- Set active unit so that looking loopUnit finds the correct
- -- -package flags in the unit state.
- hsc_env <- asks downsweep_hsc_env
- let hsc_env' = hscSetActiveUnitId home_uid hsc_env
- return $ loopUnit hsc_env' done [uid]
+--------------------------------------------------------------------------------
mkFixedEdge :: Either (ImportLevel, ModNodeKeyWithUid) (ImportLevel, UnitId) -> ModuleNodeEdge
mkFixedEdge (Left (lvl, key)) = mkModuleEdge lvl (NodeKey_Module key)
@@ -569,27 +691,6 @@ ifaceDeps deps =
| (lvl, uid) <- Set.toList (dep_direct_pkgs deps)
]
--- Like loopImports, but we already know exactly which module we are looking for.
-loopFixedImports :: [ModNodeKeyWithUid]
- -> M.Map NodeKey ModuleGraphNode
- -> DownsweepM (M.Map NodeKey ModuleGraphNode)
-loopFixedImports [] done = pure done
-loopFixedImports (key:keys) done = do
- let nk = NodeKey_Module key
- hsc_env <- asks downsweep_hsc_env
- case M.lookup nk done of
- Just {} -> loopFixedImports keys done
- Nothing -> do
- read_result <- liftIO $ findExactModule hsc_env (mnkToInstalledModule key) (mnkIsBoot key)
- case read_result of
- InstalledFound loc -> do
- done' <- loopFixedModule key loc done
- loopFixedImports keys done'
- _otherwise ->
- -- If the finder fails, just keep going, there will be another
- -- error later.
- loopFixedImports keys done
-
downsweepSummarise :: HomeUnit
-> IsBootInterface
-> Located ModuleName
@@ -597,90 +698,22 @@ downsweepSummarise :: HomeUnit
-> Maybe (StringBuffer, UTCTime)
-> DownsweepM SummariseResult
downsweepSummarise home_unit is_boot wanted_mod mb_pkg maybe_buf = do
- DownsweepEnv hsc_env mode old_summaries excl_mods <- ask
- case mode of
- DownsweepUseCompile -> liftIO $ summariseModule hsc_env home_unit old_summaries is_boot wanted_mod mb_pkg maybe_buf excl_mods
- DownsweepUseFixed -> liftIO $ summariseModuleInterface hsc_env home_unit is_boot wanted_mod mb_pkg excl_mods
-
-
--- This loops over each import in each summary. It is mutually recursive with
--- loopSummaries if we discover a new module by doing this.
-loopImports
- :: UnitId
- -- ^ UnitId of home unit of summary whose imports are being processed
- -> [(ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))]
- -- ^ Work list: process these modules
- -> M.Map NodeKey ModuleGraphNode
- -> DownsweepCache
- -- ^ Visited set; the range is a list because
- -- the roots can have the same module names
- -- if allow_dup_roots is True
- -> DownsweepM ([ModuleNodeEdge],
- M.Map NodeKey ModuleGraphNode, DownsweepCache)
- -- ^ The result is the completed NodeMap
-loopImports _ [] done summarised = return ([], done, summarised)
-loopImports home_uid ((imp, mb_pkg, gwib) : ss) done summarised
- | Just summs <- M.lookup cache_key summarised
- = case summs of
- [Right ms] -> do
- let nk = mkModuleEdge imp (NodeKey_Module (mnKey ms))
- (rest, summarised', done') <- loopImportsNext done summarised
- return (nk: rest, summarised', done')
- [Left _err] ->
- loopImportsNext done summarised
- _errs -> do
- loopImportsNext done summarised
- | otherwise
- = do
- hsc_env <- asks downsweep_hsc_env
- let home_unit = ue_unitHomeUnit home_uid (hsc_unit_env hsc_env)
- mb_s <- downsweepSummarise home_unit
- is_boot wanted_mod mb_pkg
- Nothing
- case mb_s of
- NotThere -> loopImportsNext done summarised
- External uid -> do
- -- Pass an updated hsc_env to loopUnit, as each unit might
- -- have a different visible package database.
- let hsc_env' = hscSetActiveHomeUnit home_unit hsc_env
- let done' = loopUnit hsc_env' done [uid]
- (other_deps, done'', summarised') <- loopImportsNext done' summarised
- return (mkModuleEdge imp (NodeKey_ExternalUnit uid) : other_deps, done'', summarised')
- FoundInstantiation iud -> do
- (other_deps, done', summarised') <- loopImportsNext done summarised
- return (mkModuleEdge imp (NodeKey_Unit iud) : other_deps, done', summarised')
- FoundHomeWithError (_uid, e) -> loopImportsNext done (Map.insert cache_key [(Left e)] summarised)
- FoundHome s -> do
- (done', summarised') <-
- loopModuleNodeInfo s (done, Map.insert cache_key [Right s] summarised)
- (other_deps, final_done, final_summarised) <- loopImportsNext done' summarised'
-
- -- MP: This assumes that we can only instantiate non home units, which is probably fair enough for now.
- return (mkModuleEdge imp (NodeKey_Module (mnKey s)) : other_deps, final_done, final_summarised)
- where
- loopImportsNext = loopImports home_uid ss
- cache_key = (home_uid, mb_pkg, unLoc <$> gwib)
- GWIB { gwib_mod = L loc mod, gwib_isBoot = is_boot } = gwib
- wanted_mod = L loc mod
-
-loopUnit :: HscEnv -> Map.Map NodeKey ModuleGraphNode -> [UnitId] -> Map.Map NodeKey ModuleGraphNode
-loopUnit _ cache [] = cache
-loopUnit lcl_hsc_env cache (u:uxs) = do
- let nk = (NodeKey_ExternalUnit u)
- case Map.lookup nk cache of
- Just {} -> loopUnit lcl_hsc_env cache uxs
- Nothing -> case unitDepends <$> lookupUnitId (hsc_units lcl_hsc_env) u of
- Just us -> loopUnit lcl_hsc_env (loopUnit lcl_hsc_env (Map.insert nk (UnitNode us u) cache) us) uxs
- Nothing -> pprPanic "loopUnit" (text "Malformed package database, missing " <+> ppr u)
-
-multiRootsErr :: SourceErrorContext -> [ModuleNodeInfo] -> IO ()
-multiRootsErr _ [] = panic "multiRootsErr"
-multiRootsErr sec summs@(summ1:_)
+ DownsweepEnv hsc_env mode summaries_cache_ref imports_cache_ref excl_mods <- ask
+ liftIO $ case mode of
+ DownsweepUseCompile ->
+ summariseModule hsc_env home_unit summaries_cache_ref imports_cache_ref
+ is_boot wanted_mod mb_pkg maybe_buf excl_mods
+ DownsweepUseFixed ->
+ summariseModuleInterface hsc_env home_unit imports_cache_ref is_boot
+ wanted_mod mb_pkg excl_mods
+
+multiRootsErr :: SourceErrorContext -> NE.NonEmpty ModuleNodeInfo -> IO ()
+multiRootsErr sec (summ1 NE.:| summs)
= throwOneError sec $ fmap GhcDriverMessage $
mkPlainErrorMsgEnvelope noSrcSpan $ DriverDuplicatedModuleDeclaration mod files
where
mod = moduleNodeInfoModule summ1
- files = mapMaybe (ml_hs_file . moduleNodeInfoLocation) summs
+ files = mapMaybe (ml_hs_file . moduleNodeInfoLocation) (summ1:summs)
moduleNotFoundErr :: UnitId -> ModuleName -> DriverMessages
moduleNotFoundErr uid mod = singleMessage $ mkPlainErrorMsgEnvelope noSrcSpan (DriverModuleNotFound uid mod)
@@ -734,24 +767,25 @@ linkNodes summaries uid hue =
getRootSummary ::
[ModuleName] ->
- M.Map (UnitId, OsPath) ModSummary ->
+ ModSummaryCache ->
+ ImportsCache ->
HscEnv ->
Target ->
IO (Either DriverMessages ModSummary)
-getRootSummary excl_mods old_summary_map hsc_env target
+getRootSummary excl_mods summ_cache imports_cache hsc_env target
| TargetFile file mb_phase <- targetId
= do
let offset_file = augmentByWorkingDirectory dflags file
exists <- liftIO $ doesFileExist offset_file
if exists || isJust maybe_buf
- then summariseFile hsc_env home_unit old_summary_map offset_file mb_phase
+ then summariseFile hsc_env home_unit summ_cache offset_file mb_phase
maybe_buf
else
return $ Left $ singleMessage $
mkPlainErrorMsgEnvelope noSrcSpan (DriverFileNotFound offset_file)
| TargetModule modl <- targetId
= do
- maybe_summary <- summariseModule hsc_env home_unit old_summary_map NotBoot
+ maybe_summary <- summariseModule hsc_env home_unit summ_cache imports_cache NotBoot
(L rootLoc modl) (ThisPkg (homeUnitId home_unit))
maybe_buf excl_mods
pure case maybe_summary of
@@ -1179,13 +1213,6 @@ Potential TODOS:
generating temporary ones.
-}
--- | Populate the Downsweep cache with the root modules.
-mkRootMap
- :: [ModuleNodeInfo]
- -> DownsweepCache
-mkRootMap summaries = Map.fromListWith (flip (++))
- [ ((moduleNodeInfoUnitId s, NoPkgQual, moduleNodeInfoMnwib s), [Right s]) | s <- summaries ]
-
-----------------------------------------------------------------------------
-- Summarising modules
@@ -1202,33 +1229,35 @@ mkRootMap summaries = Map.fromListWith (flip (++))
summariseFile
:: HscEnv
-> HomeUnit
- -> M.Map (UnitId, OsPath) ModSummary -- old summaries
+ -> ModSummaryCache
-> FilePath -- source file name
-> Maybe Phase -- start phase
-> Maybe (StringBuffer,UTCTime)
-> IO (Either DriverMessages ModSummary)
-summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf
- -- we can use a cached summary if one is available and the
- -- source file hasn't changed,
- | Just old_summary <- M.lookup (homeUnitId home_unit, src_fn_os) old_summaries
- = do
- let location = ms_location $ old_summary
-
- src_hash <- get_src_hash
- -- The file exists; we checked in getRootSummary above.
- -- If it gets removed subsequently, then this
- -- getFileHash may fail, but that's the right
- -- behaviour.
-
- -- return the cached summary if the source didn't change
- checkSummaryHash
- hsc_env (new_summary src_fn)
- old_summary location src_hash
-
- | otherwise
- = do src_hash <- get_src_hash
- new_summary src_fn src_hash
+summariseFile hsc_env' home_unit summ_cache_ref src_fn mb_phase maybe_buf
+ = do file_summ_cache <- readIORef summ_cache_ref
+ case M.lookup (homeUnitId home_unit, src_fn_os) file_summ_cache of
+ Just (Right (chd_summary, SummFresh)) ->
+ -- Fresh: use it straight away
+ pure (Right chd_summary)
+ Just (Right (old_summary, SummOld)) -> do
+ -- we can use a cached summary if one is available and the
+ -- source file hasn't changed,
+ let location = ms_location $ old_summary
+
+ src_hash <- get_src_hash
+ -- The file exists; we checked in getRootSummary above.
+ -- If it gets removed subsequently, then this
+ -- getFileHash may fail, but that's the right
+ -- behaviour.
+
+ -- return the cached summary if the source didn't change
+ checkSummaryHash
+ hsc_env (new_summary src_fn)
+ old_summary location src_hash
+ _ -> do src_hash <- get_src_hash
+ new_summary src_fn src_hash
where
-- change the main active unit so all operations happen relative to the given unit
hsc_env = hscSetActiveHomeUnit home_unit hsc_env'
@@ -1239,7 +1268,8 @@ summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf
Just (buf,_) -> return $ fingerprintStringBuffer buf
Nothing -> liftIO $ getFileHash src_fn
- new_summary src_fn src_hash = runExceptT $ do
+ new_summary src_fn src_hash = do
+ res <- runExceptT $ do
preimps@PreprocessedImports {..}
<- getPreprocessedImports hsc_env src_fn mb_phase maybe_buf
@@ -1270,6 +1300,10 @@ summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf
, nms_mod = mod
, nms_preimps = preimps
}
+ modifySummCache summ_cache_ref $ case res of
+ Left e -> M.insert (homeUnitId home_unit, src_fn_os) (Left e)
+ Right ms -> addModSummaryCache ms SummFresh
+ return res
checkSummaryHash
:: HscEnv
@@ -1322,15 +1356,16 @@ data SummariseResult =
-- --make mode.
summariseModule :: HscEnv
-> HomeUnit
- -> M.Map (UnitId, OsPath) ModSummary
+ -> ModSummaryCache
+ -> ImportsCache
-> IsBootInterface
-> Located ModuleName
-> PkgQual
-> Maybe (StringBuffer, UTCTime)
-> [ModuleName]
-> IO SummariseResult
-summariseModule hsc_env home_unit old_summaries is_boot wanted_mod mb_pkg maybe_buf excl_mods =
- summariseModuleDispatch k hsc_env home_unit is_boot wanted_mod mb_pkg excl_mods
+summariseModule hsc_env home_unit old_summaries imps_cache is_boot wanted_mod mb_pkg maybe_buf excl_mods =
+ summariseModuleDispatch k hsc_env imps_cache home_unit is_boot wanted_mod mb_pkg excl_mods
where
k = summariseModuleWithSource home_unit old_summaries is_boot maybe_buf
@@ -1339,13 +1374,14 @@ summariseModule hsc_env home_unit old_summaries is_boot wanted_mod mb_pkg maybe_
-- This version always returns a ModuleNodeFixed node.
summariseModuleInterface :: HscEnv
-> HomeUnit
+ -> ImportsCache
-> IsBootInterface
-> Located ModuleName
-> PkgQual
-> [ModuleName]
-> IO SummariseResult
-summariseModuleInterface hsc_env home_unit is_boot wanted_mod mb_pkg excl_mods =
- summariseModuleDispatch k hsc_env home_unit is_boot wanted_mod mb_pkg excl_mods
+summariseModuleInterface hsc_env home_unit imps_cache is_boot wanted_mod mb_pkg excl_mods =
+ summariseModuleDispatch k hsc_env imps_cache home_unit is_boot wanted_mod mb_pkg excl_mods
where
k _hsc_env loc mod = do
-- The finder will return a path to the .hi-boot even if it doesn't actually
@@ -1362,6 +1398,7 @@ summariseModuleInterface hsc_env home_unit is_boot wanted_mod mb_pkg excl_mods =
summariseModuleDispatch
:: (HscEnv -> ModLocation -> Module -> IO SummariseResult) -- ^ Continuation about how to summarise a home module.
-> HscEnv
+ -> ImportsCache
-> HomeUnit
-> IsBootInterface -- True <=> a {-# SOURCE #-} import
-> Located ModuleName -- Imported module to be summarised
@@ -1370,7 +1407,7 @@ summariseModuleDispatch
-> IO SummariseResult
-summariseModuleDispatch k hsc_env' home_unit is_boot (L _ wanted_mod) mb_pkg excl_mods
+summariseModuleDispatch k hsc_env' imps_cache_ref home_unit is_boot (L _ wanted_mod) mb_pkg excl_mods
| wanted_mod `elem` excl_mods
= return NotThere
| otherwise = find_it
@@ -1380,37 +1417,44 @@ summariseModuleDispatch k hsc_env' home_unit is_boot (L _ wanted_mod) mb_pkg exc
hsc_env = hscSetActiveHomeUnit home_unit hsc_env'
find_it :: IO SummariseResult
-
find_it = do
- found <- findImportedModuleWithIsBoot hsc_env wanted_mod is_boot mb_pkg
- case found of
- Found location mod
- | moduleUnitId mod `Set.member` hsc_all_home_unit_ids hsc_env ->
- -- Home package
- k hsc_env location mod
- | VirtUnit iud <- moduleUnit mod
- , not (isHomeModule home_unit mod)
- -> return $ FoundInstantiation iud
- | otherwise -> return $ External (moduleUnitId mod)
- _ -> return NotThere
- -- Not found
- -- (If it is TRULY not found at all, we'll
- -- error when we actually try to compile)
-
+ imps_cache <- readIORef imps_cache_ref
+ case M.lookup cache_key imps_cache of
+ Just result -> return result
+ Nothing -> do
+ found <- findImportedModuleWithIsBoot hsc_env wanted_mod is_boot mb_pkg
+ r <- case found of
+ Found location mod
+ | moduleUnitId mod `Set.member` hsc_all_home_unit_ids hsc_env ->
+ -- Home package
+ k hsc_env location mod
+ | VirtUnit iud <- moduleUnit mod
+ , not (isHomeModule home_unit mod)
+ -> return $ FoundInstantiation iud
+ | otherwise -> return $ External (moduleUnitId mod)
+ _ -> return NotThere
+ -- Not found
+ -- (If it is TRULY not found at all, we'll
+ -- error when we actually try to compile)
+ modifyImpsCache imps_cache_ref (M.insert cache_key r)
+ return r
+
+ cache_key = ( homeUnitId home_unit, mb_pkg
+ , GWIB{ gwib_mod = wanted_mod, gwib_isBoot = is_boot })
-- | The continuation to summarise a home module if we want to find the source file
-- for it and potentially compile it.
summariseModuleWithSource
:: HomeUnit
- -> M.Map (UnitId, OsPath) ModSummary
- -- ^ Map of old summaries
+ -> ModSummaryCache
+ -- ^ Cache of constructed summaries
-> IsBootInterface -- True <=> a {-# SOURCE #-} import
-> Maybe (StringBuffer, UTCTime)
-> HscEnv
-> ModLocation
-> Module
-> IO SummariseResult
-summariseModuleWithSource home_unit old_summary_map is_boot maybe_buf hsc_env location mod = do
+summariseModuleWithSource home_unit summ_cache_ref is_boot maybe_buf hsc_env location mod = do
-- Adjust location to point to the hs-boot source file,
-- hi file, object file, when is_boot says so
let src_fn = expectJust (ml_hs_file location)
@@ -1430,20 +1474,22 @@ summariseModuleWithSource home_unit old_summary_map is_boot maybe_buf hsc_env lo
where
dflags = hsc_dflags hsc_env
- new_summary_cache_check loc mod src_fn h
- | Just old_summary <- Map.lookup ((toUnitId (moduleUnit mod), src_fn_os)) old_summary_map =
-
- -- check the hash on the source file, and
- -- return the cached summary if it hasn't changed. If the
- -- file has changed then need to resummarise.
- case maybe_buf of
- Just (buf,_) ->
- checkSummaryHash hsc_env (new_summary loc mod src_fn) old_summary loc (fingerprintStringBuffer buf)
- Nothing ->
- checkSummaryHash hsc_env (new_summary loc mod src_fn) old_summary loc h
- | otherwise = new_summary loc mod src_fn h
- where
- src_fn_os = unsafeEncodeUtf src_fn
+ new_summary_cache_check loc mod src_fn h = do
+ summ_cache <- readIORef summ_cache_ref
+ case ml_hs_file_ospath loc >>= \p -> M.lookup (moduleUnitId mod, p) summ_cache of
+ Just (Right (chd_summary, SummFresh)) ->
+ -- Fresh! just return it
+ pure (Right chd_summary)
+ Just (Right (old_summary, SummOld)) -> do
+ -- check the hash on the source file, and
+ -- return the cached summary if it hasn't changed. If the
+ -- file has changed then need to resummarise.
+ case maybe_buf of
+ Just (buf,_) ->
+ checkSummaryHash hsc_env (new_summary loc mod src_fn) old_summary loc (fingerprintStringBuffer buf)
+ Nothing ->
+ checkSummaryHash hsc_env (new_summary loc mod src_fn) old_summary loc h
+ _ -> new_summary loc mod src_fn h
new_summary :: ModLocation
-> Module
@@ -1451,41 +1497,48 @@ summariseModuleWithSource home_unit old_summary_map is_boot maybe_buf hsc_env lo
-> Fingerprint
-> IO (Either DriverMessages ModSummary)
new_summary location mod src_fn src_hash
- = runExceptT $ do
- preimps@PreprocessedImports {..}
- -- Remember to set the active unit here, otherwise the wrong include paths are passed to CPP
- -- See multiHomeUnits_cpp2 test
- <- getPreprocessedImports (hscSetActiveUnitId (moduleUnitId mod) hsc_env) src_fn Nothing maybe_buf
-
- -- NB: Despite the fact that is_boot is a top-level parameter, we
- -- don't actually know coming into this function what the HscSource
- -- of the module in question is. This is because we may be processing
- -- this module because another module in the graph imported it: in this
- -- case, we know if it's a boot or not because of the {-# SOURCE #-}
- -- annotation, but we don't know if it's a signature or a regular
- -- module until we actually look it up on the filesystem.
- let hsc_src
- | is_boot == IsBoot = HsBootFile
- | isHaskellSigFilename src_fn = HsigFile
- | otherwise = HsSrcFile
-
- when (pi_mod_name /= moduleName mod) $
- throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc
- $ DriverFileModuleNameMismatch pi_mod_name (moduleName mod)
-
- let instantiations = homeUnitInstantiations home_unit
- when (hsc_src == HsigFile && isNothing (lookup pi_mod_name instantiations)) $
- throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc
- $ DriverUnexpectedSignature pi_mod_name (checkBuildingCabalPackage dflags) instantiations
-
- liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary
- { nms_src_fn = src_fn
- , nms_src_hash = src_hash
- , nms_hsc_src = hsc_src
- , nms_location = location
- , nms_mod = mod
- , nms_preimps = preimps
- }
+ = do
+ res <- runExceptT $ do
+ preimps@PreprocessedImports {..}
+ -- Remember to set the active unit here, otherwise the wrong include paths are passed to CPP
+ -- See multiHomeUnits_cpp2 test
+ <- getPreprocessedImports (hscSetActiveUnitId (moduleUnitId mod) hsc_env) src_fn Nothing maybe_buf
+
+ -- NB: Despite the fact that is_boot is a top-level parameter, we
+ -- don't actually know coming into this function what the HscSource
+ -- of the module in question is. This is because we may be processing
+ -- this module because another module in the graph imported it: in this
+ -- case, we know if it's a boot or not because of the {-# SOURCE #-}
+ -- annotation, but we don't know if it's a signature or a regular
+ -- module until we actually look it up on the filesystem.
+ let hsc_src
+ | is_boot == IsBoot = HsBootFile
+ | isHaskellSigFilename src_fn = HsigFile
+ | otherwise = HsSrcFile
+
+ when (pi_mod_name /= moduleName mod) $
+ throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc
+ $ DriverFileModuleNameMismatch pi_mod_name (moduleName mod)
+
+ let instantiations = homeUnitInstantiations home_unit
+ when (hsc_src == HsigFile && isNothing (lookup pi_mod_name instantiations)) $
+ throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc
+ $ DriverUnexpectedSignature pi_mod_name (checkBuildingCabalPackage dflags) instantiations
+
+ liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary
+ { nms_src_fn = src_fn
+ , nms_src_hash = src_hash
+ , nms_hsc_src = hsc_src
+ , nms_location = location
+ , nms_mod = mod
+ , nms_preimps = preimps
+ }
+ modifySummCache summ_cache_ref $ case res of
+ Left e -> case ml_hs_file_ospath location of
+ Just p -> M.insert (moduleUnitId mod, p) (Left e)
+ Nothing -> id
+ Right ms -> addModSummaryCache ms SummFresh
+ return res
-- | Convenience named arguments for 'makeNewModSummary' only used to make
-- code more readable, not exported.
@@ -1568,3 +1621,78 @@ getPreprocessedImports hsc_env src_fn mb_phase maybe_buf = do
let pi_srcimps = pi_srcimps'
let pi_theimps = rn_imps pi_theimps'
return PreprocessedImports {..}
+
+--------------------------------------------------------------------------------
+
+-- | In a depth-first order, and starting from the given roots, traverse a
+-- graph by iteratively expanding the visited nodes and accumulating a payload
+-- for each explored node.
+--
+-- The same node is NEVER visited more than once, as long as the the node key
+-- @k@, computed from the node @n@, uniquely identifies that node.
+--
+-- Example: @n@ is instanced to @DownsweepNode@, @k@ is @NodeKey@, and @v@ is @ModuleNodeEdge@.
+--
+-- Returning 'Nothing' in the @expand@ function means that node couldn't be
+-- expanded yet, and we should continue without failure. We do not cache a
+-- "negative" result for the 'Nothing', because we may yet discover new
+-- information (in the monadic context) and try to expand that node in the
+-- future again, then successfully.
+--
+-- See also Note [Downsweep Control Flow and Caching]
+dfsBuild :: (Ord k, Monad m, Outputable n) => Maybe (Map.Map k v) -> [n] -> (n -> k) -> (n -> m (Maybe (v,[n]))) -> m (Map.Map k v)
+dfsBuild base_map roots key expand = go roots (fromMaybe Map.empty base_map)
+ where
+ go [] visited = pure visited
+ go (s:ss) visited
+ | k `Map.member` visited
+ = go ss visited
+ | otherwise
+ = do r <- expand s
+ case r of
+ Nothing -> go ss visited -- Skip!
+ Just (v,ns) ->
+ go (ns ++ ss {- todo: not use ++ here? -})
+ (Map.insert k v visited)
+ where
+ k = key s
+
+{-
+Note [Downsweep Control Flow and Caching]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The control flow of downsweep is extracted into a single function `dfsBuild`,
+which takes care of iteratively expanding and traversing all nodes of the
+in-construction module graph necessary to build a full `ModuleGraph` at the
+end.
+
+There are three levels of caching going on, all of which are necessary
+to make sure we don't do repeated work (specifically: NEVER summarise
+the same module twice).
+
+1. `dfsBuild` accumulates the final module graph and never revisits the
+ same node of the module graph. Cache is keyed by the final
+ `ModuleGraph`s `NodeKey`s.
+
+2. For Module A in home-unit u1, each import in the list of imports
+ needs to be *found* (call to `findImportedModuleWithIsBoot`): at this
+ point, we only have the `ModuleName` of the import, not the `Module`.
+ This *finding* is somewhat expensive, so we cache it as well
+ (`ImportsCache`). The cache key is the home-unit to which the module
+ belongs~[1], the import package qualifier, and the ModuleName.
+
+ [1] Different home-units will have different package flags, which means
+ potentially different `Module` resolution for the same `ModuleName`.
+
+3. The most expensive operation we want to avoid is summarising a
+ `Module` into a `ModSummary`, which notably involves parsing the
+ module header from scratch.
+ The third cache, in essence, maps a `Module` to its `ModSummary`
+ (named `ModSummaryCache`). This cache upholds the invariant: we NEVER
+ summarise the same module twice. In practice, the cache key is the
+ Module's UnitId and the Source path; the reason is we need to
+ distinguish between `.hs` and `.hs-boot` files, as their summaries
+ will differ.
+
+ Note that (2) can't guarantee this alone: Two ModuleName imports in
+ separate units can (and likely do) map to the same `Module`.
+-}
=====================================
utils/check-ppr/Main.hs
=====================================
@@ -18,6 +18,7 @@ import System.Environment( getArgs )
import System.Exit
import System.FilePath
import System.IO
+import Data.IORef
usage :: String
usage = unlines
@@ -85,7 +86,8 @@ parseOneFile libdir fileName = do
let dflags2 = dflags `gopt_set` Opt_KeepRawTokenStream
_ <- setSessionDynFlags dflags2
hsc_env <- getSession
- mms <- liftIO $ summariseFile hsc_env (hsc_home_unit hsc_env) mempty fileName Nothing Nothing
+ cache <- newIORef mempty
+ mms <- liftIO $ summariseFile hsc_env (hsc_home_unit hsc_env) cache fileName Nothing Nothing
case mms of
Left _err -> error "parseOneFile"
Right ms -> parseModule ms
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/567af5bea1ca44fb8f8583caebcb598…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/567af5bea1ca44fb8f8583caebcb598…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/sjakobi/mr16259] 5 commits: StgToCmm: don't untag primop args when unarisation broke positional alignment
by Simon Jakobi (＠sjakobi2) 10 Jul '26
by Simon Jakobi (＠sjakobi2) 10 Jul '26
10 Jul '26
Simon Jakobi pushed to branch wip/sjakobi/mr16259 at Glasgow Haskell Compiler / GHC
Commits:
e5d219db by Simon Jakobi at 2026-07-10T23:19:05+02:00
StgToCmm: don't untag primop args when unarisation broke positional alignment
cgOpApp zips the primop's declared argument types positionally against
the STG args to decide untagging (see Note [Pointer tagging of unlifted
boxed primitives]), but unarisation splits a declared unboxed-tuple
argument (e.g. packFloatX4#'s) into several STG args, so the zip
truncated and dropped arguments: "emitPrimOp: VecPackOp has wrong
number of arguments", failing all simd tests in the first CI run of
!16329.
When the lengths disagree we now skip declared-type-driven untagging
altogether; no such primop takes a boxed pointer through a tuple.
Assisted-by: Claude Fable 5
- - - - -
71fa62be by Simon Jakobi at 2026-07-10T23:19:26+02:00
rts: untag MVar# pointers obtained through StablePtrs
MVar# pointers now carry tag 1 (#23173), and deRefStablePtr returns the
pointer as stored, so C code casting the result to StgMVar* must strip
the tag first: hs_try_putmvar (RtsAPI.c, plus the deferred-PutMVar path
in Schedule.c) and sendCloneStackMessage (CloneStack.c).
Fixes hs_try_putmvar001/2/3, T15427, cloneThreadStack{,Migrating} and
T26640 from the first CI run of !16329.
Assisted-by: Claude Fable 5
- - - - -
7d55d5a0 by Simon Jakobi at 2026-07-10T23:19:36+02:00
foreign import prim: callees must tag returned unlifted boxed results
A foreign-prim callee is a producer under the tagging discipline of
#23173: an unlifted boxed result must be returned with its proper tag,
just like the out-of-line primops in rts/PrimOps.cmm, because compiled
code assumes the tag on the result. T21305's Cmm now returns the
MutableByteArray# tagged; without it the caller's subtract-1 untag read
one byte off. The convention is documented in Note [Pointer tagging of
unlifted boxed primitives] and the changelog entry.
Assisted-by: Claude Fable 5
- - - - -
a43c6f95 by Simon Jakobi at 2026-07-10T23:19:46+02:00
testsuite: accept T21710a output for the shared stg_enteredTaggable stub
The expected output still had the per-constructor checkEnteredTaggable
ccall plus return call; each constructor entry now makes a single call
to the shared stg_enteredTaggable stub.
Assisted-by: Claude Fable 5
- - - - -
c00b949f by Simon Jakobi at 2026-07-10T23:19:46+02:00
Accept the T13960 compile-time regression from enter-taggable enforcement
The ~3% compile-time allocation increase on T13960 is the cost of the
emitEnter tag test, the semantic core of the invariant enforcement
(#23173). The perf driver reads the Metric Increase block from the HEAD
commit only, hence this empty commit at the branch tip.
-------------------------
Metric Increase:
T13960
-------------------------
Assisted-by: Claude Fable 5
- - - - -
7 changed files:
- changelog.d/enter-taggable-invariant-23173
- compiler/GHC/StgToCmm/Prim.hs
- rts/CloneStack.c
- rts/RtsAPI.c
- rts/Schedule.c
- testsuite/tests/codeGen/should_compile/T21710a.stderr
- testsuite/tests/ffi/should_run/T21305_cmm.cmm
Changes:
=====================================
changelog.d/enter-taggable-invariant-23173
=====================================
@@ -12,4 +12,10 @@ description: {
entry code of a taggable normal form is unreachable: entering such a
closure prints a one-shot warning at runtime, or aborts the program when
the new RTS flag ``--fatal-enter-taggable`` is given.
+
+ ``foreign import prim`` callees receive unlifted boxed arguments untagged,
+ as before, but must now return unlifted boxed results with their proper
+ pointer tag (1 for primitive objects). Likewise, C code that obtains an
+ unlifted boxed value, e.g. an ``MVar#``, through a ``StablePtr`` must strip
+ the tag before dereferencing the pointer.
}
=====================================
compiler/GHC/StgToCmm/Prim.hs
=====================================
@@ -92,8 +92,15 @@ cgOpApp (StgPrimOp primop) args res_ty = do
cmm_args <- getNonVoidArgAmodes args
-- See Note [Pointer tagging of unlifted boxed primitives]
let decl_tys = map scaledThing (fst (splitFunTys (dropForAlls (primOpType primop))))
- nv_decl_tys = [ dty
- | (dty, arg) <- zip decl_tys args
+ -- Unarisation splits a declared unboxed-tuple argument (e.g.
+ -- packFloatX4#'s) into several STG args, breaking positional
+ -- alignment with the declared types. No such primop takes a boxed
+ -- pointer through a tuple, so fall back to not untagging anything.
+ mb_decl_tys
+ | decl_tys `equalLength` args = map Just decl_tys
+ | otherwise = map (const Nothing) args
+ nv_decl_tys = [ mb_dty
+ | (mb_dty, arg) <- zip mb_decl_tys args
, not (null (stgArgRep arg)) ]
cmm_args' = zipWith3 (untagPrimArg platform) nv_decl_tys (nonVoidStgArgs args) cmm_args
-- The RTS dereferences the key field of a Weak directly (GC key
@@ -145,9 +152,10 @@ cmmPrimOpApp cfg primop cmm_args mres_ty = do
-- yet (e.g. ThreadId#s in the array filled in by C listThreads).
--
-- See Note [Pointer tagging of unlifted boxed primitives].
-untagPrimArg :: Platform -> Type -> NonVoid StgArg -> CmmExpr -> CmmExpr
-untagPrimArg platform decl_ty nv_arg e
- | Just tc <- tyConAppTyCon_maybe decl_ty
+untagPrimArg :: Platform -> Maybe Type -> NonVoid StgArg -> CmmExpr -> CmmExpr
+untagPrimArg platform mb_decl_ty nv_arg e
+ | Just decl_ty <- mb_decl_ty
+ , Just tc <- tyConAppTyCon_maybe decl_ty
= if isKnownTag1PrimTyCon tc
then cmmOffsetB platform e (-1)
else if isUnliftedBoxedTy (stgArgType (fromNonVoid nv_arg))
@@ -238,6 +246,11 @@ Foreign and foreign-prim arguments
@Any \@UnliftedRep@ arguments, so the predicate here admits any unlifted boxed
type rather than only the primitive ones.
+ In the other direction the callee is a producer: an unlifted boxed value
+ /returned/ by a 'foreign import prim' must carry its proper tag (1 for a
+ primitive object), just like the out-of-line primops in rts/PrimOps.cmm.
+ Compiled code assumes the tag on the result (see e.g. T21305).
+
Stripping the tag from an already-untagged pointer is the identity, so the
boundaries are correct whether or not a given producer has been taught to tag.
=====================================
rts/CloneStack.c
=====================================
@@ -78,7 +78,9 @@ void sendCloneStackMessage(StgTSO *tso, HsStablePtr mvar) {
MessageCloneStack *msg;
msg = (MessageCloneStack *)allocate(srcCapability, sizeofW(MessageCloneStack));
msg->tso = tso;
- msg->result = (StgMVar*)deRefStablePtr(mvar);
+ // MVar# pointers carry tag 1; see Note [Pointer tagging of unlifted boxed
+ // primitives] in GHC.StgToCmm.Prim.
+ msg->result = (StgMVar*)UNTAG_CLOSURE((StgClosure*)deRefStablePtr(mvar));
SET_HDR_RELEASE(msg, &stg_MSG_CLONE_STACK_info, CCS_SYSTEM);
sendMessage(srcCapability, tso->cap, (Message *)msg);
=====================================
rts/RtsAPI.c
=====================================
@@ -982,7 +982,9 @@ void hs_try_putmvar_with_value (/* in */ int capability,
#if !defined(THREADED_RTS)
- performTryPutMVar(cap, (StgMVar*)deRefStablePtr(mvar), value);
+ // MVar# pointers carry tag 1; see Note [Pointer tagging of unlifted boxed
+ // primitives] in GHC.StgToCmm.Prim.
+ performTryPutMVar(cap, (StgMVar*)UNTAG_CLOSURE((StgClosure*)deRefStablePtr(mvar)), value);
freeStablePtr(mvar);
#else
@@ -995,7 +997,8 @@ void hs_try_putmvar_with_value (/* in */ int capability,
task->cap = cap;
RELEASE_LOCK(&cap->lock);
- performTryPutMVar(cap, (StgMVar*)deRefStablePtr(mvar), value);
+ performTryPutMVar(cap, (StgMVar*)UNTAG_CLOSURE((StgClosure*)deRefStablePtr(mvar)),
+ value);
freeStablePtr(mvar);
=====================================
rts/Schedule.c
=====================================
@@ -1053,7 +1053,8 @@ scheduleProcessInbox (Capability **pcap USED_IF_THREADS)
while (p != NULL) {
pnext = p->link;
- performTryPutMVar(cap, (StgMVar*)deRefStablePtr(p->mvar),
+ performTryPutMVar(cap,
+ (StgMVar*)UNTAG_CLOSURE((StgClosure*)deRefStablePtr(p->mvar)),
Unit_closure);
freeStablePtr(p->mvar);
stgFree(p);
=====================================
testsuite/tests/codeGen/should_compile/T21710a.stderr
=====================================
@@ -53,35 +53,34 @@
}
{offset
cqw: // global
- if ((Sp + -8) < SpLim) (likely: False) goto cqx; else goto cqy; // CmmCondBranch
+ if ((Sp + -8) < SpLim) (likely: False) goto cqx; else goto cqy;
cqx: // global
- R1 = M.foo_closure; // CmmAssign
- call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8; // CmmCall
+ R1 = M.foo_closure;
+ call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8;
cqy: // global
- I64[Sp - 8] = cqo; // CmmStore
- R1 = R2; // CmmAssign
- Sp = Sp - 8; // CmmAssign
- if (R1 & 7 != 0) goto cqo; else goto cqp; // CmmCondBranch
+ I64[Sp - 8] = cqo;
+ R1 = R2;
+ Sp = Sp - 8;
+ if (R1 & 7 != 0) goto cqo; else goto cqp;
cqp: // global
- call (I64![R1])(R1) returns to cqo, args: 8, res: 8, upd: 8; // CmmCall
+ call (I64![R1])(R1) returns to cqo, args: 8, res: 8, upd: 8;
cqo: // global
- _cqv::P64 = R1 & 7; // CmmAssign
- if (_cqv::P64 != 1) goto n0; else goto cqt; // CmmCondBranch
+ _cqv::P64 = R1 & 7;
+ if (_cqv::P64 != 1) goto n0; else goto cqt;
n0: // global
- if (_cqv::P64 != 2) goto cqs; else goto cqu; // CmmCondBranch
+ if (_cqv::P64 != 2) goto cqs; else goto cqu;
cqs: // global
- // dataToTagSmall#
- R1 = R1 & 7 - 1; // CmmAssign
- Sp = Sp + 8; // CmmAssign
- call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall
+ R1 = R1 & 7 - 1;
+ Sp = Sp + 8;
+ call (P64[Sp])(R1) args: 8, res: 0, upd: 8;
cqu: // global
- R1 = 42; // CmmAssign
- Sp = Sp + 8; // CmmAssign
- call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall
+ R1 = 42;
+ Sp = Sp + 8;
+ call (P64[Sp])(R1) args: 8, res: 0, upd: 8;
cqt: // global
- R1 = 2; // CmmAssign
- Sp = Sp + 8; // CmmAssign
- call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall
+ R1 = 2;
+ Sp = Sp + 8;
+ call (P64[Sp])(R1) args: 8, res: 0, upd: 8;
}
},
section ""data" . M.foo_closure" {
@@ -92,27 +91,7 @@
==================== Output Cmm ====================
-[section ""cstring" . cqJ_str" {
- cqJ_str:
- I8[] "A"
- },
- section ""cstring" . cqL_str" {
- cqL_str:
- I8[] "B"
- },
- section ""cstring" . cqN_str" {
- cqN_str:
- I8[] "C"
- },
- section ""cstring" . cqP_str" {
- cqP_str:
- I8[] "D"
- },
- section ""cstring" . cqR_str" {
- cqR_str:
- I8[] "E"
- },
- section ""relreadonly" . M.E_closure_tbl" {
+[section ""relreadonly" . M.E_closure_tbl" {
M.E_closure_tbl:
const M.A_closure+1;
const M.B_closure+2;
@@ -121,73 +100,63 @@
const M.E_closure+5;
},
M.A_con_entry() { // []
- { info_tbls: [(cqK,
+ { info_tbls: [(cqJ,
label: M.A_con_info
rep: HeapRep 1 nonptrs { Con {tag: 0 descr:"main:M.A"} }
srt: Nothing)]
stack_info: arg_space: 8
}
{offset
- cqK: // global
- call "ccall" arg hints: [PtrHint] result hints: [] checkEnteredTaggable(cqJ_str); // CmmUnsafeForeignCall
- R1 = R1 + 1; // CmmAssign
- call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall
+ cqJ: // global
+ call stg_enteredTaggable(R1) args: 8, res: 0, upd: 8;
}
},
M.B_con_entry() { // []
- { info_tbls: [(cqM,
+ { info_tbls: [(cqK,
label: M.B_con_info
rep: HeapRep 1 nonptrs { Con {tag: 1 descr:"main:M.B"} }
srt: Nothing)]
stack_info: arg_space: 8
}
{offset
- cqM: // global
- call "ccall" arg hints: [PtrHint] result hints: [] checkEnteredTaggable(cqL_str); // CmmUnsafeForeignCall
- R1 = R1 + 2; // CmmAssign
- call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall
+ cqK: // global
+ call stg_enteredTaggable(R1) args: 8, res: 0, upd: 8;
}
},
M.C_con_entry() { // []
- { info_tbls: [(cqO,
+ { info_tbls: [(cqL,
label: M.C_con_info
rep: HeapRep 1 nonptrs { Con {tag: 2 descr:"main:M.C"} }
srt: Nothing)]
stack_info: arg_space: 8
}
{offset
- cqO: // global
- call "ccall" arg hints: [PtrHint] result hints: [] checkEnteredTaggable(cqN_str); // CmmUnsafeForeignCall
- R1 = R1 + 3; // CmmAssign
- call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall
+ cqL: // global
+ call stg_enteredTaggable(R1) args: 8, res: 0, upd: 8;
}
},
M.D_con_entry() { // []
- { info_tbls: [(cqQ,
+ { info_tbls: [(cqM,
label: M.D_con_info
rep: HeapRep 1 nonptrs { Con {tag: 3 descr:"main:M.D"} }
srt: Nothing)]
stack_info: arg_space: 8
}
{offset
- cqQ: // global
- call "ccall" arg hints: [PtrHint] result hints: [] checkEnteredTaggable(cqP_str); // CmmUnsafeForeignCall
- R1 = R1 + 4; // CmmAssign
- call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall
+ cqM: // global
+ call stg_enteredTaggable(R1) args: 8, res: 0, upd: 8;
}
},
M.E_con_entry() { // []
- { info_tbls: [(cqS,
+ { info_tbls: [(cqN,
label: M.E_con_info
rep: HeapRep 1 nonptrs { Con {tag: 4 descr:"main:M.E"} }
srt: Nothing)]
stack_info: arg_space: 8
}
{offset
- cqS: // global
- call "ccall" arg hints: [PtrHint] result hints: [] checkEnteredTaggable(cqR_str); // CmmUnsafeForeignCall
- R1 = R1 + 5; // CmmAssign
- call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall
+ cqN: // global
+ call stg_enteredTaggable(R1) args: 8, res: 0, upd: 8;
}
}]
=====================================
testsuite/tests/ffi/should_run/T21305_cmm.cmm
=====================================
@@ -2,5 +2,8 @@
f(P_ a, P_ b, P_ c) {
I64[c + SIZEOF_StgArrBytes + 8] = 770000;
- return (b, a, c);
+ // c arrives untagged and is a MutableByteArray#, so it must be returned
+ // with tag 1; see Note [Pointer tagging of unlifted boxed primitives] in
+ // GHC.StgToCmm.Prim.
+ return (b, a, c + 1);
}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/14141caa5a34e1a3b2cc35eef94359…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/14141caa5a34e1a3b2cc35eef94359…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/sjakobi/udfm-placement] UDFM: represent placement-sort holes with a TaggedHole constructor
by Simon Jakobi (＠sjakobi2) 10 Jul '26
by Simon Jakobi (＠sjakobi2) 10 Jul '26
10 Jul '26
Simon Jakobi pushed to branch wip/sjakobi/udfm-placement at Glasgow Haskell Compiler / GHC
Commits:
a70e4b42 by Simon Jakobi at 2026-07-10T00:34:01+02:00
UDFM: represent placement-sort holes with a TaggedHole constructor
The placement sort in eltsUDFM/udfmToList/foldUDFM seeds gap slots of its
SmallArray with a sentinel. Previously that sentinel was
`TaggedVal (unsafeCoerce ()) (-1)`, relying on () having the same boxed
representation as the element type. Replace it with a proper nullary
constructor, TaggedHole, so the readout distinguishes gaps by constructor
instead of a tag < 0 test, and no unsafe coercion is needed. The accessors
taggedFst/taggedSnd panic on TaggedHole, since it must never be stored in a
map.
Compiler allocation is neutral (T13719 +0.01%, T17836 -0.14%; both within
noise). See Note [Sorting a UDFM].
Assisted-by: Claude Opus 4.8
- - - - -
1 changed file:
- compiler/GHC/Types/Unique/DFM.hs
Changes:
=====================================
compiler/GHC/Types/Unique/DFM.hs
=====================================
@@ -74,6 +74,7 @@ import GHC.Prelude
import GHC.Types.Unique ( Uniquable(..), Unique, getKey, mkUniqueGrimily )
import GHC.Utils.Outputable
+import GHC.Utils.Panic (panic)
import qualified GHC.Data.Word64Map.Strict as MS
import qualified GHC.Data.Word64Map as M
@@ -135,19 +136,24 @@ import qualified GHC.Data.Word64Set as W
-- | A type of values carrying an insertion tag
data TaggedVal val =
- TaggedVal
- !val
- {-# UNPACK #-} !Int -- ^ insertion tag
+ TaggedVal
+ !val
+ {-# UNPACK #-} !Int -- ^ insertion tag
+ | TaggedHole -- ^ placement-sort gap sentinel; never stored in a map.
+ -- See Note [Sorting a UDFM].
deriving stock (Data, Functor, Foldable, Traversable)
taggedFst :: TaggedVal val -> val
taggedFst (TaggedVal v _) = v
+taggedFst TaggedHole = panic "taggedFst: TaggedHole"
taggedSnd :: TaggedVal val -> Int
taggedSnd (TaggedVal _ i) = i
+taggedSnd TaggedHole = panic "taggedSnd: TaggedHole"
instance Eq val => Eq (TaggedVal val) where
(TaggedVal v1 _) == (TaggedVal v2 _) = v1 == v2
+ _ == _ = panic "TaggedVal (==): TaggedHole"
-- | Type of unique deterministic finite maps
--
@@ -207,7 +213,7 @@ addToUDFM_Directly :: UniqDFM key elt -> Unique -> elt -> UniqDFM key elt
addToUDFM_Directly (UDFM m i) u v
= UDFM (MS.insertWith tf (getKey u) (TaggedVal v i) m) (i + 1)
where
- tf (TaggedVal new_v _) (TaggedVal _ old_i) = TaggedVal new_v old_i
+ tf new old = TaggedVal (taggedFst new) (taggedSnd old)
-- Keep the old tag, but insert the new value
-- This means that udfmToList typically returns elements
-- in the order of insertion, rather than the reverse
@@ -224,8 +230,8 @@ addToUDFM_C_Directly
addToUDFM_C_Directly f (UDFM m i) u v
= UDFM (MS.insertWith tf (getKey u) (TaggedVal v i) m) (i + 1)
where
- tf (TaggedVal new_v _) (TaggedVal old_v old_i)
- = TaggedVal (f old_v new_v) old_i
+ tf new old
+ = TaggedVal (f (taggedFst old) (taggedFst new)) (taggedSnd old)
-- Flip the arguments, because M.insertWith uses (new->old->result)
-- but f needs (old->new->result)
-- Like addToUDFM_Directly, keep the old tag
@@ -378,7 +384,7 @@ foldWithKeyUDFM k z m = foldr (uncurry k) z (udfmToList m)
nonDetStrictFoldUDFM :: (elt -> a -> a) -> a -> UniqDFM key elt -> a
nonDetStrictFoldUDFM k z (UDFM m _i) = foldl' k' z m
where
- k' acc (TaggedVal v _) = k v acc
+ k' acc tv = k (taggedFst tv) acc
{- Note [Cost of deterministic iteration]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -440,22 +446,13 @@ folding the sorted elements with no intermediate list. foldUDFM is INLINE and
dispatches through the out-of-line fold_elts_nonempty, where the fusion happens
once -- so the fold is list-free without inlining the sort into every consumer.
-Holes: slots whose tag never occurs keep the initial sentinel, a TaggedVal
-with tag -1. Real tags are non-negative, so the readout skips on tag < 0 and
-never reads the sentinel's value field. But that field is strict, so the
-sentinel still needs a value in WHNF: a panic thunk is out (it would be forced
--- and crash -- the moment the readout inspects a hole's tag). We use
-@unsafeCoerce ()@: () is a static, already-evaluated nullary constructor, so
-the sentinel is one shared top-level value -- no per-call allocation, and it
-retains nothing.
-
-The unsafeCoerce is safe here because r is always a lifted, boxed (pointer)
-type -- it comes from the map's elements -- so a pointer to () has the right
-representation. The GC only ever traces that pointer (() is a valid closure);
-the value is never evaluated or used as an r, since the readout takes values
-only from filled slots. Borrowing a real element instead would also type-check
-but costs a per-call thunk that retains the whole source map until the holes
-are read.
+Holes: slots whose tag never occurs keep the initial sentinel, the nullary
+constructor TaggedHole. The readout distinguishes it from a real TaggedVal by
+constructor, so it never touches a filled element's value in a hole slot.
+TaggedHole is static (a nullary constructor is a single shared closure), so
+newSmallArray fills every slot with the same pointer -- no per-call allocation,
+nothing retained. TaggedHole must never be stored in a map; the accessors
+(taggedFst, taggedSnd) panic on it to catch any invariant violation.
This sorting method loses when ub is much larger than n = M.size m: ub never
shrinks (overwrites keep bumping it, delete/filter shrink n but not ub). We
@@ -487,10 +484,10 @@ placementSort :: forall e r. Int
-- consuming fold. See Note [Sorting a UDFM].
placementSort ub mk m = build gen
where
- -- The tag -1 marks unfilled slots; the value field is never read, but it
- -- is strict, so it needs a WHNF value of type r. See Note [Sorting a UDFM].
+ -- Unfilled slots hold the TaggedHole sentinel; the readout skips it.
+ -- See Note [Sorting a UDFM].
hole :: TaggedVal r
- hole = TaggedVal (unsafeCoerce ()) (-1)
+ hole = TaggedHole
fill :: SmallMutableArray s (TaggedVal r) -> State# s -> (# State# s, () #)
fill marr s = case M.traverseWithKey_ write m of ST st -> st s
@@ -511,17 +508,17 @@ placementSort ub mk m = build gen
readout :: SmallArray (TaggedVal r) -> Int -> b
readout arr j
| j >= ub = nil
- | t < 0 = readout arr (j + 1)
- | otherwise = cons v (readout arr (j + 1))
- where TaggedVal v t = indexSmallArray arr j
+ | otherwise = case indexSmallArray arr j of
+ TaggedHole -> readout arr (j + 1)
+ TaggedVal v _ -> cons v (readout arr (j + 1))
filterUDFM :: (elt -> Bool) -> UniqDFM key elt -> UniqDFM key elt
-filterUDFM p (UDFM m i) = UDFM (M.filter (\(TaggedVal v _) -> p v) m) i
+filterUDFM p (UDFM m i) = UDFM (M.filter (p . taggedFst) m) i
filterUDFM_Directly :: (Unique -> elt -> Bool) -> UniqDFM key elt -> UniqDFM key elt
filterUDFM_Directly p (UDFM m i) = UDFM (M.filterWithKey p' m) i
where
- p' k (TaggedVal v _) = p (mkUniqueGrimily k) v
+ p' k tv = p (mkUniqueGrimily k) (taggedFst tv)
udfmRestrictKeys :: UniqDFM key elt -> UniqDFM key elt2 -> UniqDFM key elt
udfmRestrictKeys (UDFM a i) (UDFM b _) = UDFM (M.restrictKeys a (M.keysSet b)) i
@@ -645,7 +642,7 @@ alterUDFM f (UDFM m i) k =
UDFM (M.alter alterf (getKey $ getUnique k) m) (i + 1)
where
alterf Nothing = inject $ f Nothing
- alterf (Just (TaggedVal v _)) = inject $ f (Just v)
+ alterf (Just tv) = inject $ f (Just (taggedFst tv))
inject Nothing = Nothing
inject (Just v) = Just $ TaggedVal v i
@@ -664,7 +661,7 @@ upsertUDFM f (UDFM m i) k =
UDFM (MS.upsert upsertf (getKey $ getUnique k) m) (i + 1)
where
upsertf Nothing = TaggedVal (f Nothing) i
- upsertf (Just (TaggedVal v _)) = TaggedVal (f (Just v)) i
+ upsertf (Just tv) = TaggedVal (f (Just (taggedFst tv))) i
-- | The expression (@'alterUDFM_L' f map k@) alters value @x@ at @k@, or absence
-- thereof and returns the new element at @k@ if there is any.
@@ -687,7 +684,7 @@ alterUDFM_L f (UDFM m i) k =
where
alterf :: Maybe (TaggedVal elt) -> (Maybe (TaggedVal elt))
alterf Nothing = inject $ f Nothing
- alterf (Just (TaggedVal v _)) = inject $ f (Just v)
+ alterf (Just tv) = inject $ f (Just (taggedFst tv))
inject Nothing = Nothing
inject (Just v) = Just $ TaggedVal v i
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a70e4b4285630695aecc61665101c04…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a70e4b4285630695aecc61665101c04…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/spj-reinstallable-base2] Major patch to re-engineer known-key names
by Rodrigo Mesquita (＠alt-romes) 10 Jul '26
by Rodrigo Mesquita (＠alt-romes) 10 Jul '26
10 Jul '26
Rodrigo Mesquita pushed to branch wip/spj-reinstallable-base2 at Glasgow Haskell Compiler / GHC
Commits:
d18aabb0 by Simon Peyton Jones at 2026-07-10T20:46:40+01:00
Major patch to re-engineer known-key names
This big patch implements the New Plan for known-key names,
described in #27013.
Read the big Note [Overview of known-key names] in GHC.Types.Name
Some things had to be reworked slightly to accomodate the new known-keys
design. A significant one was the generation of auxiliary KindRep
bindings, which was greatly simplified. Note [Grand plan for Typeable]
was updated accordingly. Another example: GHC.Internal.CString was
merged into GHC.Internal.Types.
Co-authored-by: Rodrigo Mesquita <rodrigo.m.mesquita(a)gmail.com>
The couple hundreds of hours spent here by Rodrigo were sponsored by Well-Typed
Metrics: compile_time/bytes allocated
-------------------------------------
Baseline
Test Metric value New value Change
------------------------------------------------------------------------------------------
MultiComponentModules100(normal) ghc/alloc 24,312,779,672 24,990,470,432 +2.8% BAD
MultiComponentModulesRecomp(normal) ghc/alloc 601,924,960 621,884,888 +3.3% BAD
MultiComponentModulesRecomp100(normal) ghc/alloc 11,884,065,432 12,531,373,704 +5.4% BAD
MultiLayerModules(normal) ghc/alloc 3,861,537,072 3,706,919,512 -4.0% GOOD
T13701(normal) ghc/alloc 3,517,246,392 3,237,179,616 -8.0% GOOD
T13820(normal) ghc/alloc 28,961,056 29,663,208 +2.4% BAD
T14697(normal) ghc/alloc 472,044,184 443,550,048 -6.0% GOOD
T18140(normal) ghc/alloc 47,905,664 49,115,808 +2.5% BAD
T4801(normal) ghc/alloc 269,339,096 263,432,040 -2.2% GOOD
T783(normal) ghc/alloc 341,112,672 333,339,952 -2.3% GOOD
hard_hole_fits(normal) ghc/alloc 222,164,728 213,433,808 -3.9% GOOD
mhu-perf(normal) ghc/alloc 49,011,440 46,706,280 -4.7% GOOD
geo. mean +0.1%
minimum -8.0%
maximum +5.4%
All performance regressions were investigated in depth. The surviving
ones:
- MultiComponentModules100, MultiComponentModulesRecomp100,
MultiComponentModulesRecomp regresses because existing bugs that make
an additional implicit edge do too much redundant work: #27053 and #27461
- T13820, T18140, T10547 regress because we load an additional interface and
associated Names for GHC.Essentials.
-------------------------
Metric Decrease:
MultiLayerModules
T13701
T14697
T4801
T783
hard_hole_fits
mhu-perf
size_hello_obj
Metric Increase:
LinkableUsage01
MultiComponentModules100
MultiComponentModulesRecomp
MultiComponentModulesRecomp100
T10547
T13820
T18140
-------------------------
- - - - -
727 changed files:
- + changelog.d/refactor-known-names
- compiler/GHC.hs
- + compiler/GHC/Builtin.hs
- + compiler/GHC/Builtin/KnownKeys.hs
- + compiler/GHC/Builtin/KnownOccs.hs
- + compiler/GHC/Builtin/Modules.hs
- − compiler/GHC/Builtin/Names.hs
- − compiler/GHC/Builtin/Names/TH.hs
- compiler/GHC/Builtin/PrimOps.hs
- compiler/GHC/Builtin/PrimOps/Casts.hs
- compiler/GHC/Builtin/PrimOps/Ids.hs
- + compiler/GHC/Builtin/TH.hs
- compiler/GHC/Builtin/Uniques.hs
- compiler/GHC/Builtin/Uniques.hs-boot
- − compiler/GHC/Builtin/Utils.hs
- + compiler/GHC/Builtin/WiredIn/Ids.hs
- compiler/GHC/Builtin/Types/Prim.hs → compiler/GHC/Builtin/WiredIn/Prim.hs
- compiler/GHC/Builtin/Types/Literals.hs → compiler/GHC/Builtin/WiredIn/TypeLits.hs
- compiler/GHC/Builtin/Types.hs → compiler/GHC/Builtin/WiredIn/Types.hs
- compiler/GHC/Builtin/Types.hs-boot → compiler/GHC/Builtin/WiredIn/Types.hs-boot
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/Core.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/DataCon.hs
- compiler/GHC/Core/FVs.hs
- compiler/GHC/Core/FamInstEnv.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Make.hs
- compiler/GHC/Core/Multiplicity.hs
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Opt/ConstantFold.hs
- compiler/GHC/Core/Opt/CprAnal.hs
- compiler/GHC/Core/Opt/DmdAnal.hs
- compiler/GHC/Core/Opt/LiberateCase.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/SetLevels.hs
- compiler/GHC/Core/Opt/Simplify/Env.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/SpecConstr.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Opt/WorkWrap/Utils.hs
- compiler/GHC/Core/Ppr.hs
- compiler/GHC/Core/Predicate.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/Core/SimpleOpt.hs
- compiler/GHC/Core/Subst.hs
- compiler/GHC/Core/TyCo/FVs.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Core/Unfold.hs
- compiler/GHC/Core/Unify.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/CoreToStg.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/Config/Tidy.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Env.hs
- compiler/GHC/Driver/Env/KnotVars.hs
- compiler/GHC/Driver/Env/Types.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Main/Hsc.hs
- compiler/GHC/Driver/Main/Passes.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Driver/Plugins.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Lit.hs
- compiler/GHC/Hs/Pat.hs
- compiler/GHC/Hs/Syn/Type.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/HsToCore/Arrows.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Foreign/C.hs
- compiler/GHC/HsToCore/Foreign/Call.hs
- compiler/GHC/HsToCore/Foreign/JavaScript.hs
- compiler/GHC/HsToCore/Foreign/Utils.hs
- compiler/GHC/HsToCore/Foreign/Wasm.hs
- compiler/GHC/HsToCore/ListComp.hs
- compiler/GHC/HsToCore/Match.hs
- compiler/GHC/HsToCore/Match/Literal.hs
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/HsToCore/Pmc/Check.hs
- compiler/GHC/HsToCore/Pmc/Desugar.hs
- compiler/GHC/HsToCore/Pmc/Ppr.hs
- compiler/GHC/HsToCore/Pmc/Solver.hs
- compiler/GHC/HsToCore/Pmc/Solver/Types.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/HsToCore/Types.hs
- compiler/GHC/HsToCore/Utils.hs
- compiler/GHC/Iface/Binary.hs
- compiler/GHC/Iface/Env.hs
- − compiler/GHC/Iface/Env.hs-boot
- compiler/GHC/Iface/Errors/Ppr.hs
- compiler/GHC/Iface/Errors/Types.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Iface/Make.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/Iface/Type.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/Errors/Ppr.hs
- compiler/GHC/Parser/Header.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Plugins.hs
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Lit.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Rename/Splice.hs
- compiler/GHC/Rename/Unbound.hs
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Runtime/Context.hs
- compiler/GHC/Runtime/Debugger.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Runtime/Heap/Inspect.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/Runtime/Loader.hs
- compiler/GHC/Stg/BcPrep.hs
- compiler/GHC/Stg/Unarise.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/StgToCmm/Bind.hs
- compiler/GHC/StgToCmm/DataCon.hs
- compiler/GHC/StgToCmm/Env.hs
- compiler/GHC/StgToCmm/Foreign.hs
- compiler/GHC/StgToCmm/Lit.hs
- compiler/GHC/StgToCmm/Ticky.hs
- compiler/GHC/StgToJS/Apply.hs
- compiler/GHC/StgToJS/Arg.hs
- compiler/GHC/StgToJS/Expr.hs
- compiler/GHC/StgToJS/FFI.hs
- compiler/GHC/StgToJS/Linker/Utils.hs
- compiler/GHC/StgToJS/Utils.hs
- compiler/GHC/Tc/Deriv.hs
- compiler/GHC/Tc/Deriv/Functor.hs
- compiler/GHC/Tc/Deriv/Generate.hs
- compiler/GHC/Tc/Deriv/Generics.hs
- compiler/GHC/Tc/Deriv/Infer.hs
- compiler/GHC/Tc/Deriv/Utils.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Hole.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Arrow.hs
- compiler/GHC/Tc/Gen/Bind.hs
- compiler/GHC/Tc/Gen/Default.hs
- compiler/GHC/Tc/Gen/Export.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Foreign.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/Tc/Gen/Sig.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Tc/Instance/Typeable.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/Solver/Default.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Solver/FunDeps.hs
- compiler/GHC/Tc/Solver/InertSet.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Solver/Rewrite.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Build.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Tc/TyCl/PatSyn.hs
- compiler/GHC/Tc/TyCl/Utils.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Types/LclEnv.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/Backpack.hs
- compiler/GHC/Tc/Utils/Concrete.hs
- compiler/GHC/Tc/Utils/Env.hs
- compiler/GHC/Tc/Utils/Instantiate.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/TcType.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Validity.hs
- compiler/GHC/Tc/Zonk/Type.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/DefaultEnv.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Types/Hint.hs
- compiler/GHC/Types/Hint/Ppr.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Types/Literal.hs
- compiler/GHC/Types/Name.hs
- compiler/GHC/Types/Name/Cache.hs
- compiler/GHC/Types/Name/Ppr.hs
- compiler/GHC/Types/Name/Reader.hs
- compiler/GHC/Types/RepType.hs
- compiler/GHC/Types/TyThing.hs
- compiler/GHC/Types/Unique.hs
- compiler/GHC/Types/Unique/FM.hs
- compiler/GHC/Types/Var.hs
- compiler/GHC/Unit.hs
- compiler/GHC/Unit/External.hs
- compiler/GHC/Unit/Module/Deps.hs
- compiler/GHC/Unit/Module/ModSummary.hs
- compiler/GHC/Unit/State.hs
- compiler/GHC/Unit/Types.hs
- compiler/GHC/Utils/Binary.hs
- − compiler/GHC/Utils/Binary/Typeable.hs
- compiler/Language/Haskell/Syntax/Expr.hs
- compiler/ghc.cabal.in
- docs/users_guide/separate_compilation.rst
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Monad.hs
- libraries/base/base.cabal.in
- libraries/base/src/Control/Applicative.hs
- libraries/base/src/Control/Concurrent.hs
- libraries/base/src/Control/Concurrent/Chan.hs
- libraries/base/src/Control/Concurrent/QSem.hs
- libraries/base/src/Control/Concurrent/QSemN.hs
- libraries/base/src/Data/Array/Byte.hs
- libraries/base/src/Data/Bifoldable.hs
- libraries/base/src/Data/Bifoldable1.hs
- libraries/base/src/Data/Bifunctor.hs
- libraries/base/src/Data/Bitraversable.hs
- libraries/base/src/Data/Bool.hs
- libraries/base/src/Data/Complex.hs
- libraries/base/src/Data/Data.hs
- libraries/base/src/Data/Enum.hs
- libraries/base/src/Data/Fixed.hs
- libraries/base/src/Data/Foldable1.hs
- libraries/base/src/Data/Functor/Classes.hs
- libraries/base/src/Data/Functor/Compose.hs
- libraries/base/src/Data/Functor/Contravariant.hs
- libraries/base/src/Data/Functor/Product.hs
- libraries/base/src/Data/Functor/Sum.hs
- libraries/base/src/Data/List.hs
- libraries/base/src/Data/List/NonEmpty.hs
- libraries/base/src/Data/List/NubOrdSet.hs
- libraries/base/src/Data/Semigroup.hs
- libraries/base/src/Data/Version.hs
- libraries/base/src/GHC/Base.hs
- libraries/base/src/GHC/ByteOrder.hs
- + libraries/base/src/GHC/Essentials.hs
- libraries/base/src/GHC/Exts.hs
- libraries/base/src/GHC/Fingerprint.hs
- libraries/base/src/GHC/RTS/Flags.hs
- libraries/base/src/GHC/ResponseFile.hs
- libraries/base/src/GHC/Stats.hs
- libraries/base/src/GHC/Weak/Finalize.hs
- libraries/base/src/Numeric.hs
- libraries/base/src/Prelude.hs
- libraries/base/src/System/CPUTime/Posix/ClockGetTime.hsc
- libraries/base/src/System/CPUTime/Posix/RUsage.hsc
- libraries/base/src/System/CPUTime/Unsupported.hs
- libraries/base/src/System/Console/GetOpt.hs
- libraries/base/src/System/Exit.hs
- libraries/base/src/System/IO.hs
- libraries/base/src/System/IO/OS.hs
- libraries/base/src/System/IO/Unsafe.hs
- libraries/base/src/System/Info.hs
- libraries/base/src/System/Timeout.hs
- libraries/base/src/Text/Printf.hs
- libraries/base/src/Text/Read.hs
- libraries/base/src/Text/Show/Functions.hs
- libraries/binary
- libraries/ghc-experimental/src/Data/Sum/Experimental.hs
- libraries/ghc-experimental/src/Data/Tuple/Experimental.hs
- libraries/ghc-experimental/src/GHC/Profiling/Eras.hs
- libraries/ghc-experimental/src/Prelude/Experimental.hs
- libraries/ghc-internal/codepages/MakeTable.hs
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/include/RtsIfaceSymbols.h
- libraries/ghc-internal/src/GHC/Internal/AllocationLimitHandler.hs
- libraries/ghc-internal/src/GHC/Internal/Arr.hs
- libraries/ghc-internal/src/GHC/Internal/ArrayArray.hs
- libraries/ghc-internal/src/GHC/Internal/Base.hs
- libraries/ghc-internal/src/GHC/Internal/Bignum/Backend.hs
- libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/GMP.hs
- libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Native.hs
- libraries/ghc-internal/src/GHC/Internal/Bignum/BigNat.hs
- libraries/ghc-internal/src/GHC/Internal/Bignum/BigNat.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Bignum/Integer.hs
- libraries/ghc-internal/src/GHC/Internal/Bignum/Integer.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Bignum/Natural.hs
- libraries/ghc-internal/src/GHC/Internal/Bignum/Natural.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Bits.hs
- libraries/ghc-internal/src/GHC/Internal/ByteOrder.hs
- libraries/ghc-internal/src/GHC/Internal/CString.hs
- libraries/ghc-internal/src/GHC/Internal/Char.hs
- libraries/ghc-internal/src/GHC/Internal/Classes.hs
- libraries/ghc-internal/src/GHC/Internal/Classes/IP.hs
- libraries/ghc-internal/src/GHC/Internal/Clock.hsc
- libraries/ghc-internal/src/GHC/Internal/ClosureTypes.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Bound.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/POSIX.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/POSIX/Const.hsc
- libraries/ghc-internal/src/GHC/Internal/Conc/Signal.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs
- libraries/ghc-internal/src/GHC/Internal/ConsoleHandler.hsc
- libraries/ghc-internal/src/GHC/Internal/Control/Arrow.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Category.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Concurrent/MVar.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fail.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fix.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/IO/Class.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Imp.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Lazy.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Lazy/Imp.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/Zip.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Bits.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Coerce.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Data.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Dynamic.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Either.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Foldable.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Function.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Functor.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Functor/Const.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Functor/Identity.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Functor/Utils.hs
- libraries/ghc-internal/src/GHC/Internal/Data/IORef.hs
- libraries/ghc-internal/src/GHC/Internal/Data/List.hs
- libraries/ghc-internal/src/GHC/Internal/Data/List/NonEmpty.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Maybe.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Monoid.hs
- libraries/ghc-internal/src/GHC/Internal/Data/NonEmpty.hs
- libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Ord.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Proxy.hs
- libraries/ghc-internal/src/GHC/Internal/Data/STRef.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Semigroup/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Data/String.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Traversable.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Bool.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Coercion.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Equality.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Ord.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Typeable.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Typeable/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Unique.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Version.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Void.hs
- libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs
- libraries/ghc-internal/src/GHC/Internal/Desugar.hs
- libraries/ghc-internal/src/GHC/Internal/Encoding/UTF8.hs
- libraries/ghc-internal/src/GHC/Internal/Enum.hs
- libraries/ghc-internal/src/GHC/Internal/Enum.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Environment.hs
- libraries/ghc-internal/src/GHC/Internal/Err.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Arr.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Array.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Control.hs
- libraries/ghc-internal/src/GHC/Internal/Event/EPoll.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/IntTable.hs
- libraries/ghc-internal/src/GHC/Internal/Event/IntVar.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Internal/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Event/KQueue.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Manager.hs
- libraries/ghc-internal/src/GHC/Internal/Event/PSQ.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Poll.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs
- libraries/ghc-internal/src/GHC/Internal/Event/TimeOut.hs
- libraries/ghc-internal/src/GHC/Internal/Event/TimerManager.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Unique.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Windows.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/Clock.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/ConsoleEvent.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/FFI.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/ManagedThreadPool.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/Thread.hs
- libraries/ghc-internal/src/GHC/Internal/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Exception/Context.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Context.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs-boot
- libraries/ghc-internal/src/GHC/Internal/ExecutionStack.hs
- libraries/ghc-internal/src/GHC/Internal/ExecutionStack/Internal.hsc
- libraries/ghc-internal/src/GHC/Internal/Exts.hs
- libraries/ghc-internal/src/GHC/Internal/Fingerprint.hs
- libraries/ghc-internal/src/GHC/Internal/Fingerprint/Type.hs
- libraries/ghc-internal/src/GHC/Internal/Float.hs
- libraries/ghc-internal/src/GHC/Internal/Float/ConversionUtils.hs
- libraries/ghc-internal/src/GHC/Internal/Float/RealFracMethods.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/ConstPtr.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/Error.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/String.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/String/Encoding.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/ForeignPtr/Imp.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Alloc.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Array.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Error.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Pool.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Utils.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Ptr.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Storable.hs
- libraries/ghc-internal/src/GHC/Internal/ForeignPtr.hs
- libraries/ghc-internal/src/GHC/Internal/ForeignSrcLang.hs
- libraries/ghc-internal/src/GHC/Internal/Functor/ZipList.hs
- libraries/ghc-internal/src/GHC/Internal/GHCi.hs
- libraries/ghc-internal/src/GHC/Internal/GHCi/Helpers.hs
- libraries/ghc-internal/src/GHC/Internal/Generics.hs
- libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs
- libraries/ghc-internal/src/GHC/Internal/Heap/Constants.hsc
- libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable.hsc
- libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable/Types.hsc
- libraries/ghc-internal/src/GHC/Internal/Heap/InfoTableProf.hsc
- libraries/ghc-internal/src/GHC/Internal/Heap/ProfInfo/Types.hs
- libraries/ghc-internal/src/GHC/Internal/IO.hs
- libraries/ghc-internal/src/GHC/Internal/IO.hs-boot
- libraries/ghc-internal/src/GHC/Internal/IO/Buffer.hs
- libraries/ghc-internal/src/GHC/Internal/IO/BufferedIO.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Device.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/CodePage.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/CodePage/API.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/CodePage/Table.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Failure.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Iconv.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Latin1.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Types.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/UTF16.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/UTF32.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/UTF8.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs-boot
- libraries/ghc-internal/src/GHC/Internal/IO/FD.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/FD.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Internals.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/Common.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/Flock.hsc
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/NoOp.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/Windows.hsc
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Text.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Types.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Types.hs-boot
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Windows.hs
- libraries/ghc-internal/src/GHC/Internal/IO/IOMode.hs
- libraries/ghc-internal/src/GHC/Internal/IO/SubSystem.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Unsafe.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Windows/Encoding.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Windows/Handle.hsc
- libraries/ghc-internal/src/GHC/Internal/IOArray.hs
- libraries/ghc-internal/src/GHC/Internal/IORef.hs
- libraries/ghc-internal/src/GHC/Internal/InfoProv.hs
- libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc
- libraries/ghc-internal/src/GHC/Internal/Int.hs
- libraries/ghc-internal/src/GHC/Internal/IsList.hs
- libraries/ghc-internal/src/GHC/Internal/Ix.hs
- libraries/ghc-internal/src/GHC/Internal/JS/Foreign/Callback.hs
- libraries/ghc-internal/src/GHC/Internal/JS/Prim.hs
- libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs
- libraries/ghc-internal/src/GHC/Internal/Lexeme.hs
- libraries/ghc-internal/src/GHC/Internal/List.hs
- libraries/ghc-internal/src/GHC/Internal/MVar.hs
- libraries/ghc-internal/src/GHC/Internal/Magic.hs
- libraries/ghc-internal/src/GHC/Internal/Magic/Dict.hs
- libraries/ghc-internal/src/GHC/Internal/Maybe.hs
- libraries/ghc-internal/src/GHC/Internal/Num.hs
- libraries/ghc-internal/src/GHC/Internal/Num.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Numeric.hs
- libraries/ghc-internal/src/GHC/Internal/OverloadedLabels.hs
- libraries/ghc-internal/src/GHC/Internal/Pack.hs
- libraries/ghc-internal/src/GHC/Internal/Prim/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/Prim/Ext.hs
- libraries/ghc-internal/src/GHC/Internal/Prim/Panic.hs
- libraries/ghc-internal/src/GHC/Internal/Prim/PtrEq.hs
- libraries/ghc-internal/src/GHC/Internal/Profiling.hs
- libraries/ghc-internal/src/GHC/Internal/Ptr.hs
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags/Test.hsc
- libraries/ghc-internal/src/GHC/Internal/Read.hs
- libraries/ghc-internal/src/GHC/Internal/Real.hs
- libraries/ghc-internal/src/GHC/Internal/Real.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Records.hs
- libraries/ghc-internal/src/GHC/Internal/ST.hs
- libraries/ghc-internal/src/GHC/Internal/STM.hs
- libraries/ghc-internal/src/GHC/Internal/STRef.hs
- libraries/ghc-internal/src/GHC/Internal/Show.hs
- libraries/ghc-internal/src/GHC/Internal/Stable.hs
- libraries/ghc-internal/src/GHC/Internal/StableName.hs
- libraries/ghc-internal/src/GHC/Internal/Stack.hs
- libraries/ghc-internal/src/GHC/Internal/Stack.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Stack/Annotation.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc
- libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/Constants.hsc
- libraries/ghc-internal/src/GHC/Internal/Stack/ConstantsProf.hsc
- libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/Types.hs
- libraries/ghc-internal/src/GHC/Internal/StaticPtr.hs
- libraries/ghc-internal/src/GHC/Internal/StaticPtr/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Stats.hsc
- libraries/ghc-internal/src/GHC/Internal/Storable.hs
- libraries/ghc-internal/src/GHC/Internal/System/Environment.hs
- libraries/ghc-internal/src/GHC/Internal/System/Environment/Blank.hsc
- libraries/ghc-internal/src/GHC/Internal/System/Environment/ExecutablePath.hsc
- libraries/ghc-internal/src/GHC/Internal/System/IO/Error.hs
- libraries/ghc-internal/src/GHC/Internal/System/Mem.hs
- libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs
- libraries/ghc-internal/src/GHC/Internal/System/Posix/Types.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs
- libraries/ghc-internal/src/GHC/Internal/Text/ParserCombinators/ReadP.hs
- libraries/ghc-internal/src/GHC/Internal/Text/ParserCombinators/ReadPrec.hs
- libraries/ghc-internal/src/GHC/Internal/Text/Read/Lex.hs
- libraries/ghc-internal/src/GHC/Internal/TopHandler.hs
- libraries/ghc-internal/src/GHC/Internal/Tuple.hs
- libraries/ghc-internal/src/GHC/Internal/Type/Reflection.hs
- libraries/ghc-internal/src/GHC/Internal/Type/Reflection/Unsafe.hs
- libraries/ghc-internal/src/GHC/Internal/TypeError.hs
- libraries/ghc-internal/src/GHC/Internal/TypeLits.hs
- libraries/ghc-internal/src/GHC/Internal/TypeLits/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/TypeNats.hs
- libraries/ghc-internal/src/GHC/Internal/TypeNats/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Bits.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/DerivedCoreProperties.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/GeneralCategory.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/SimpleLowerCaseMapping.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/SimpleTitleCaseMapping.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/SimpleUpperCaseMapping.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Version.hs
- libraries/ghc-internal/src/GHC/Internal/Unsafe/Coerce.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Conc.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Weak.hs
- libraries/ghc-internal/src/GHC/Internal/Weak/Finalize.hs
- libraries/ghc-internal/src/GHC/Internal/Windows.hs
- libraries/ghc-internal/src/GHC/Internal/Word.hs
- libraries/ghc-prim/Dummy.hs
- libraries/ghc-prim/ghc-prim.cabal
- libraries/template-haskell/Language/Haskell/TH/Lib.hs
- rts/include/rts/RtsToHsIface.h
- testsuite/tests/ado/T13242a.stderr
- testsuite/tests/annotations/should_fail/annfail10.stderr
- testsuite/tests/backpack/cabal/bkpcabal07/Makefile
- testsuite/tests/backpack/should_compile/T20396.stderr
- testsuite/tests/backpack/should_fail/bkpfail17.stderr
- testsuite/tests/cabal/T12485/Makefile
- + testsuite/tests/cabal/T27013a/Makefile
- + testsuite/tests/cabal/T27013a/Setup.hs
- + testsuite/tests/cabal/T27013a/all.T
- + testsuite/tests/cabal/T27013a/composition.cabal
- + testsuite/tests/cabal/T27013a/src/Data/Composition.hs
- + testsuite/tests/cabal/T27013d/Composition.hs
- + testsuite/tests/cabal/T27013d/Makefile
- + testsuite/tests/cabal/T27013d/T27013d.stdout
- + testsuite/tests/cabal/T27013d/all.T
- testsuite/tests/callarity/unittest/CallArity1.hs
- testsuite/tests/corelint/LintEtaExpand.hs
- testsuite/tests/corelint/T21115b.stderr
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/deSugar/should_compile/T13208.stdout
- testsuite/tests/deSugar/should_compile/T16615.stderr
- testsuite/tests/deSugar/should_compile/T2431.stderr
- testsuite/tests/default/DefaultImportFail01.stderr
- testsuite/tests/default/DefaultImportFail02.stderr
- testsuite/tests/default/DefaultImportFail03.stderr
- testsuite/tests/default/DefaultImportFail04.stderr
- testsuite/tests/default/DefaultImportFail05.stderr
- testsuite/tests/default/DefaultImportFail07.stderr
- testsuite/tests/default/T25775.stderr
- testsuite/tests/deriving/should_compile/T14682.stderr
- testsuite/tests/deriving/should_compile/T20496.stderr
- testsuite/tests/diagnostic-codes/codes.stdout
- + testsuite/tests/driver/T27013b/Makefile
- + testsuite/tests/driver/T27013b/T27013b.stdout
- + testsuite/tests/driver/T27013b/X.hs
- + testsuite/tests/driver/T27013b/all.T
- + testsuite/tests/driver/T27013c/Makefile
- + testsuite/tests/driver/T27013c/T27013c.stdout
- + testsuite/tests/driver/T27013c/X.hs
- + testsuite/tests/driver/T27013c/all.T
- + testsuite/tests/driver/T27013e/T27013e.hs
- + testsuite/tests/driver/T27013e/T27013e.stderr
- + testsuite/tests/driver/T27013e/all.T
- + testsuite/tests/driver/T27013f/T27013f.hs
- + testsuite/tests/driver/T27013f/T27013f.stderr
- + testsuite/tests/driver/T27013f/all.T
- testsuite/tests/driver/T3007/A/Internal.hs
- testsuite/tests/driver/T3007/Makefile
- testsuite/tests/driver/make-prim/Makefile
- testsuite/tests/driver/recomp24656/Makefile
- testsuite/tests/driver/recomp24656/recomp24656.stdout
- testsuite/tests/ghc-api/T8628.hs
- testsuite/tests/ghc-api/downsweep/PartialDownsweep.hs
- testsuite/tests/ghci.debugger/scripts/break006.stderr
- testsuite/tests/ghci.debugger/scripts/print019.stderr
- testsuite/tests/ghci/scripts/all.T
- testsuite/tests/hiefile/should_run/T23120.stdout
- testsuite/tests/iface/IfaceSharingIfaceType.hs
- testsuite/tests/iface/IfaceSharingName.hs
- testsuite/tests/indexed-types/should_fail/T12522a.stderr
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
- testsuite/tests/interface-stability/ghc-prim-exports.stdout
- testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32
- testsuite/tests/interface-stability/template-haskell-exports.stdout
- testsuite/tests/javascript/T24495.hs
- testsuite/tests/numeric/should_compile/T14170.stdout
- testsuite/tests/numeric/should_compile/T14465.stdout
- testsuite/tests/numeric/should_compile/T7116.stdout
- testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr
- testsuite/tests/package/all.T
- testsuite/tests/parser/should_compile/DumpParsedAst.stderr
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr
- testsuite/tests/parser/should_compile/KindSigs.stderr
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail13.stderr
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr
- testsuite/tests/parser/should_fail/T16270h.hs
- testsuite/tests/partial-sigs/should_fail/NamedWildcardsNotInMonotype.stderr
- testsuite/tests/patsyn/should_fail/T26465.stderr
- testsuite/tests/perf/should_run/ByteCodeAsm.hs
- testsuite/tests/plugins/defaulting-plugin/DefaultInterference.hs
- testsuite/tests/plugins/defaulting-plugin/DefaultInvalid.hs
- testsuite/tests/plugins/defaulting-plugin/DefaultMultiParam.hs
- testsuite/tests/plugins/plugins10.stdout
- testsuite/tests/plugins/simple-plugin/Simple/ReplacePlugin.hs
- testsuite/tests/plugins/static-plugins.stdout
- testsuite/tests/profiling/should_run/callstack001.stdout
- testsuite/tests/profiling/should_run/callstack002.stderr
- testsuite/tests/profiling/should_run/callstack002.stdout
- testsuite/tests/rename/should_compile/T3103/Foreign/Ptr.hs
- testsuite/tests/rename/should_compile/T3103/GHC/Base.lhs
- testsuite/tests/rename/should_compile/T3103/GHC/Word.hs
- testsuite/tests/rename/should_compile/T3103/test.T
- testsuite/tests/roles/should_compile/Roles1.stderr
- testsuite/tests/roles/should_compile/Roles13.stderr
- testsuite/tests/roles/should_compile/Roles14.stderr
- testsuite/tests/roles/should_compile/Roles2.stderr
- testsuite/tests/roles/should_compile/Roles3.stderr
- testsuite/tests/roles/should_compile/Roles4.stderr
- testsuite/tests/roles/should_compile/T8958.stderr
- testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr
- testsuite/tests/simplCore/should_compile/T13543.stderr
- testsuite/tests/simplCore/should_compile/T16038/T16038.stdout
- testsuite/tests/simplCore/should_compile/T3717.stderr
- testsuite/tests/simplCore/should_compile/T3772.stdout
- testsuite/tests/simplCore/should_compile/T4908.stderr
- testsuite/tests/simplCore/should_compile/T4930.stderr
- testsuite/tests/simplCore/should_compile/T7360.stderr
- testsuite/tests/simplCore/should_compile/T8274.stdout
- testsuite/tests/simplCore/should_compile/T9400.stderr
- testsuite/tests/simplCore/should_compile/noinline01.stderr
- testsuite/tests/simplCore/should_compile/par01.stderr
- testsuite/tests/simplCore/should_compile/rule2.stderr
- testsuite/tests/simplCore/should_compile/str-rules.hs
- testsuite/tests/tcplugins/ArgsPlugin.hs
- testsuite/tests/tcplugins/EmitWantedPlugin.hs
- testsuite/tests/tcplugins/RewritePlugin.hs
- testsuite/tests/tcplugins/T26395_Plugin.hs
- testsuite/tests/tcplugins/TyFamPlugin.hs
- testsuite/tests/th/T14741.hs
- testsuite/tests/th/T21547.stderr
- testsuite/tests/th/T26568.stderr
- testsuite/tests/th/TH_Roles2.stderr
- + testsuite/tests/th/TH_pragmaSpecOld.hs
- + testsuite/tests/th/TH_pragmaSpecOld.stderr
- testsuite/tests/th/all.T
- testsuite/tests/typecheck/should_compile/T13032.stderr
- testsuite/tests/typecheck/should_compile/T14273.stderr
- testsuite/tests/typecheck/should_compile/T18406b.stderr
- testsuite/tests/typecheck/should_compile/T18529.stderr
- testsuite/tests/typecheck/should_compile/holes.stderr
- testsuite/tests/typecheck/should_compile/holes2.stderr
- testsuite/tests/typecheck/should_compile/holes3.stderr
- testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
- testsuite/tests/typecheck/should_fail/T12921.stderr
- testsuite/tests/typecheck/should_fail/T14884.stderr
- testsuite/tests/typecheck/should_fail/T15883b.stderr
- testsuite/tests/typecheck/should_fail/T15883c.stderr
- testsuite/tests/typecheck/should_fail/T15883d.stderr
- testsuite/tests/typecheck/should_fail/T21130.stderr
- testsuite/tests/typecheck/should_fail/T3323.stderr
- testsuite/tests/typecheck/should_fail/T5095.stderr
- testsuite/tests/typecheck/should_fail/T7279.stderr
- testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr
- testsuite/tests/typecheck/should_fail/TyAppPat_PatternBindingExistential.stderr
- testsuite/tests/typecheck/should_fail/tcfail072.stderr
- testsuite/tests/typecheck/should_fail/tcfail097.stderr
- testsuite/tests/typecheck/should_fail/tcfail133.stderr
- testsuite/tests/typecheck/should_run/T22510.stdout
- testsuite/tests/unboxedsums/unboxedsums_unit_tests.hs
- testsuite/tests/warnings/should_compile/DerivingTypeable.stderr
- utils/check-exact/Utils.hs
- utils/genprimopcode/Main.hs
- utils/haddock/haddock-api/src/Haddock/Convert.hs
- utils/haddock/haddock-api/src/Haddock/GhcUtils.hs
- utils/haddock/haddock-api/src/Haddock/Interface.hs
- utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Create.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
- utils/haddock/haddock-api/src/Haddock/Types.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d18aabb0c1aa717050d6bab9e140c7c…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d18aabb0c1aa717050d6bab9e140c7c…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/romes/27461] 20 commits: Add 'backendInfoTableMapValidity' backend predicate
by Rodrigo Mesquita (＠alt-romes) 10 Jul '26
by Rodrigo Mesquita (＠alt-romes) 10 Jul '26
10 Jul '26
Rodrigo Mesquita pushed to branch wip/romes/27461 at Glasgow Haskell Compiler / GHC
Commits:
66d1a5d5 by fendor at 2026-07-07T16:57:56-04:00
Add 'backendInfoTableMapValidity' backend predicate
Check whether the backend supports the `-finfo-table-map` flag and
ignore it otherwise.
Improve by-design documentation of `backendCodeOutput`.
`Backend` is **abstract by design**. Make this clearer in
`backendCodeOutput` which is incorrectly being used as a proxy for
`Backend`.
Instead, define the desired property predicates in GHC.Driver.Backend
In the process, make `backendCodeOutput` total.
- - - - -
74f1071d by fendor at 2026-07-07T16:57:56-04:00
Add failing test for `-finfo-table-map` and bytecode backend
If you compile a module using the bytecode backend, with
-finfo-table-map, then the info table map doesn't get populated for the
module.
This is because the -finfo-table-map code path is implemented mostly in
the StgToCmm phase which isn't run when creating bytecode.
Ticket #27039
- - - - -
28d63bca by mangoiv at 2026-07-07T16:59:16-04:00
ci: don't fail nightly if there have been no changes that night
Fixes #27127
- - - - -
4ebfc478 by Rodrigo Mesquita at 2026-07-08T04:47:53-04:00
ttg: Using ShortText over FastString in the AST
To make the AST independent of GHC, this commit replaces usages of
`FastString` with `HText` in the AST, killing the last edge from
Language.Haskell.* to GHC.* modules.
Even though we /do/ want to use FastStrings in general -- critically in
Names or Ids -- there is no particular reason for the FastStrings that
occur in the AST proper to be FastStrings. Strings in the AST are
typically unique and don't benefit particularly from being interned
FastStrings with Uniques for fast comparison.
`HText` is a type synonym for `ShortText` which uses GHC's Modified
UTF-8 encoding exclusively.
Modified UTF-8 must be used to represent the Haskell AST because the
Haskell Report allows surrogate code points. `Data.Text.Text` functions
use Standard UTF-8 which replace surrogates with a placeholder value,
thus `Data.Text.Text` is unsuitable for AST strings. See the
`Language.Haskell.Syntax.Text` module header for more details.
Final progress towards #21592
Closes #21628
- - - - -
d910b353 by Simon Peyton Jones at 2026-07-08T04:48:36-04:00
Update equality-type documenation in GHC.Builtin.Types.Prim
Fix #27466
- - - - -
b2530542 by Simon Peyton Jones at 2026-07-08T04:48:36-04:00
Honour -dsuppress-coercions in GHC.Core.TyCo.pprCo
Fixes #27467
- - - - -
9a73179a by Facundo Domínguez at 2026-07-08T04:49:26-04:00
Add item to MR checklist asking to squash fixup commits after approval
The checklist has an item that reads
All commits are either individually buildable or squashed.
This item could be checked immediately after sending the merge request
though. If reviewers ask for amends later on, and the author amends
the merge request, there was no item that would remind the contributors
to squash the fixup commits before landing.
This commit adds a new item
After all approvals and before landing: all fixup commits are squashed with their originating commits.
which should be harder to mark as done before approvals have been given.
- - - - -
ed09895d by Andreas Klebinger at 2026-07-08T16:53:27-04:00
Fix a profiling race condition resulting in segfaults.
StgToCmm: Don't assume tagged FUN closures in closureCodeBody.
When entering a closure the self/node pointer might not be tagged in
some situations when a thunk is evaluated by multiple threads.
So we most AND away the tag bits rather than subtracting an expected tag.
Apply.cmm: Fix a race condition occuring when a thunk is mutated during GC.
In stg_ap_0_fast when might need to run GC before entering a thunk. If this happens
another thread or the GC itself might mutate the closure making entering it no longer
valid. We now check for this.
Add test and changelog for #27123 fixes.
- - - - -
67c03eb2 by Cheng Shao at 2026-07-08T16:54:09-04:00
ghc-heap: fix invalid srtlen returned by peekItbl when no-TNTC
This patch fixes the no-TNTC code path of `peekItbl` so that it looks
at the right memory address when reading the `srt` field from the
`StgInfoTable_` struct. Also adds a `T27465` regression test that
reproduces the bug on no-TNTC builds before the fix. Fixes #27465.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
2ecabb4f by Zubin Duggal at 2026-07-09T09:23:25-04:00
hadrian: binary-dist-dir should not be the default target
Revert behaviour to pre 23c9b6c392f52ec9d7a8618b204ff6b885f5fba2
In 23c9b6c392f52ec9d7a8618b204ff6b885f5fba2, we applied the following behaviour change:
```
hadrian: Build stage 2 cross compilers
...
* hadrian: Make binary-dist-dir the default build target. This allows us
to have the logic in one place about which libraries/stages to build
with cross compilers. Fixes #24192
```
This is a major regression to development experience, a plain hadrian/build
--freeze1 now takes ages because we rebuild all docs (which need to go in the
binary dist dir).
`binary-dist-dir` is the wrong default target for regular GHC development work
Fixes #27445
- - - - -
e16388e3 by Zubin Duggal at 2026-07-09T09:23:25-04:00
.gitignore: Add the hadrian system.config introduced by commit 23c9b6c392f52ec9d7a8618b204ff6b885f5fba2
Since
commit 23c9b6c392f52ec9d7a8618b204ff6b885f5fba2
Author: Matthew Pickering <matthewtpickering(a)gmail.com>
Date: Thu Dec 21 16:17:41 2023 +0000
hadrian: Build stage 2 cross compilers
./configure produces /hadrian/cfg/system.config.{host,target}
Add these to .gitignore
- - - - -
7e8abf41 by Alan Zimmerman at 2026-07-09T09:24:12-04:00
EPA: Replace AnnListItem with simply [TrailingAnn]
Remove the unnecessary wrapper around a single field.
- - - - -
29032f17 by Zubin Duggal at 2026-07-09T09:24:58-04:00
testsuite: Keep real reason for fragile test failures
- - - - -
c34e03a7 by Zubin Duggal at 2026-07-09T09:24:58-04:00
testsuite: Fall back to the failure reason for empty JUnit bodies
- - - - -
409d40f0 by Zubin Duggal at 2026-07-09T09:24:58-04:00
testsuite: Show output diffs in JUnit output
Also refactor compare_outputs to return essentially a `Maybe Diff`
(`CompareOutput`) instead of a bool, but more pythonic. This
allows us to pass the diff through nice.
- - - - -
06fee1ab by Zubin Duggal at 2026-07-09T09:24:58-04:00
perf notes: include stat deviation and acceptance window in notes so they show up in gitlab
- - - - -
57c0f32c by mangoiv at 2026-07-10T11:08:38-04:00
driver: enable -finter-module-far-jumps by default
this fixes a compatibility bug with certain binutils/gcc versions where
we were seeing jump offset overflow errors.
This commit can probably reverted if we stop supporting the problematic
binutils/gcc verions (2.44 and 14.2, respectively)
Reolves #26994
- - - - -
4396a6f2 by Andrea Vezzosi at 2026-07-10T11:09:25-04:00
[Fix #27287] preserve ModBreaks in ModIface
- - - - -
393aeb18 by Rodrigo Mesquita at 2026-07-10T20:31:43+01:00
loopImports: Don't dup ms_uid in summary imports
We were writing the ms_unitid of the mod summary with every single
import of that module
That complicated the code (as though the UnitId in that list could ever
be something else) and also allocates unnecessarily per every mod
import. Very slight allocation decrease measured locally in a few tests:
(MultiComponentModulesRecomp: -0.06%; MultiComponentModulesRecomp100: -0.05%)
Purely a clean up.
- - - - -
94d68f81 by Rodrigo Mesquita at 2026-07-10T20:31:43+01:00
downsweep: make control flow simpler and cache correct
This refactor extracts the control flow of downsweep into a single
function `dfsBuild`, which takes care of iteratively expanding and
traversing all nodes of the in-construction module graph necessary to
build a full `ModuleGraph`.
There are three levels of caching going on, all of which are necessary
to make sure we don't do repeated work (specifically: NEVER summarise
the same module twice).
1. `dfsBuild` accumulates the final module graph and never revisits the
same node of the module graph. Cache is keyed by the final
`ModuleGraph`s `NodeKey`s.
2. For Module A in home-unit u1, each import in the list of imports
needs to be *found* (call to `findImportedModuleWithIsBoot`): at this
point, we only have the `ModuleName` of the import, not the `Module`.
This *finding* is somewhat expensive, so we cache it as well
(`ImportsCache`). The cache key is the home-unit to which the module
belongs~[1], the import package qualifier, and the ModuleName.
[1] Different home-units will have different package flags, which means
potentially different `Module` resolution for the same `ModuleName`.
3. The most expensive operation we want to avoid is summarising a
`Module` into a `ModSummary`, which notably involves parsing the
module header from scratch.
The third cache, in essence, maps a `Module` to its `ModSummary`
(named `ModSummaryCache`). This cache upholds the invariant: we NEVER
summarise the same module twice. In practice, the cache key is the
Module's UnitId and the Source path; the reason is we need to
distinguish between `.hs` and `.hs-boot` files, as their summaries
will differ.
Note that (2) can't guarantee this alone: Two ModuleName imports in
separate units can (and likely do) map to the same `Module`.
Note that the previous implementation failed to achieve the
no-duplicate-work summarisation invariant, and we ended up doing a
quadratic amount of processing in scenarios like test
`MultiComponentModules100`.
See also Note [Downsweep Control Flow and Caching]
Fixes #27461
- - - - -
185 changed files:
- .gitignore
- .gitlab-ci.yml
- .gitlab/merge_request_templates/Default.md
- .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
- + changelog.d/T21628
- + changelog.d/T27123.md
- + changelog.d/fix-peekitbl-no-tntc
- + changelog.d/inter-module-far-jumps-aarch64-default
- compiler/GHC/Builtin/Types/Prim.hs
- compiler/GHC/Builtin/Utils.hs
- compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Cmm/CLabel.hs
- compiler/GHC/Core/Ppr.hs
- compiler/GHC/Core/TyCo/Ppr.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Data/FastString.hs
- compiler/GHC/Data/StringBuffer.hs
- compiler/GHC/Driver/Backend.hs
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Errors/Ppr.hs
- compiler/GHC/Driver/Main/Compile.hs
- compiler/GHC/Driver/Main/Hsc.hs
- compiler/GHC/Driver/Main/Passes.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Hs/Dump.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Lit.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/HsToCore/Breakpoints.hs
- + compiler/GHC/HsToCore/Breakpoints/Types.hs
- compiler/GHC/HsToCore/Errors/Types.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Foreign/C.hs
- compiler/GHC/HsToCore/Foreign/JavaScript.hs
- compiler/GHC/HsToCore/Foreign/Wasm.hs
- compiler/GHC/HsToCore/Match.hs
- compiler/GHC/HsToCore/Match/Literal.hs
- compiler/GHC/HsToCore/Pmc/Desugar.hs
- compiler/GHC/HsToCore/Pmc/Solver/Types.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Iface/Make.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/Errors/Ppr.hs
- compiler/GHC/Parser/HaddockLex.x
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Platform/Ways.hs
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Rename/Splice.hs
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/StgToCmm/Bind.hs
- compiler/GHC/StgToCmm/Foreign.hs
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/StgToJS/FFI.hs
- compiler/GHC/Tc/Deriv/Generate.hs
- compiler/GHC/Tc/Deriv/Generics.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Gen/Bind.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/Tc/Gen/Sig.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Utils.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Validity.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/Basic.hs
- compiler/GHC/Types/Error.hs
- compiler/GHC/Types/FieldLabel.hs
- compiler/GHC/Types/ForeignCall.hs
- compiler/GHC/Types/Literal.hs
- compiler/GHC/Unit/Module/ModGuts.hs
- compiler/GHC/Unit/Module/ModIface.hs
- compiler/GHC/Unit/Module/Warnings.hs
- compiler/GHC/Unit/Module/WholeCoreBindings.hs
- compiler/GHC/Utils/Binary.hs
- compiler/GHC/Utils/Outputable.hs
- compiler/Language/Haskell/Syntax/Basic.hs
- compiler/Language/Haskell/Syntax/Decls.hs
- compiler/Language/Haskell/Syntax/Decls/Foreign.hs
- compiler/Language/Haskell/Syntax/Expr.hs
- compiler/Language/Haskell/Syntax/Lit.hs
- compiler/Language/Haskell/Syntax/Module/Name.hs
- + compiler/Language/Haskell/Syntax/Text.hs
- compiler/Language/Haskell/Syntax/Type.hs
- compiler/ghc.cabal.in
- docs/users_guide/using-optimisation.rst
- hadrian/src/Rules.hs
- hadrian/src/Rules/BinaryDist.hs
- libraries/ghc-boot/GHC/Data/ShortText.hs
- + libraries/ghc-heap/tests/T27465.hs
- + libraries/ghc-heap/tests/T27465.stdout
- libraries/ghc-heap/tests/all.T
- libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable.hsc
- libraries/ghc-internal/src/GHC/Internal/Heap/InfoTableProf.hsc
- rts/Apply.cmm
- testsuite/driver/junit.py
- testsuite/driver/perf_notes.py
- testsuite/driver/testglobals.py
- testsuite/driver/testlib.py
- testsuite/driver/testutil.py
- testsuite/tests/codeGen/should_compile/T25177.stderr
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/deSugar/should_fail/all.T
- testsuite/tests/ghc-api/T25121_status.stdout
- testsuite/tests/ghc-api/annotations-literals/parsed.hs
- testsuite/tests/ghc-api/exactprint/T22919.stderr
- testsuite/tests/ghc-api/exactprint/Test20239.stderr
- testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr
- testsuite/tests/ghci/scripts/all.T
- + testsuite/tests/ghci/scripts/bytecodeIPE.hs
- + testsuite/tests/ghci/scripts/bytecodeIPE.script
- + testsuite/tests/ghci/scripts/bytecodeIPE.stdout
- testsuite/tests/ghci/should_run/Makefile
- + testsuite/tests/ghci/should_run/T27287.hs
- + testsuite/tests/ghci/should_run/T27287.stdout
- testsuite/tests/ghci/should_run/all.T
- testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T24221.stderr
- testsuite/tests/module/mod185.stderr
- testsuite/tests/numeric/should_compile/T15547.stderr
- testsuite/tests/parser/should_compile/DumpParsedAst.stderr
- testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- testsuite/tests/parser/should_compile/DumpSemis.stderr
- testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr
- testsuite/tests/parser/should_compile/KindSigs.stderr
- testsuite/tests/parser/should_compile/T14189.stderr
- testsuite/tests/parser/should_compile/T15323.stderr
- testsuite/tests/parser/should_compile/T20452.stderr
- testsuite/tests/parser/should_compile/T20718.stderr
- testsuite/tests/parser/should_compile/T20718b.stderr
- testsuite/tests/parser/should_compile/T20846.stderr
- testsuite/tests/parser/should_compile/T23315/T23315.stderr
- + testsuite/tests/parser/should_run/StringStartsWithNull.hs
- + testsuite/tests/parser/should_run/StringStartsWithNull.stdout
- testsuite/tests/parser/should_run/all.T
- testsuite/tests/perf/compiler/hard_hole_fits.stderr
- testsuite/tests/printer/AnnotationNoListTuplePuns.stdout
- testsuite/tests/printer/T18791.stderr
- testsuite/tests/printer/Test20297.stdout
- testsuite/tests/printer/Test24533.stdout
- + testsuite/tests/rts/T27123.hs
- testsuite/tests/rts/all.T
- testsuite/tests/simplCore/should_compile/DataToTagFamilyScrut.stderr
- testsuite/tests/simplCore/should_compile/T14978.stdout
- testsuite/tests/simplCore/should_compile/T18013.stderr
- testsuite/tests/simplCore/should_compile/T24229a.stderr
- testsuite/tests/simplCore/should_compile/T24229b.stderr
- testsuite/tests/typecheck/should_compile/T15242.stderr
- testsuite/tests/typecheck/should_compile/all.T
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Transform.hs
- utils/check-exact/Utils.hs
- utils/check-exact/check-exact.cabal
- utils/haddock/haddock-api/haddock-api.cabal
- utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
- utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
- utils/haddock/haddock-api/src/Haddock/Convert.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Create.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a57145ba713f432bda72d2d5f8b296…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a57145ba713f432bda72d2d5f8b296…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/jeltsch/textual-bytecode-output] Add output of `<none>` in case of missing (type) variables
by Wolfgang Jeltsch (＠jeltsch) 10 Jul '26
by Wolfgang Jeltsch (＠jeltsch) 10 Jul '26
10 Jul '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/textual-bytecode-output at Glasgow Haskell Compiler / GHC
Commits:
c461ef90 by Wolfgang Jeltsch at 2026-07-10T21:59:43+03:00
Add output of `<none>` in case of missing (type) variables
- - - - -
1 changed file:
- compiler/GHC/ByteCode/Show.hs
Changes:
=====================================
compiler/GHC/ByteCode/Show.hs
=====================================
@@ -364,7 +364,7 @@ pprType = entry (text "type") . ppr
-- | […]
pprTypeVariables :: [IfaceTvBndr] -> SDoc
pprTypeVariables = entry (text "type variables") .
- vcat .
+ vcatOrNone .
map pprTypeVariableBinder
-- | […]
@@ -373,7 +373,7 @@ pprTypeVariableBinder (name, kind) = ppr name <+> text "::" <+> ppr kind
-- | […]
pprVariables :: [Maybe (IfaceIdBndr, Word)] -> SDoc
-pprVariables = entry (text "variables") . vcat . map pprVariable
+pprVariables = entry (text "variables") . vcatOrNone . map pprVariable
-- | […]
pprVariable :: Maybe (IfaceIdBndr, Word) -> SDoc
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c461ef90e2cd36eb8c28b0de196b38f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c461ef90e2cd36eb8c28b0de196b38f…
You're receiving this email because of your account on gitlab.haskell.org.
1
0