Hannes Siebenhandl pushed to branch wip/romes/27461 at Glasgow Haskell Compiler / GHC

Commits:

4 changed files:

Changes:

  • changelog.d/downsweep-refactor
    1 
    +section: compiler
    2 
    +synopsis: Significantly improve the performance of downsweep
    3 
    +issues: #27461
    4 
    +mrs: !16330
    5 
    +description: {
    6 
    +    Rewrite the downsweep pass to make the control flow clearer and fix the
    7 
    +    caching strategy. Allocations during downsweep in multi-home-unit-heavy and
    8 
    +    module-heavy tests are reduced by -30% to -60%
    9 
    +}

  • compiler/GHC/Driver/Downsweep.hs
    ... ... @@ -5,8 +5,8 @@
    5 5 
     {-# LANGUAGE RecordWildCards #-}
    6 6 
     {-# LANGUAGE BlockArguments #-}
    7 7 
     {-# LANGUAGE ViewPatterns #-}
    8 
    -{-# LANGUAGE TypeFamilies #-}
    9 
    -{-# LANGUAGE FunctionalDependencies #-}
    8 
    +
    9 
    +-- | See Note [The ModuleGraph]
    10 10 
     module GHC.Driver.Downsweep
    11 11 
       ( downsweep
    12 12 
       , downsweepThunk
    ... ... @@ -117,17 +117,35 @@ import Data.IORef
    117 117 
     import qualified Data.List.NonEmpty as NE
    118 118
    119 119 
     {-
    120 
    -Note [Downsweep and the ModuleGraph]
    121 
    -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    120 
    +Note [The ModuleGraph]
    121 
    +~~~~~~~~~~~~~~~~~~~~~~
    122 
    +The 'ModuleGraph' stores the relationship between all the modules, units, and
    123 
    +instantiations in the current session, allowing e.g. to answer questions about
    124 
    +the transitive closure of the imports.
    125 
    +
    126 
    +* A /node/ of the `ModuleGraph`, of type `ModuleGraphNode`, corresponds
    127 
    +  1-1 with a home-package module of source code, N.hs or N.hs-boot.
    128 
    +  See the haddocks of `ModuleGraphNode`.
    129 
    +
    130 
    +  The `ModuleNodeInfo` field of the `ModuleGraphNode` contains a `ModSummary`
    131 
    +  that in turn describes where the source file is (its `ModLocation`), when it
    132 
    +  was read, its contents etc. See Note [Module Types in the ModuleGraph].
    133 
    +
    134 
    +  Each node has a distinct `NodeKey` (an instance of Ord); the function
    135 
    +        mkNodeKey :: ModuleGraphNode -> NodeKey
    136 
    +  get the `NodeKey` of a node
    122 137
    123 
    -The ModuleGraph stores the relationship between all the modules, units, and
    124 
    -instantiations in the current session.
    138 
    +* An /edge/ of the `ModuleGraph` from N1 to N2 typically corresponds to a
    139 
    +  direct import of module N2 in module N1: one edge for each import.
    140 
    +  Imports of modules from non-home-packages are featured in the `ModuleGraph`
    141 
    +  as `UnitNode`s, or `InstantiationNodes` when backpack is involved.
    125 142
    126 
    -When we do downsweep, we build up a new ModuleGraph, starting from the root
    127 
    -modules. By following all the dependencies we construct a graph which allows
    128 
    -us to answer questions about the transitive closure of the imports.
    143 
    +  Each node contains a list of all its out-edges or, more precisely, of the
    144 
    +  `NodeKey`s of its direct dependencies.
    129 145
    130 
    -The module graph is accessible in the HscEnv.
    146 
    +Because a node in the `ModuleGraph` describes the precise dependencies of the module, each node has its
    147 
    +own `UnitId`.  Remember, a single module can be compiled against many different versions of a library; but
    148 
    +once we fix its dependencies we can compile it, and give it a `UnitId`.  See Note [About units] in GHC.Unit.
    131 149
    132 150 
     When is this graph constructed?
    133 151
    ... ... @@ -144,10 +162,54 @@ When is this graph constructed?
    144 162
    145 163 
     The result is having a uniform graph available for the whole compilation pipeline.
    146 164
    147 
    -See also Note [Downsweep Control Flow and Caching]
    165 
    +See Note [Downsweep Control Flow and Caching] for implementation details of
    166 
    +the algorithm and caching.
    167 
    +
    168 
    +Note [Downsweep: building and maintaining the module graph]
    169 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    170 
    +The module graph can be built from scratch by starting from a set of /root nodes/
    171 
    +and exploring their dependencies. This is done by `GHC.Driver.Downsweep.downsweep`.
    172 
    +
    173 
    +Another scenario is when we already /have/ a `ModuleGraph` and want to update
    174 
    +it (e.g. to reflect any file-system changes that have taken place since the
    175 
    +last invocation of `downsweep`) or augment it by exploring new roots (e.g. for
    176 
    +incrementally constructing a ModuleGraph using the GHC API; See #27054). So
    177 
    +`downsweep` takes a `Maybe ModuleGraph` as one of its arguments.
    178 
    +
    179 
    +Downsweep iteratively *expands* each so-called 'DownsweepNode' into a list of
    180 
    +its dependencies, and recursively traverses all reachable nodes in a
    181 
    +depth-first order using 'dfsBuild'. A 'DownsweepNode' is *expanded* by 'dsNodeExpand':
    182 
    +
    183 
    +  dsNodeExpand :: DownsweepNode -> DownsweepM (NodeRes (ModuleGraphNode, [DownsweepNode]))
    184 
    +
    185 
    +Most notably:
    186 
    +
    187 
    +  - 'DSMod' (Module-based) nodes can be expanded by preprocessing and
    188 
    +  parsing the module header, then listing the imports (direct and SOURCE imports)
    189 
    +  (see 'expandModuleSummary' and 'expandFixedModuleNode')
    190 
    +
    191 
    +  - 'DSUnit' is expanded by finding the unit dependencies of that unit by id
    192 
    +  (see 'expandUnitNode').
    193 
    +
    194 
    +Besides its dependencies, expanding a 'DownsweepNode' produces a
    195 
    +'ModuleGraphNode'. The final 'ModuleGraph' is constructed from the list of
    196 
    +'ModuleGraphNode's accumulated by expanding all reachable 'DownsweepNode's.
    197 
    +
    198 
    +A 'ModuleGraphNode' is essentially the resolved version of 'DownsweepNode':
    199 
    +it records the payload (e.g. a Module) *and* its dependencies, unlike
    200 
    +'DownsweepNode' which has the just the payload that is used as a seed (and
    201 
    +potentially some context information, like the current home-unit)
    202 
    +
    203 
    +TL;DR: We recursively traverse 'DownsweepNodes' to discover and build the 'ModuleGraph'.
    204 
    +
    205 
    +See also Note [Downsweep Control Flow and Caching] for implementation details.
    206 
    +See Note [The ModuleGraph] for an overview when we do downsweep.
    148 207 
     -}
    149 208
    150 209 
     -----------------------------------------------------------------------------
    210 
    +-- * Top-level entry to downsweep
    211 
    +-----------------------------------------------------------------------------
    212 
    +
    151 213 
     --
    152 214 
     -- | Downsweep (dependency analysis) for --make mode
    153 215 
     --
    ... ... @@ -159,7 +221,7 @@ See also Note [Downsweep Control Flow and Caching]
    159 221 
     -- cache to avoid recalculating a module summary if the source is
    160 222 
     -- unchanged.
    161 223 
     --
    162 
    --- Downsweeping can start from scratch for from a given module graph. In the
    224 
    +-- Downsweeping can start from scratch or from a given module graph. In the
    163 225 
     -- latter case, the given graph is fully included in the resulting graph, even
    164 226 
     -- if parts of it are not reachable from any of the given roots. When an import
    165 227 
     -- is processed, the source of the imported module is not consulted if this
    ... ... @@ -175,6 +237,8 @@ See also Note [Downsweep Control Flow and Caching]
    175 237 
     --
    176 238 
     -- It will also turn on code generation for any modules that need it by calling
    177 239 
     -- 'enableCodeGenForTH'.
    240 
    +--
    241 
    +-- See also Note [The ModuleGraph]
    178 242 
     downsweep :: HscEnv
    179 243 
               -> (GhcMessage -> AnyGhcDiagnostic)
    180 244 
               -> Maybe Messager
    ... ... @@ -231,6 +295,35 @@ downsweep hsc_env diag_wrapper msg old_summaries maybe_base_graph excl_mods allo
    231 295 
         unitModuleNodes summaries uid hue =
    232 296 
           maybeToList (linkNodes summaries uid hue)
    233 297
    298 
    +    -- The linking plan for each module. If we need to do linking for a home unit
    299 
    +    -- then this function returns a graph node which depends on all the modules in the home unit.
    300 
    +
    301 
    +    -- At the moment nothing can depend on these LinkNodes.
    302 
    +    linkNodes :: [ModuleGraphNode] -> UnitId -> HomeUnitEnv -> Maybe (Either (Messages DriverMessage) ModuleGraphNode)
    303 
    +    linkNodes summaries uid hue =
    304 
    +      let dflags = homeUnitEnv_dflags hue
    305 
    +          ofile = outputFile_ dflags
    306 
    +
    307 
    +          unit_nodes :: [NodeKey]
    308 
    +          unit_nodes = map mkNodeKey (filter ((== uid) . mgNodeUnitId) summaries)
    309 
    +      -- Issue a warning for the confusing case where the user
    310 
    +      -- said '-o foo' but we're not going to do any linking.
    311 
    +      -- We attempt linking if either (a) one of the modules is
    312 
    +      -- called Main, or (b) the user said -no-hs-main, indicating
    313 
    +      -- that main() is going to come from somewhere else.
    314 
    +      --
    315 
    +          no_hs_main = gopt Opt_NoHsMain dflags
    316 
    +
    317 
    +          main_sum = any (== NodeKey_Module (ModNodeKeyWithUid (GWIB (mainModuleNameIs dflags) NotBoot) uid)) unit_nodes
    318 
    +
    319 
    +          do_linking =  main_sum || no_hs_main || ghcLink dflags == LinkDynLib || ghcLink dflags == LinkStaticLib || ghcLink dflags == LinkBytecodeLib
    320 
    +
    321 
    +      in if | isExecutableLink (ghcLink dflags) && isJust ofile && not do_linking ->
    322 
    +                Just (Left $ singleMessage $ mkPlainErrorMsgEnvelope noSrcSpan (DriverRedirectedNoMain $ mainModuleNameIs dflags))
    323 
    +            -- This should be an error, not a warning (#10895).
    324 
    +            | ghcLink dflags /= NoLink, do_linking -> Just (Right (LinkNode unit_nodes uid))
    325 
    +            | otherwise  -> Nothing
    326 
    +
    234 327 
     -- | Calculate the module graph starting from a single ModSummary. The result is a
    235 328 
     -- thunk, which when forced will perform the downsweep. This is useful in oneshot
    236 329 
     -- mode where the module graph may never be needed.
    ... ... @@ -322,7 +415,35 @@ downsweepInstalledModules hsc_env mods = do
    322 415
    323 416 
         return (mkModuleGraph mg)
    324 417
    418 
    +-----------------------------------------------------------------------------
    419 
    +-- * Orchestrator: downsweepFromRootNodes
    420 
    +-----------------------------------------------------------------------------
    421 
    +
    422 
    +type ModSummaryCache = IORef ModSummaryCacheMap
    423 
    +type ImportsCache    = IORef ImportsCacheMap
    424 
    +
    425 
    +-- | A cache from file paths to the already summarised modules. The same file
    426 
    +-- can be used in multiple units so the map is actually also keyed by which
    427 
    +-- unit the file was used in.
    428 
    +--
    429 
    +-- We want to reuse ModSummaries as far as possible because the most expensive
    430 
    +-- part of downsweep is reading and parsing the headers.
    431 
    +--
    432 
    +-- See Note [Downsweep Control Flow and Caching]
    433 
    +type ModSummaryCacheMap
    434 
    +      -- The cache can't be keyed by 'Module' because that isn't sufficient to
    435 
    +      -- distinguish .hs from .hs-boot files. Use path+unit instead.
    436 
    +      = ( M.Map (UnitId, OsPath) (Either DriverMessages (ModSummary, SummProvenance)) )
    325 437
    438 
    +-- | A 'ModSummary's provenance during downsweep: an old previously constructed
    439 
    +-- ModSummary, that might be potentially outdated, or a freshly constructed one
    440 
    +-- during this downsweep which is certainly up to date?
    441 
    +data SummProvenance
    442 
    +  -- | Constructed during this downsweep: trivially up to date
    443 
    +  = SummFresh
    444 
    +  -- | Carried over from a previous run: may be stale, must be hash-checked
    445 
    +  -- (and considered by -fforce-recomp)
    446 
    +  | SummOld
    326 447
    327 448 
     -- | Whether downsweep should use compiler or fixed nodes. Compile nodes are used
    328 449 
     -- by --make mode, and fixed nodes by oneshot mode.
    ... ... @@ -381,20 +502,15 @@ downsweepFromRootNodes hsc_env summ_cache imps_cache maybe_base_graph excl_mods
    381 502 
                [ ((moduleNodeInfoUnitId s, moduleNodeInfoMnwib s), [s])
    382 503 
                | s <- root_nodes ]
    383 504
    384 
    -    moduleGraphNodeMap :: ModuleGraph -> M.Map NodeKey (MGRes ModuleGraphNode)
    505 
    +    moduleGraphNodeMap :: ModuleGraph -> M.Map NodeKey (NodeRes ModuleGraphNode)
    385 506 
         moduleGraphNodeMap graph
    386 507 
             = M.fromList [(mkNodeKey node, NSuccess node) | node <- mgModSummaries' graph]
    387 508
    388 509 
         sec = initSourceErrorContext (hsc_dflags hsc_env)
    389 510
    390 
    -calcDeps :: ModSummary -> [(ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))]
    391 
    -calcDeps ms =
    392 
    -  -- Add a dependency on the HsBoot file if it exists
    393 
    -  -- This gets passed to the loopImports function which just ignores it if it
    394 
    -  -- can't be found.
    395 
    -  [(NormalLevel, NoPkgQual, GWIB (noLoc $ ms_mod_name ms) IsBoot) | NotBoot <- [isBootSummary ms] ] ++
    396 
    -  [(lvl, b, c) | (lvl, b, c) <- msDeps ms ]
    397 
    -
    511 
    +--------------------------------------------------------------------------------
    512 
    +-- ** 'DownsweepM'
    513 
    +--------------------------------------------------------------------------------
    398 514
    399 515 
     type DownsweepM a = ReaderT DownsweepEnv IO a
    400 516 
     data DownsweepEnv = DownsweepEnv {
    ... ... @@ -405,29 +521,6 @@ data DownsweepEnv = DownsweepEnv {
    405 521 
         , _downsweep_excl_mods :: [ModuleName]
    406 522 
     }
    407 523
    408 
    -type ModSummaryCache = IORef ModSummaryCacheMap
    409 
    -type ImportsCache    = IORef ImportsCacheMap
    410 
    -
    411 
    --- | A cache from file paths to the already summarised modules. The same file
    412 
    --- can be used in multiple units so the map is actually also keyed by which
    413 
    --- unit the file was used in.
    414 
    ---
    415 
    --- We want to reuse ModSummaries as far as possible because the most expensive
    416 
    --- part of downsweep is reading and parsing the headers.
    417 
    ---
    418 
    --- See Note [Downsweep Control Flow and Caching]
    419 
    -type ModSummaryCacheMap
    420 
    -      -- The cache can't be keyed by 'Module' because that isn't sufficient to
    421 
    -      -- distinguish .hs from .hs-boot files. Use path+unit instead.
    422 
    -      = ( M.Map (UnitId, OsPath) (Either DriverMessages (ModSummary, SummProvenance)) )
    423 
    -
    424 
    -data SummProvenance
    425 
    -  -- | Constructed during this downsweep: trivially up to date
    426 
    -  = SummFresh
    427 
    -  -- | Carried over from a previous run: may be stale, must be hash-checked
    428 
    -  -- (and considered by -fforce-recomp)
    429 
    -  | SummOld
    430 
    -
    431 524 
     mkModSummaryCache :: [(ModSummary, SummProvenance)] -> ModSummaryCacheMap
    432 525 
     mkModSummaryCache summs = foldl' (flip (uncurry addModSummaryCache)) M.empty summs
    433 526
    ... ... @@ -460,17 +553,19 @@ mkRootMap summaries = Map.fromList
    460 553 
     runDownsweepM :: DownsweepEnv -> DownsweepM a -> IO a
    461 554 
     runDownsweepM env act = runReaderT act env
    462 555
    463 
    -loopDownsweepNodes  :: M.Map NodeKey (MGRes ModuleGraphNode) -> [DownsweepNode]               -> DownsweepM (M.Map NodeKey (MGRes ModuleGraphNode))
    464 
    -loopModuleNodeInfos :: M.Map NodeKey (MGRes ModuleGraphNode) -> [ModuleNodeInfo]              -> DownsweepM (M.Map NodeKey (MGRes ModuleGraphNode))
    465 
    -loopUnits           :: M.Map NodeKey (MGRes ModuleGraphNode) -> UnitId -> [UnitId]            -> DownsweepM (M.Map NodeKey (MGRes ModuleGraphNode))
    466 
    -loopInstantiations  :: M.Map NodeKey (MGRes ModuleGraphNode) -> [(UnitId, InstantiatedUnit)]  -> DownsweepM (M.Map NodeKey (MGRes ModuleGraphNode))
    467 
    -loopFromInteractive :: M.Map NodeKey (MGRes ModuleGraphNode) -> Module -> [InteractiveImport] -> DownsweepM (M.Map NodeKey (MGRes ModuleGraphNode))
    556 
    +loopDownsweepNodes  :: M.Map NodeKey (NodeRes ModuleGraphNode) -> [DownsweepNode]               -> DownsweepM (M.Map NodeKey (NodeRes ModuleGraphNode))
    557 
    +loopModuleNodeInfos :: M.Map NodeKey (NodeRes ModuleGraphNode) -> [ModuleNodeInfo]              -> DownsweepM (M.Map NodeKey (NodeRes ModuleGraphNode))
    558 
    +loopUnits           :: M.Map NodeKey (NodeRes ModuleGraphNode) -> UnitId -> [UnitId]            -> DownsweepM (M.Map NodeKey (NodeRes ModuleGraphNode))
    559 
    +loopInstantiations  :: M.Map NodeKey (NodeRes ModuleGraphNode) -> [(UnitId, InstantiatedUnit)]  -> DownsweepM (M.Map NodeKey (NodeRes ModuleGraphNode))
    560 
    +loopFromInteractive :: M.Map NodeKey (NodeRes ModuleGraphNode) -> Module -> [InteractiveImport] -> DownsweepM (M.Map NodeKey (NodeRes ModuleGraphNode))
    468 561 
     loopDownsweepNodes  base_map nodes = dfsBuild (Just base_map) nodes dsNodeInfoKey dsNodeExpand
    469 562 
     loopModuleNodeInfos base_map       = loopDownsweepNodes base_map . map DSMod
    470 563 
     loopUnits           base_map homud = loopDownsweepNodes base_map . map (DSUnit homud)
    471 564 
     loopInstantiations  base_map       = loopDownsweepNodes base_map . map (uncurry DSInst)
    472 565 
     loopFromInteractive base_map m     = loopDownsweepNodes base_map . (:[]) . DSInteractive m
    473 566
    567 
    +--------------------------------------------------------------------------------
    568 
    +-- * Expanding 'DownsweepNode's into payload and node dependencies
    474 569 
     --------------------------------------------------------------------------------
    475 570
    476 571 
     -- | A 'DownsweepNode' is the basic block of the downsweep algorithm which
    ... ... @@ -516,7 +611,7 @@ dsNodeInfoKey = \case
    516 611 
       DSInst{instantiated_ud}       -> NodeKey_Unit instantiated_ud
    517 612 
       DSInteractive mod _imps       -> NodeKey_Module $ moduleToMnk mod NotBoot
    518 613
    519 
    -dsNodeExpand :: DownsweepNode -> DownsweepM (MGRes (ModuleGraphNode, [DownsweepNode]))
    614 
    +dsNodeExpand :: DownsweepNode -> DownsweepM (NodeRes (ModuleGraphNode, [DownsweepNode]))
    520 615 
     dsNodeExpand = \case
    521 616 
       DSMod (ModuleNodeCompile ms)         -> expandModuleSummary ms
    522 617 
       DSMod (ModuleNodeFixed key loc)      -> expandFixedModuleNode key loc
    ... ... @@ -525,12 +620,29 @@ dsNodeExpand = \case
    525 620 
             , home_context_uid }           -> expandInstantiatedUnit instantiated_ud home_context_uid
    526 621 
       DSInteractive imod iis               -> expandInteractiveImports imod iis
    527 622
    528 
    -expandModuleSummary :: ModSummary -> DownsweepM (MGRes (ModuleGraphNode, [DownsweepNode]))
    623 
    +expandModuleSummary :: ModSummary -> DownsweepM (NodeRes (ModuleGraphNode, [DownsweepNode]))
    529 624 
     expandModuleSummary ms = do -- Didn't work out what the imports mean yet, now do that.
    530 625 
         hsc_env <- asks downsweep_hsc_env
    531 626 
         let home_uid  = ms_unitid ms
    532 627 
             home_unit = ue_unitHomeUnit home_uid (hsc_unit_env hsc_env)
    533 
    -    (final_deps, todo) <- fmap unzip $ forM (calcDeps ms) $ \(imp,mb_pkg,gwib) -> do
    628 
    +    (final_deps, todo) <- unzip <$> mapM (expandModImport home_uid home_unit) (calcDeps ms)
    629 
    +
    630 
    +    -- This has the effect of finding a .hs file if we are looking at the .hs-boot file.
    631 
    +    boot_todo <-
    632 
    +      if | HsBootFile <- ms_hsc_src ms
    633 
    +         -> do
    634 
    +            r <- downsweepSummarise home_unit NotBoot (noLoc $ ms_mod_name ms) NoPkgQual Nothing
    635 
    +            case r of
    636 
    +              FoundHome s -> pure [DSMod s]
    637 
    +              _           -> pure []
    638 
    +         | otherwise      -> pure []
    639 
    +
    640 
    +    return $ NSuccess
    641 
    +      ( ModuleNode (catMaybes final_deps) (ModuleNodeCompile ms)
    642 
    +      , boot_todo ++ concat todo
    643 
    +      )
    644 
    +  where
    645 
    +    expandModImport home_uid home_unit (imp,mb_pkg,gwib) = do
    534 646 
           let GWIB { gwib_mod = L loc mod, gwib_isBoot = is_boot } = gwib
    535 647 
               wanted_mod = L loc mod
    536 648 
           mb_s <- downsweepSummarise home_unit is_boot wanted_mod mb_pkg Nothing
    ... ... @@ -552,24 +664,17 @@ expandModuleSummary ms = do -- Didn't work out what the imports mean yet, now do
    552 664 
               ( Just $ mkModuleEdge imp (NodeKey_Module (mnKey s))
    553 665 
               , [DSMod s] )
    554 666
    555 
    -    -- This has the effect of finding a .hs file if we are looking at the .hs-boot file.
    556 
    -    boot_todo <-
    557 
    -      if | HsBootFile <- ms_hsc_src ms
    558 
    -         -> do
    559 
    -            r <- downsweepSummarise home_unit NotBoot (noLoc $ ms_mod_name ms) NoPkgQual Nothing
    560 
    -            case r of
    561 
    -              FoundHome s -> pure [DSMod s]
    562 
    -              _           -> pure []
    563 
    -         | otherwise      -> pure []
    564 
    -
    565 
    -    return $ NSuccess
    566 
    -      ( ModuleNode (catMaybes final_deps) (ModuleNodeCompile ms)
    567 
    -      , boot_todo ++ concat todo
    568 
    -      )
    667 
    +    calcDeps :: ModSummary -> [(ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))]
    668 
    +    calcDeps ms =
    669 
    +      -- Add a dependency on the HsBoot file if it exists
    670 
    +      -- This gets passed to the loopImports function which just ignores it if it
    671 
    +      -- can't be found.
    672 
    +      [(NormalLevel, NoPkgQual, GWIB (noLoc $ ms_mod_name ms) IsBoot) | NotBoot <- [isBootSummary ms] ] ++
    673 
    +      [(lvl, b, c) | (lvl, b, c) <- msDeps ms ]
    569 674
    570 675 
     -- | Expand a 'ModuleNodeFixed' node
    571 676 
     -- NB: If you ever reach a Fixed node, everything under that also must be fixed.
    572 
    -expandFixedModuleNode :: ModNodeKeyWithUid -> ModLocation -> DownsweepM (MGRes (ModuleGraphNode, [DownsweepNode]))
    677 
    +expandFixedModuleNode :: ModNodeKeyWithUid -> ModLocation -> DownsweepM (NodeRes (ModuleGraphNode, [DownsweepNode]))
    573 678 
     expandFixedModuleNode key loc = do
    574 679 
         hsc_env <- asks downsweep_hsc_env
    575 680 
         -- MP: TODO, we should just read the dependency info from the interface rather than either
    ... ... @@ -603,7 +708,7 @@ expandFixedModuleNode key loc = do
    603 708 
               pure $ Just $ DSMod (ModuleNodeFixed key loc)
    604 709 
             _otherwise ->
    605 710 
               -- If the finder fails, just keep going, there will be another
    606 
    -          -- error later.
    711 
    +          -- error later when we try to expand this dependency.
    607 712 
               pure Nothing
    608 713 
         mk_dep _ (Right uid_dep) = do
    609 714 
           -- Set active unit so that looking loopUnit finds the correct
    ... ... @@ -611,9 +716,22 @@ expandFixedModuleNode key loc = do
    611 716 
           let home_uid = mnkUnitId key
    612 717 
           pure (Just DSUnit{node_uid=uid_dep, home_context_uid=home_uid})
    613 718
    719 
    +    mkFixedEdge :: Either (ImportLevel, ModNodeKeyWithUid) (ImportLevel, UnitId) -> ModuleNodeEdge
    720 
    +    mkFixedEdge (Left (lvl, key))  = mkModuleEdge lvl (NodeKey_Module key)
    721 
    +    mkFixedEdge (Right (lvl, uid)) = mkModuleEdge lvl (NodeKey_ExternalUnit uid)
    722 
    +
    723 
    +    ifaceDeps :: Dependencies -> [Either (ImportLevel, ModNodeKeyWithUid) (ImportLevel, UnitId)]
    724 
    +    ifaceDeps deps =
    725 
    +      [ Left (tcImportLevel lvl, ModNodeKeyWithUid dep uid)
    726 
    +      | (lvl, uid, dep) <- Set.toList (dep_direct_mods deps)
    727 
    +      ] ++
    728 
    +      [ Right (tcImportLevel lvl, uid)
    729 
    +      | (lvl, uid) <- Set.toList (dep_direct_pkgs deps)
    730 
    +      ]
    731 
    +
    614 732 
     -- | Expand a unit id under the context of a certain home unit
    615 733 
     expandUnitNode :: UnitId {-^ @node_uid@ -} -> UnitId {-^ Home unit from where @node_uid@ was introduced -}
    616 
    -               -> DownsweepM (MGRes (ModuleGraphNode, [DownsweepNode]))
    734 
    +               -> DownsweepM (NodeRes (ModuleGraphNode, [DownsweepNode]))
    617 735 
     expandUnitNode node_uid home_context_uid = do
    618 736 
         -- Set active unit so that looking loopUnit finds the correct
    619 737 
         -- -package flags in the unit state.
    ... ... @@ -623,12 +741,12 @@ expandUnitNode node_uid home_context_uid = do
    623 741 
           Just us -> pure $ NSuccess ((UnitNode us node_uid), map (\u -> DSUnit{node_uid=u, home_context_uid{-inherit-}}) us)
    624 742 
           Nothing -> pprPanic "loopUnit" (text "Malformed package database, missing " <+> ppr node_uid)
    625 743
    626 
    -expandInstantiatedUnit :: InstantiatedUnit -> UnitId {-^ Home unit -} -> DownsweepM (MGRes (ModuleGraphNode, [DownsweepNode]))
    744 
    +expandInstantiatedUnit :: InstantiatedUnit -> UnitId {-^ Home unit -} -> DownsweepM (NodeRes (ModuleGraphNode, [DownsweepNode]))
    627 745 
     expandInstantiatedUnit iud home_uid = pure $ NSuccess
    628 746 
       ( InstantiationNode home_uid iud
    629 747 
       , [DSUnit{node_uid=instUnitInstanceOf iud, home_context_uid=home_uid}] )
    630 748
    631 
    -expandInteractiveImports :: Module -> [InteractiveImport] -> DownsweepM (MGRes (ModuleGraphNode, [DownsweepNode]))
    749 
    +expandInteractiveImports :: Module -> [InteractiveImport] -> DownsweepM (NodeRes (ModuleGraphNode, [DownsweepNode]))
    632 750 
     expandInteractiveImports imod imps = do
    633 751 
       hsc_env    <- asks downsweep_hsc_env
    634 752 
       imps_cache <- asks downsweep_imports_cache
    ... ... @@ -686,19 +804,8 @@ expandInteractiveImports imod imps = do
    686 804 
         node_type = ModuleNodeFixed key ml
    687 805
    688 806 
     --------------------------------------------------------------------------------
    689 
    -
    690 
    -mkFixedEdge :: Either (ImportLevel, ModNodeKeyWithUid) (ImportLevel, UnitId) -> ModuleNodeEdge
    691 
    -mkFixedEdge (Left (lvl, key)) = mkModuleEdge lvl (NodeKey_Module key)
    692 
    -mkFixedEdge (Right (lvl, uid)) = mkModuleEdge lvl (NodeKey_ExternalUnit uid)
    693 
    -
    694 
    -ifaceDeps :: Dependencies -> [Either (ImportLevel, ModNodeKeyWithUid) (ImportLevel, UnitId)]
    695 
    -ifaceDeps deps =
    696 
    -  [ Left (tcImportLevel lvl, ModNodeKeyWithUid dep uid)
    697 
    -  | (lvl, uid, dep) <- Set.toList (dep_direct_mods deps)
    698 
    -  ] ++
    699 
    -  [ Right (tcImportLevel lvl, uid)
    700 
    -  | (lvl, uid) <- Set.toList (dep_direct_pkgs deps)
    701 
    -  ]
    807 
    +-- * Constructing Module Summaries
    808 
    +--------------------------------------------------------------------------------
    702 809
    703 810 
     downsweepSummarise :: HomeUnit
    704 811 
                        -> IsBootInterface
    ... ... @@ -745,35 +852,6 @@ instantiationNodes uid unit_state = map (uid,) iuids_to_check
    745 852 
             , recur <- (indef :) $ goUnitId $ moduleUnit $ snd inst
    746 853 
             ]
    747 854
    748 
    --- The linking plan for each module. If we need to do linking for a home unit
    749 
    --- then this function returns a graph node which depends on all the modules in the home unit.
    750 
    -
    751 
    --- At the moment nothing can depend on these LinkNodes.
    752 
    -linkNodes :: [ModuleGraphNode] -> UnitId -> HomeUnitEnv -> Maybe (Either (Messages DriverMessage) ModuleGraphNode)
    753 
    -linkNodes summaries uid hue =
    754 
    -  let dflags = homeUnitEnv_dflags hue
    755 
    -      ofile = outputFile_ dflags
    756 
    -
    757 
    -      unit_nodes :: [NodeKey]
    758 
    -      unit_nodes = map mkNodeKey (filter ((== uid) . mgNodeUnitId) summaries)
    759 
    -  -- Issue a warning for the confusing case where the user
    760 
    -  -- said '-o foo' but we're not going to do any linking.
    761 
    -  -- We attempt linking if either (a) one of the modules is
    762 
    -  -- called Main, or (b) the user said -no-hs-main, indicating
    763 
    -  -- that main() is going to come from somewhere else.
    764 
    -  --
    765 
    -      no_hs_main = gopt Opt_NoHsMain dflags
    766 
    -
    767 
    -      main_sum = any (== NodeKey_Module (ModNodeKeyWithUid (GWIB (mainModuleNameIs dflags) NotBoot) uid)) unit_nodes
    768 
    -
    769 
    -      do_linking =  main_sum || no_hs_main || ghcLink dflags == LinkDynLib || ghcLink dflags == LinkStaticLib || ghcLink dflags == LinkBytecodeLib
    770 
    -
    771 
    -  in if | isExecutableLink (ghcLink dflags) && isJust ofile && not do_linking ->
    772 
    -            Just (Left $ singleMessage $ mkPlainErrorMsgEnvelope noSrcSpan (DriverRedirectedNoMain $ mainModuleNameIs dflags))
    773 
    -        -- This should be an error, not a warning (#10895).
    774 
    -        | ghcLink dflags /= NoLink, do_linking -> Just (Right (LinkNode unit_nodes uid))
    775 
    -        | otherwise  -> Nothing
    776 
    -
    777 855 
     getRootSummary ::
    778 856 
       [ModuleName] ->
    779 857 
       ModSummaryCache ->
    ... ... @@ -858,6 +936,10 @@ rootSummariesParallel n_jobs hsc_env diag_wrapper msg get_summary = do
    858 936 
                   throwIO e
    859 937 
                 a -> pure a
    860 938
    939 
    +--------------------------------------------------------------------------------
    940 
    +-- * Check/validate properties and error out
    941 
    +--------------------------------------------------------------------------------
    942 
    +
    861 943 
     -- | This function checks then important property that if both p and q are home units
    862 944 
     -- then any dependency of p, which transitively depends on q is also a home unit.
    863 945 
     --
    ... ... @@ -905,6 +987,10 @@ checkHomeUnitsClosed ue
    905 987 
                           let todo'' = (depends Set.\\ done) `Set.union` todo'
    906 988 
                           in DigraphNode uid uid (Set.toList depends) : go (Set.insert uid done) todo''
    907 989
    990 
    +--------------------------------------------------------------------------------
    991 
    +-- * Enable Code Gen for Template Haskell
    992 
    +--------------------------------------------------------------------------------
    993 
    +
    908 994 
     -- | Update the every ModSummary that is depended on
    909 995 
     -- by a module that needs template haskell. We enable codegen to
    910 996 
     -- the specified target, disable optimization and change the .hi
    ... ... @@ -1223,7 +1309,8 @@ Potential TODOS:
    1223 1309 
     -}
    1224 1310
    1225 1311 
     -----------------------------------------------------------------------------
    1226 
    --- Summarising modules
    1312 
    +-- * Pre-processing and Summarising and modules
    1313 
    +-----------------------------------------------------------------------------
    1227 1314
    1228 1315 
     -- We have two types of summarisation:
    1229 1316 
     --
    ... ... @@ -1639,9 +1726,11 @@ getPreprocessedImports hsc_env src_fn mb_phase maybe_buf = do
    1639 1726 
       return PreprocessedImports {..}
    1640 1727
    1641 1728 
     --------------------------------------------------------------------------------
    1729 
    +-- * Generic traversal of iteratively-built graph: dfsBuild
    1730 
    +--------------------------------------------------------------------------------
    1642 1731
    1643 1732 
     -- | The result of expanding a node in 'dfsBuild'.
    1644 
    -data MGRes v
    1733 
    +data NodeRes v
    1645 1734 
       -- | Computed the node payload successfully
    1646 1735 
       = NSuccess v
    1647 1736 
       -- | Skip a node! This means this node doesn't produce a payload and we can
    ... ... @@ -1657,8 +1746,8 @@ data MGRes v
    1657 1746 
     -- graph by iteratively expanding a node into a payload and a list of children
    1658 1747 
     -- nodes to visit next.
    1659 1748 
     --
    1660 
    --- A node is NEVER visited/expanded more than once, as long as the the
    1661 
    --- node key @k@, computed from the node @n@, uniquely identifies that node.
    1749 
    +-- A node is NEVER visited/expanded more than once, as long as the node key
    1750 
    +-- @k@, computed from the node @n@, uniquely identifies that node.
    1662 1751 
     --
    1663 1752 
     -- The first argument @base_map@ is the starting set of already visited nodes
    1664 1753 
     -- (these nodes won't be expanded again!).
    ... ... @@ -1678,17 +1767,17 @@ data MGRes v
    1678 1767 
     --
    1679 1768 
     -- See also Note [Downsweep Control Flow and Caching]
    1680 1769 
     dfsBuild :: (Ord k, Monad m)
    1681 
    -         => Maybe (Map.Map k (MGRes v))
    1770 
    +         => Maybe (Map.Map k (NodeRes v))
    1682 1771 
              -- ^ Base map, existing results. We won't re-expand any of the nodes
    1683 1772 
              -- already present in this map.
    1684 1773 
              -> [n]
    1685 1774 
              -- ^ The root nodes from where to start traversal
    1686 1775 
              -> (n -> k)
    1687 1776 
              -- ^ Compute the key which uniquely identifies this node
    1688 
    -         -> (n -> m (MGRes (v,[n])))
    1777 
    +         -> (n -> m (NodeRes (v,[n])))
    1689 1778 
              -- ^ Expand this node into its payload result and into the list of
    1690 1779 
              -- children nodes to visit next.
    1691 
    -         -> m (Map.Map k (MGRes v))
    1780 
    +         -> m (Map.Map k (NodeRes v))
    1692 1781 
              -- ^ The result accumulates the payload of expanding the root nodes
    1693 1782 
              -- and all nodes transitively reachable from those roots.
    1694 1783 
     dfsBuild base_map roots key expand = go roots (fromMaybe Map.empty base_map)
    ... ... @@ -1704,7 +1793,7 @@ dfsBuild base_map roots key expand = go roots (fromMaybe Map.empty base_map)
    1704 1793 
                    go ss
    1705 1794 
                       (Map.insert k NSkip        visited) -- Skip!
    1706 1795 
                  NSuccess (v,ns) ->
    1707 
    -               go (ns ++ ss {- todo: not use ++ here? -})
    1796 
    +               go (ns ++ ss)
    1708 1797 
                       (Map.insert k (NSuccess v) visited)
    1709 1798 
           where
    1710 1799 
             k = key s
    ... ... @@ -1725,6 +1814,17 @@ twice).
    1725 1814 
        same node of the module graph. Cache is keyed by the final
    1726 1815 
        `ModuleGraph`s `NodeKey`s.
    1727 1816
    1817 
    +    For example, suppose
    1818 
    +
    1819 
    +       A imports B and C
    1820 
    +       B imports D
    1821 
    +       C imports D
    1822 
    +
    1823 
    +    Then, starting from A we will expand A and push B and C to the worklist;
    1824 
    +    then, going back to B, we expand B which pushes D to the worklist. After
    1825 
    +    processing D, we go to C, which imports D, but we have already visited that
    1826 
    +    module so we can just use the already-constructed `ModuleGraphNode` for D.
    1827 
    +
    1728 1828 
     2. For Module A in home-unit u1, each import in the list of imports
    1729 1829 
        needs to be *found* (call to `findImportedModuleWithIsBoot`): at this
    1730 1830 
        point, we only have the `ModuleName` of the import, not the `Module`.
    ... ... @@ -1732,6 +1832,16 @@ twice).
    1732 1832 
        (`ImportsCache`). The cache key is the home-unit to which the module
    1733 1833 
        belongs~[1], the import package qualifier, and the ModuleName.
    1734 1834
    1835 
    +   Same example, suppose
    1836 
    +
    1837 
    +      A imports B and C
    1838 
    +      B imports D
    1839 
    +      C imports D
    1840 
    +
    1841 
    +   When expanding B, we will findImportedModule "import D".
    1842 
    +   When expanding C, we would findImportedModule "import D", but we can just
    1843 
    +   look it up in the cache
    1844 
    +
    1735 1845 
        [1] Different home-units will have different package flags, which means
    1736 1846 
        potentially different `Module` resolution for the same `ModuleName`.
    1737 1847
    ... ... @@ -1745,8 +1855,13 @@ twice).
    1745 1855 
        distinguish between `.hs` and `.hs-boot` files, as their summaries
    1746 1856 
        will differ.
    1747 1857
    1858 
    +   Note that this covers more than just (1), because we summarise all imports
    1859 
    +   of a single module when expanding it (see 'expandModuleSummary'), before
    1860 
    +   returning from the expansion function.
    1861 
    +
    1748 1862 
        Note that (2) can't guarantee this alone: Two ModuleName imports in
    1749 1863 
        separate units can (and likely do) map to the same `Module`.
    1750 1864
    1751 
    -See also Note [Downsweep and the ModuleGraph]
    1865 
    +See also Note [Downsweep: building and maintaining the module graph] and
    1866 
    +Note [The ModuleGraph].
    1752 1867 
     -}

  • compiler/GHC/Driver/Env.hs
    ... ... @@ -270,7 +270,7 @@ hugSomeThingsBelowUs :: (HomeModInfo -> [a]) -> Bool -> HscEnv -> UnitId -> Modu
    270 270 
     -- These things are currently stored in the EPS for home packages. (See #25795 for
    271 271 
     -- progress in removing these kind of checks; and making these functions of
    272 272 
     -- `UnitEnv` rather than `HscEnv`)
    273 
    --- See Note [Downsweep and the ModuleGraph]
    273 
    +-- See Note [The ModuleGraph]
    274 274 
     hugSomeThingsBelowUs _ _ hsc_env _ _ | isOneShot (ghcMode (hsc_dflags hsc_env)) = return []
    275 275 
     hugSomeThingsBelowUs extract include_hi_boot hsc_env uid mn
    276 276 
       = let hug = hsc_HUG hsc_env

  • compiler/GHC/Unit/Env.hs
    ... ... @@ -164,7 +164,7 @@ data UnitEnv = UnitEnv
    164 164
    165 165 
         , ue_module_graph    :: ModuleGraph
    166 166 
             -- ^ The module graph of the current session
    167 
    -        -- See Note [Downsweep and the ModuleGraph] for when this is constructed.
    167 
    +        -- See Note [The ModuleGraph] for when this is constructed.
    168 168
    169 169 
         , ue_home_unit_graph :: !HomeUnitGraph
    170 170 
             -- See Note [Multiple Home Units]

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help Notification message regarding https://gitlab.haskell.org/ghc/ghc/-/commit/5bfee53ad2045e9c6f1dae6bd2abd7e0f777396d at 1785420537