Rodrigo Mesquita pushed to branch wip/romes/27461 at Glasgow Haskell Compiler / GHC Commits: 25ec3570 by Rodrigo Mesquita at 2026-07-17T16:21:47+01:00 Organize and clean-up GHC.Driver.Downsweep Simply some cosmetic changes, moving definitions around to structure the module better into its relevant sections (In go (ns ++ ss), it's not a problem to use ++ because it's a good producer and we won't have to append fully before processing the next item in go) - - - - - 1 changed file: - compiler/GHC/Driver/Downsweep.hs Changes: ===================================== compiler/GHC/Driver/Downsweep.hs ===================================== @@ -5,8 +5,8 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE BlockArguments #-} {-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE FunctionalDependencies #-} + +-- | See Note [Downsweep and the ModuleGraph] module GHC.Driver.Downsweep ( downsweep , downsweepThunk @@ -119,15 +119,38 @@ import qualified Data.List.NonEmpty as NE {- Note [Downsweep and the ModuleGraph] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The 'ModuleGraph' stores the relationship between all the modules, units, and +instantiations in the current session, allowing e.g. to answer questions about +the transitive closure of the imports. + +Downsweep is the compiler pass which discovers and builds a new 'ModuleGraph'. +by following all the (module,unit,...) dependencies, starting from the root modules. + +Downsweep iteratively *expands* each so-called 'DownsweepNode' into a list of +its dependencies, and recursively traverses all reachable nodes in a +depth-first order using 'dfsBuild'. A 'DownsweepNode' is *expanded* by 'dsNodeExpand': + + dsNodeExpand :: DownsweepNode -> DownsweepM (NodeRes (ModuleGraphNode, [DownsweepNode])) -The ModuleGraph stores the relationship between all the modules, units, and -instantiations in the current session. +Most notably: -When we do downsweep, we build up a new ModuleGraph, starting from the root -modules. By following all the dependencies we construct a graph which allows -us to answer questions about the transitive closure of the imports. + - 'DSMod' (Module-based) nodes can be expanded by preprocessing and + parsing the module header, then listing the imports (direct and SOURCE imports) + (see 'expandModuleSummary' and 'expandFixedModuleNode') -The module graph is accessible in the HscEnv. + - 'DSUnit' is expanded by finding the unit dependencies of that unit by id + (see 'expandUnitNode'). + +Besides its dependencies, expanding a 'DownsweepNode' produces a +'ModuleGraphNode'. The final 'ModuleGraph' is constructed from the list of +'ModuleGraphNode's accumulated by expanding all reachable 'DownsweepNode's. + +A 'ModuleGraphNode' is essentially the resolved version of 'DownsweepNode': +it records the payload (e.g. a Module) *and* its dependencies, unlike +'DownsweepNode' which has the just the payload that is used as a seed (and +potentially some context information, like the current home-unit) + +TL;DR: We recursively traverse 'DownsweepNodes' to discover and build the 'ModuleGraph'. When is this graph constructed? @@ -148,6 +171,9 @@ See also Note [Downsweep Control Flow and Caching] -} ----------------------------------------------------------------------------- +-- * Top-level entry to downsweep +----------------------------------------------------------------------------- + -- -- | Downsweep (dependency analysis) for --make mode -- @@ -159,7 +185,7 @@ See also Note [Downsweep Control Flow and Caching] -- cache to avoid recalculating a module summary if the source is -- unchanged. -- --- Downsweeping can start from scratch for from a given module graph. In the +-- Downsweeping can start from scratch or from a given module graph. In the -- latter case, the given graph is fully included in the resulting graph, even -- if parts of it are not reachable from any of the given roots. When an import -- is processed, the source of the imported module is not consulted if this @@ -175,6 +201,8 @@ See also Note [Downsweep Control Flow and Caching] -- -- It will also turn on code generation for any modules that need it by calling -- 'enableCodeGenForTH'. +-- +-- See also Note [Downsweep and the ModuleGraph] downsweep :: HscEnv -> (GhcMessage -> AnyGhcDiagnostic) -> Maybe Messager @@ -231,6 +259,35 @@ downsweep hsc_env diag_wrapper msg old_summaries maybe_base_graph excl_mods allo unitModuleNodes summaries uid hue = maybeToList (linkNodes summaries uid hue) + -- The linking plan for each module. If we need to do linking for a home unit + -- then this function returns a graph node which depends on all the modules in the home unit. + + -- At the moment nothing can depend on these LinkNodes. + linkNodes :: [ModuleGraphNode] -> UnitId -> HomeUnitEnv -> Maybe (Either (Messages DriverMessage) ModuleGraphNode) + linkNodes summaries uid hue = + let dflags = homeUnitEnv_dflags hue + ofile = outputFile_ dflags + + unit_nodes :: [NodeKey] + unit_nodes = map mkNodeKey (filter ((== uid) . mgNodeUnitId) summaries) + -- Issue a warning for the confusing case where the user + -- said '-o foo' but we're not going to do any linking. + -- We attempt linking if either (a) one of the modules is + -- called Main, or (b) the user said -no-hs-main, indicating + -- that main() is going to come from somewhere else. + -- + no_hs_main = gopt Opt_NoHsMain dflags + + main_sum = any (== NodeKey_Module (ModNodeKeyWithUid (GWIB (mainModuleNameIs dflags) NotBoot) uid)) unit_nodes + + do_linking = main_sum || no_hs_main || ghcLink dflags == LinkDynLib || ghcLink dflags == LinkStaticLib || ghcLink dflags == LinkBytecodeLib + + in if | isExecutableLink (ghcLink dflags) && isJust ofile && not do_linking -> + Just (Left $ singleMessage $ mkPlainErrorMsgEnvelope noSrcSpan (DriverRedirectedNoMain $ mainModuleNameIs dflags)) + -- This should be an error, not a warning (#10895). + | ghcLink dflags /= NoLink, do_linking -> Just (Right (LinkNode unit_nodes uid)) + | otherwise -> Nothing + -- | Calculate the module graph starting from a single ModSummary. The result is a -- thunk, which when forced will perform the downsweep. This is useful in oneshot -- mode where the module graph may never be needed. @@ -322,7 +379,35 @@ downsweepInstalledModules hsc_env mods = do return (mkModuleGraph mg) +----------------------------------------------------------------------------- +-- * Orchestrator: downsweepFromRootNodes +----------------------------------------------------------------------------- + +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)) ) +-- | A 'ModSummary's provenance during downsweep: an old previously constructed +-- ModSummary, that might be potentially outdated, or a freshly constructed one +-- during this downsweep which is certainly up to date? +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 -- | Whether downsweep should use compiler or fixed nodes. Compile nodes are used -- by --make mode, and fixed nodes by oneshot mode. @@ -381,20 +466,15 @@ downsweepFromRootNodes hsc_env summ_cache imps_cache maybe_base_graph excl_mods [ ((moduleNodeInfoUnitId s, moduleNodeInfoMnwib s), [s]) | s <- root_nodes ] - moduleGraphNodeMap :: ModuleGraph -> M.Map NodeKey (MGRes ModuleGraphNode) + moduleGraphNodeMap :: ModuleGraph -> M.Map NodeKey (NodeRes ModuleGraphNode) moduleGraphNodeMap graph = M.fromList [(mkNodeKey node, NSuccess node) | node <- mgModSummaries' graph] sec = initSourceErrorContext (hsc_dflags hsc_env) -calcDeps :: ModSummary -> [(ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))] -calcDeps ms = - -- Add a dependency on the HsBoot file if it exists - -- This gets passed to the loopImports function which just ignores it if it - -- can't be found. - [(NormalLevel, NoPkgQual, GWIB (noLoc $ ms_mod_name ms) IsBoot) | NotBoot <- [isBootSummary ms] ] ++ - [(lvl, b, c) | (lvl, b, c) <- msDeps ms ] - +-------------------------------------------------------------------------------- +-- ** 'DownsweepM' +-------------------------------------------------------------------------------- type DownsweepM a = ReaderT DownsweepEnv IO a data DownsweepEnv = DownsweepEnv { @@ -405,29 +485,6 @@ data DownsweepEnv = DownsweepEnv { , _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 @@ -460,17 +517,19 @@ mkRootMap summaries = Map.fromList runDownsweepM :: DownsweepEnv -> DownsweepM a -> IO a runDownsweepM env act = runReaderT act env -loopDownsweepNodes :: M.Map NodeKey (MGRes ModuleGraphNode) -> [DownsweepNode] -> DownsweepM (M.Map NodeKey (MGRes ModuleGraphNode)) -loopModuleNodeInfos :: M.Map NodeKey (MGRes ModuleGraphNode) -> [ModuleNodeInfo] -> DownsweepM (M.Map NodeKey (MGRes ModuleGraphNode)) -loopUnits :: M.Map NodeKey (MGRes ModuleGraphNode) -> UnitId -> [UnitId] -> DownsweepM (M.Map NodeKey (MGRes ModuleGraphNode)) -loopInstantiations :: M.Map NodeKey (MGRes ModuleGraphNode) -> [(UnitId, InstantiatedUnit)] -> DownsweepM (M.Map NodeKey (MGRes ModuleGraphNode)) -loopFromInteractive :: M.Map NodeKey (MGRes ModuleGraphNode) -> Module -> [InteractiveImport] -> DownsweepM (M.Map NodeKey (MGRes ModuleGraphNode)) +loopDownsweepNodes :: M.Map NodeKey (NodeRes ModuleGraphNode) -> [DownsweepNode] -> DownsweepM (M.Map NodeKey (NodeRes ModuleGraphNode)) +loopModuleNodeInfos :: M.Map NodeKey (NodeRes ModuleGraphNode) -> [ModuleNodeInfo] -> DownsweepM (M.Map NodeKey (NodeRes ModuleGraphNode)) +loopUnits :: M.Map NodeKey (NodeRes ModuleGraphNode) -> UnitId -> [UnitId] -> DownsweepM (M.Map NodeKey (NodeRes ModuleGraphNode)) +loopInstantiations :: M.Map NodeKey (NodeRes ModuleGraphNode) -> [(UnitId, InstantiatedUnit)] -> DownsweepM (M.Map NodeKey (NodeRes ModuleGraphNode)) +loopFromInteractive :: M.Map NodeKey (NodeRes ModuleGraphNode) -> Module -> [InteractiveImport] -> DownsweepM (M.Map NodeKey (NodeRes 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 +-------------------------------------------------------------------------------- +-- * Expanding 'DownsweepNode's into payload and node dependencies -------------------------------------------------------------------------------- -- | A 'DownsweepNode' is the basic block of the downsweep algorithm which @@ -516,7 +575,7 @@ dsNodeInfoKey = \case DSInst{instantiated_ud} -> NodeKey_Unit instantiated_ud DSInteractive mod _imps -> NodeKey_Module $ moduleToMnk mod NotBoot -dsNodeExpand :: DownsweepNode -> DownsweepM (MGRes (ModuleGraphNode, [DownsweepNode])) +dsNodeExpand :: DownsweepNode -> DownsweepM (NodeRes (ModuleGraphNode, [DownsweepNode])) dsNodeExpand = \case DSMod (ModuleNodeCompile ms) -> expandModuleSummary ms DSMod (ModuleNodeFixed key loc) -> expandFixedModuleNode key loc @@ -525,12 +584,29 @@ dsNodeExpand = \case , home_context_uid } -> expandInstantiatedUnit instantiated_ud home_context_uid DSInteractive imod iis -> expandInteractiveImports imod iis -expandModuleSummary :: ModSummary -> DownsweepM (MGRes (ModuleGraphNode, [DownsweepNode])) +expandModuleSummary :: ModSummary -> DownsweepM (NodeRes (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 + (final_deps, todo) <- unzip <$> mapM (expandModImport home_uid home_unit) (calcDeps ms) + + -- 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 $ NSuccess + ( ModuleNode (catMaybes final_deps) (ModuleNodeCompile ms) + , boot_todo ++ concat todo + ) + where + expandModImport home_uid home_unit (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 @@ -552,24 +628,17 @@ expandModuleSummary ms = do -- Didn't work out what the imports mean yet, now do ( 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 $ NSuccess - ( ModuleNode (catMaybes final_deps) (ModuleNodeCompile ms) - , boot_todo ++ concat todo - ) + calcDeps :: ModSummary -> [(ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))] + calcDeps ms = + -- Add a dependency on the HsBoot file if it exists + -- This gets passed to the loopImports function which just ignores it if it + -- can't be found. + [(NormalLevel, NoPkgQual, GWIB (noLoc $ ms_mod_name ms) IsBoot) | NotBoot <- [isBootSummary ms] ] ++ + [(lvl, b, c) | (lvl, b, c) <- msDeps ms ] -- | Expand a 'ModuleNodeFixed' node -- NB: If you ever reach a Fixed node, everything under that also must be fixed. -expandFixedModuleNode :: ModNodeKeyWithUid -> ModLocation -> DownsweepM (MGRes (ModuleGraphNode, [DownsweepNode])) +expandFixedModuleNode :: ModNodeKeyWithUid -> ModLocation -> DownsweepM (NodeRes (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 @@ -603,7 +672,7 @@ expandFixedModuleNode key loc = do pure $ Just $ DSMod (ModuleNodeFixed key loc) _otherwise -> -- If the finder fails, just keep going, there will be another - -- error later. + -- error later when we try to expand this dependency. pure Nothing mk_dep _ (Right uid_dep) = do -- Set active unit so that looking loopUnit finds the correct @@ -611,9 +680,22 @@ expandFixedModuleNode key loc = do let home_uid = mnkUnitId key pure (Just DSUnit{node_uid=uid_dep, home_context_uid=home_uid}) + mkFixedEdge :: Either (ImportLevel, ModNodeKeyWithUid) (ImportLevel, UnitId) -> ModuleNodeEdge + mkFixedEdge (Left (lvl, key)) = mkModuleEdge lvl (NodeKey_Module key) + mkFixedEdge (Right (lvl, uid)) = mkModuleEdge lvl (NodeKey_ExternalUnit uid) + + ifaceDeps :: Dependencies -> [Either (ImportLevel, ModNodeKeyWithUid) (ImportLevel, UnitId)] + ifaceDeps deps = + [ Left (tcImportLevel lvl, ModNodeKeyWithUid dep uid) + | (lvl, uid, dep) <- Set.toList (dep_direct_mods deps) + ] ++ + [ Right (tcImportLevel lvl, uid) + | (lvl, uid) <- Set.toList (dep_direct_pkgs deps) + ] + -- | 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 (MGRes (ModuleGraphNode, [DownsweepNode])) + -> DownsweepM (NodeRes (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. @@ -623,12 +705,12 @@ expandUnitNode node_uid home_context_uid = do Just us -> pure $ NSuccess ((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 (MGRes (ModuleGraphNode, [DownsweepNode])) +expandInstantiatedUnit :: InstantiatedUnit -> UnitId {-^ Home unit -} -> DownsweepM (NodeRes (ModuleGraphNode, [DownsweepNode])) expandInstantiatedUnit iud home_uid = pure $ NSuccess ( InstantiationNode home_uid iud , [DSUnit{node_uid=instUnitInstanceOf iud, home_context_uid=home_uid}] ) -expandInteractiveImports :: Module -> [InteractiveImport] -> DownsweepM (MGRes (ModuleGraphNode, [DownsweepNode])) +expandInteractiveImports :: Module -> [InteractiveImport] -> DownsweepM (NodeRes (ModuleGraphNode, [DownsweepNode])) expandInteractiveImports imod imps = do hsc_env <- asks downsweep_hsc_env imps_cache <- asks downsweep_imports_cache @@ -686,19 +768,8 @@ expandInteractiveImports imod imps = do node_type = ModuleNodeFixed key ml -------------------------------------------------------------------------------- - -mkFixedEdge :: Either (ImportLevel, ModNodeKeyWithUid) (ImportLevel, UnitId) -> ModuleNodeEdge -mkFixedEdge (Left (lvl, key)) = mkModuleEdge lvl (NodeKey_Module key) -mkFixedEdge (Right (lvl, uid)) = mkModuleEdge lvl (NodeKey_ExternalUnit uid) - -ifaceDeps :: Dependencies -> [Either (ImportLevel, ModNodeKeyWithUid) (ImportLevel, UnitId)] -ifaceDeps deps = - [ Left (tcImportLevel lvl, ModNodeKeyWithUid dep uid) - | (lvl, uid, dep) <- Set.toList (dep_direct_mods deps) - ] ++ - [ Right (tcImportLevel lvl, uid) - | (lvl, uid) <- Set.toList (dep_direct_pkgs deps) - ] +-- * Constructing Module Summaries +-------------------------------------------------------------------------------- downsweepSummarise :: HomeUnit -> IsBootInterface @@ -745,35 +816,6 @@ instantiationNodes uid unit_state = map (uid,) iuids_to_check , recur <- (indef :) $ goUnitId $ moduleUnit $ snd inst ] --- The linking plan for each module. If we need to do linking for a home unit --- then this function returns a graph node which depends on all the modules in the home unit. - --- At the moment nothing can depend on these LinkNodes. -linkNodes :: [ModuleGraphNode] -> UnitId -> HomeUnitEnv -> Maybe (Either (Messages DriverMessage) ModuleGraphNode) -linkNodes summaries uid hue = - let dflags = homeUnitEnv_dflags hue - ofile = outputFile_ dflags - - unit_nodes :: [NodeKey] - unit_nodes = map mkNodeKey (filter ((== uid) . mgNodeUnitId) summaries) - -- Issue a warning for the confusing case where the user - -- said '-o foo' but we're not going to do any linking. - -- We attempt linking if either (a) one of the modules is - -- called Main, or (b) the user said -no-hs-main, indicating - -- that main() is going to come from somewhere else. - -- - no_hs_main = gopt Opt_NoHsMain dflags - - main_sum = any (== NodeKey_Module (ModNodeKeyWithUid (GWIB (mainModuleNameIs dflags) NotBoot) uid)) unit_nodes - - do_linking = main_sum || no_hs_main || ghcLink dflags == LinkDynLib || ghcLink dflags == LinkStaticLib || ghcLink dflags == LinkBytecodeLib - - in if | isExecutableLink (ghcLink dflags) && isJust ofile && not do_linking -> - Just (Left $ singleMessage $ mkPlainErrorMsgEnvelope noSrcSpan (DriverRedirectedNoMain $ mainModuleNameIs dflags)) - -- This should be an error, not a warning (#10895). - | ghcLink dflags /= NoLink, do_linking -> Just (Right (LinkNode unit_nodes uid)) - | otherwise -> Nothing - getRootSummary :: [ModuleName] -> ModSummaryCache -> @@ -858,6 +900,10 @@ rootSummariesParallel n_jobs hsc_env diag_wrapper msg get_summary = do throwIO e a -> pure a +-------------------------------------------------------------------------------- +-- * Check/validate properties and error out +-------------------------------------------------------------------------------- + -- | This function checks then important property that if both p and q are home units -- then any dependency of p, which transitively depends on q is also a home unit. -- @@ -905,6 +951,10 @@ checkHomeUnitsClosed ue let todo'' = (depends Set.\\ done) `Set.union` todo' in DigraphNode uid uid (Set.toList depends) : go (Set.insert uid done) todo'' +-------------------------------------------------------------------------------- +-- * Enable Code Gen for Template Haskell +-------------------------------------------------------------------------------- + -- | Update the every ModSummary that is depended on -- by a module that needs template haskell. We enable codegen to -- the specified target, disable optimization and change the .hi @@ -1223,7 +1273,8 @@ Potential TODOS: -} ----------------------------------------------------------------------------- --- Summarising modules +-- * Pre-processing and Summarising and modules +----------------------------------------------------------------------------- -- We have two types of summarisation: -- @@ -1639,9 +1690,11 @@ getPreprocessedImports hsc_env src_fn mb_phase maybe_buf = do return PreprocessedImports {..} -------------------------------------------------------------------------------- +-- * Generic traversal of iteratively-built graph: dfsBuild +-------------------------------------------------------------------------------- -- | The result of expanding a node in 'dfsBuild'. -data MGRes v +data NodeRes v -- | Computed the node payload successfully = NSuccess v -- | Skip a node! This means this node doesn't produce a payload and we can @@ -1657,8 +1710,8 @@ data MGRes v -- graph by iteratively expanding a node into a payload and a list of children -- nodes to visit next. -- --- A node is NEVER visited/expanded more than once, as long as the the --- node key @k@, computed from the node @n@, uniquely identifies that node. +-- A node is NEVER visited/expanded more than once, as long as the node key +-- @k@, computed from the node @n@, uniquely identifies that node. -- -- The first argument @base_map@ is the starting set of already visited nodes -- (these nodes won't be expanded again!). @@ -1678,17 +1731,17 @@ data MGRes v -- -- See also Note [Downsweep Control Flow and Caching] dfsBuild :: (Ord k, Monad m) - => Maybe (Map.Map k (MGRes v)) + => Maybe (Map.Map k (NodeRes v)) -- ^ Base map, existing results. We won't re-expand any of the nodes -- already present in this map. -> [n] -- ^ The root nodes from where to start traversal -> (n -> k) -- ^ Compute the key which uniquely identifies this node - -> (n -> m (MGRes (v,[n]))) + -> (n -> m (NodeRes (v,[n]))) -- ^ Expand this node into its payload result and into the list of -- children nodes to visit next. - -> m (Map.Map k (MGRes v)) + -> m (Map.Map k (NodeRes v)) -- ^ The result accumulates the payload of expanding the root nodes -- and all nodes transitively reachable from those roots. dfsBuild base_map roots key expand = go roots (fromMaybe Map.empty base_map) @@ -1704,7 +1757,7 @@ dfsBuild base_map roots key expand = go roots (fromMaybe Map.empty base_map) go ss (Map.insert k NSkip visited) -- Skip! NSuccess (v,ns) -> - go (ns ++ ss {- todo: not use ++ here? -}) + go (ns ++ ss) (Map.insert k (NSuccess v) visited) where k = key s View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/25ec3570556d915af9e5c1c97daa25ce... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/25ec3570556d915af9e5c1c97daa25ce... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help