Rodrigo Mesquita pushed to branch wip/romes/27461 at Glasgow Haskell Compiler / GHC

Commits:

1 changed file:

Changes:

  • 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 [Downsweep and the ModuleGraph]
    10 10 
     module GHC.Driver.Downsweep
    11 11 
       ( downsweep
    12 12 
       , downsweepThunk
    ... ... @@ -119,15 +119,38 @@ import qualified Data.List.NonEmpty as NE
    119 119 
     {-
    120 120 
     Note [Downsweep and the ModuleGraph]
    121 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 
    +Downsweep is the compiler pass which discovers and builds a new 'ModuleGraph'.
    127 
    +by following all the (module,unit,...) dependencies, starting from the root modules.
    128 
    +
    129 
    +Downsweep iteratively *expands* each so-called 'DownsweepNode' into a list of
    130 
    +its dependencies, and recursively traverses all reachable nodes in a
    131 
    +depth-first order using 'dfsBuild'. A 'DownsweepNode' is *expanded* by 'dsNodeExpand':
    132 
    +
    133 
    +  dsNodeExpand :: DownsweepNode -> DownsweepM (NodeRes (ModuleGraphNode, [DownsweepNode]))
    122 134
    123 
    -The ModuleGraph stores the relationship between all the modules, units, and
    124 
    -instantiations in the current session.
    135 
    +Most notably:
    125 136
    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.
    137 
    +  - 'DSMod' (Module-based) nodes can be expanded by preprocessing and
    138 
    +  parsing the module header, then listing the imports (direct and SOURCE imports)
    139 
    +  (see 'expandModuleSummary' and 'expandFixedModuleNode')
    129 140
    130 
    -The module graph is accessible in the HscEnv.
    141 
    +  - 'DSUnit' is expanded by finding the unit dependencies of that unit by id
    142 
    +  (see 'expandUnitNode').
    143 
    +
    144 
    +Besides its dependencies, expanding a 'DownsweepNode' produces a
    145 
    +'ModuleGraphNode'. The final 'ModuleGraph' is constructed from the list of
    146 
    +'ModuleGraphNode's accumulated by expanding all reachable 'DownsweepNode's.
    147 
    +
    148 
    +A 'ModuleGraphNode' is essentially the resolved version of 'DownsweepNode':
    149 
    +it records the payload (e.g. a Module) *and* its dependencies, unlike
    150 
    +'DownsweepNode' which has the just the payload that is used as a seed (and
    151 
    +potentially some context information, like the current home-unit)
    152 
    +
    153 
    +TL;DR: We recursively traverse 'DownsweepNodes' to discover and build the 'ModuleGraph'.
    131 154
    132 155 
     When is this graph constructed?
    133 156
    ... ... @@ -148,6 +171,9 @@ See also Note [Downsweep Control Flow and Caching]
    148 171 
     -}
    149 172
    150 173 
     -----------------------------------------------------------------------------
    174 
    +-- * Top-level entry to downsweep
    175 
    +-----------------------------------------------------------------------------
    176 
    +
    151 177 
     --
    152 178 
     -- | Downsweep (dependency analysis) for --make mode
    153 179 
     --
    ... ... @@ -159,7 +185,7 @@ See also Note [Downsweep Control Flow and Caching]
    159 185 
     -- cache to avoid recalculating a module summary if the source is
    160 186 
     -- unchanged.
    161 187 
     --
    162 
    --- Downsweeping can start from scratch for from a given module graph. In the
    188 
    +-- Downsweeping can start from scratch or from a given module graph. In the
    163 189 
     -- latter case, the given graph is fully included in the resulting graph, even
    164 190 
     -- if parts of it are not reachable from any of the given roots. When an import
    165 191 
     -- 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]
    175 201 
     --
    176 202 
     -- It will also turn on code generation for any modules that need it by calling
    177 203 
     -- 'enableCodeGenForTH'.
    204 
    +--
    205 
    +-- See also Note [Downsweep and the ModuleGraph]
    178 206 
     downsweep :: HscEnv
    179 207 
               -> (GhcMessage -> AnyGhcDiagnostic)
    180 208 
               -> Maybe Messager
    ... ... @@ -231,6 +259,35 @@ downsweep hsc_env diag_wrapper msg old_summaries maybe_base_graph excl_mods allo
    231 259 
         unitModuleNodes summaries uid hue =
    232 260 
           maybeToList (linkNodes summaries uid hue)
    233 261
    262 
    +    -- The linking plan for each module. If we need to do linking for a home unit
    263 
    +    -- then this function returns a graph node which depends on all the modules in the home unit.
    264 
    +
    265 
    +    -- At the moment nothing can depend on these LinkNodes.
    266 
    +    linkNodes :: [ModuleGraphNode] -> UnitId -> HomeUnitEnv -> Maybe (Either (Messages DriverMessage) ModuleGraphNode)
    267 
    +    linkNodes summaries uid hue =
    268 
    +      let dflags = homeUnitEnv_dflags hue
    269 
    +          ofile = outputFile_ dflags
    270 
    +
    271 
    +          unit_nodes :: [NodeKey]
    272 
    +          unit_nodes = map mkNodeKey (filter ((== uid) . mgNodeUnitId) summaries)
    273 
    +      -- Issue a warning for the confusing case where the user
    274 
    +      -- said '-o foo' but we're not going to do any linking.
    275 
    +      -- We attempt linking if either (a) one of the modules is
    276 
    +      -- called Main, or (b) the user said -no-hs-main, indicating
    277 
    +      -- that main() is going to come from somewhere else.
    278 
    +      --
    279 
    +          no_hs_main = gopt Opt_NoHsMain dflags
    280 
    +
    281 
    +          main_sum = any (== NodeKey_Module (ModNodeKeyWithUid (GWIB (mainModuleNameIs dflags) NotBoot) uid)) unit_nodes
    282 
    +
    283 
    +          do_linking =  main_sum || no_hs_main || ghcLink dflags == LinkDynLib || ghcLink dflags == LinkStaticLib || ghcLink dflags == LinkBytecodeLib
    284 
    +
    285 
    +      in if | isExecutableLink (ghcLink dflags) && isJust ofile && not do_linking ->
    286 
    +                Just (Left $ singleMessage $ mkPlainErrorMsgEnvelope noSrcSpan (DriverRedirectedNoMain $ mainModuleNameIs dflags))
    287 
    +            -- This should be an error, not a warning (#10895).
    288 
    +            | ghcLink dflags /= NoLink, do_linking -> Just (Right (LinkNode unit_nodes uid))
    289 
    +            | otherwise  -> Nothing
    290 
    +
    234 291 
     -- | Calculate the module graph starting from a single ModSummary. The result is a
    235 292 
     -- thunk, which when forced will perform the downsweep. This is useful in oneshot
    236 293 
     -- mode where the module graph may never be needed.
    ... ... @@ -322,7 +379,35 @@ downsweepInstalledModules hsc_env mods = do
    322 379
    323 380 
         return (mkModuleGraph mg)
    324 381
    382 
    +-----------------------------------------------------------------------------
    383 
    +-- * Orchestrator: downsweepFromRootNodes
    384 
    +-----------------------------------------------------------------------------
    385 
    +
    386 
    +type ModSummaryCache = IORef ModSummaryCacheMap
    387 
    +type ImportsCache    = IORef ImportsCacheMap
    388 
    +
    389 
    +-- | A cache from file paths to the already summarised modules. The same file
    390 
    +-- can be used in multiple units so the map is actually also keyed by which
    391 
    +-- unit the file was used in.
    392 
    +--
    393 
    +-- We want to reuse ModSummaries as far as possible because the most expensive
    394 
    +-- part of downsweep is reading and parsing the headers.
    395 
    +--
    396 
    +-- See Note [Downsweep Control Flow and Caching]
    397 
    +type ModSummaryCacheMap
    398 
    +      -- The cache can't be keyed by 'Module' because that isn't sufficient to
    399 
    +      -- distinguish .hs from .hs-boot files. Use path+unit instead.
    400 
    +      = ( M.Map (UnitId, OsPath) (Either DriverMessages (ModSummary, SummProvenance)) )
    325 401
    402 
    +-- | A 'ModSummary's provenance during downsweep: an old previously constructed
    403 
    +-- ModSummary, that might be potentially outdated, or a freshly constructed one
    404 
    +-- during this downsweep which is certainly up to date?
    405 
    +data SummProvenance
    406 
    +  -- | Constructed during this downsweep: trivially up to date
    407 
    +  = SummFresh
    408 
    +  -- | Carried over from a previous run: may be stale, must be hash-checked
    409 
    +  -- (and considered by -fforce-recomp)
    410 
    +  | SummOld
    326 411
    327 412 
     -- | Whether downsweep should use compiler or fixed nodes. Compile nodes are used
    328 413 
     -- 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
    381 466 
                [ ((moduleNodeInfoUnitId s, moduleNodeInfoMnwib s), [s])
    382 467 
                | s <- root_nodes ]
    383 468
    384 
    -    moduleGraphNodeMap :: ModuleGraph -> M.Map NodeKey (MGRes ModuleGraphNode)
    469 
    +    moduleGraphNodeMap :: ModuleGraph -> M.Map NodeKey (NodeRes ModuleGraphNode)
    385 470 
         moduleGraphNodeMap graph
    386 471 
             = M.fromList [(mkNodeKey node, NSuccess node) | node <- mgModSummaries' graph]
    387 472
    388 473 
         sec = initSourceErrorContext (hsc_dflags hsc_env)
    389 474
    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 
    -
    475 
    +--------------------------------------------------------------------------------
    476 
    +-- ** 'DownsweepM'
    477 
    +--------------------------------------------------------------------------------
    398 478
    399 479 
     type DownsweepM a = ReaderT DownsweepEnv IO a
    400 480 
     data DownsweepEnv = DownsweepEnv {
    ... ... @@ -405,29 +485,6 @@ data DownsweepEnv = DownsweepEnv {
    405 485 
         , _downsweep_excl_mods :: [ModuleName]
    406 486 
     }
    407 487
    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 488 
     mkModSummaryCache :: [(ModSummary, SummProvenance)] -> ModSummaryCacheMap
    432 489 
     mkModSummaryCache summs = foldl' (flip (uncurry addModSummaryCache)) M.empty summs
    433 490
    ... ... @@ -460,17 +517,19 @@ mkRootMap summaries = Map.fromList
    460 517 
     runDownsweepM :: DownsweepEnv -> DownsweepM a -> IO a
    461 518 
     runDownsweepM env act = runReaderT act env
    462 519
    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))
    520 
    +loopDownsweepNodes  :: M.Map NodeKey (NodeRes ModuleGraphNode) -> [DownsweepNode]               -> DownsweepM (M.Map NodeKey (NodeRes ModuleGraphNode))
    521 
    +loopModuleNodeInfos :: M.Map NodeKey (NodeRes ModuleGraphNode) -> [ModuleNodeInfo]              -> DownsweepM (M.Map NodeKey (NodeRes ModuleGraphNode))
    522 
    +loopUnits           :: M.Map NodeKey (NodeRes ModuleGraphNode) -> UnitId -> [UnitId]            -> DownsweepM (M.Map NodeKey (NodeRes ModuleGraphNode))
    523 
    +loopInstantiations  :: M.Map NodeKey (NodeRes ModuleGraphNode) -> [(UnitId, InstantiatedUnit)]  -> DownsweepM (M.Map NodeKey (NodeRes ModuleGraphNode))
    524 
    +loopFromInteractive :: M.Map NodeKey (NodeRes ModuleGraphNode) -> Module -> [InteractiveImport] -> DownsweepM (M.Map NodeKey (NodeRes ModuleGraphNode))
    468 525 
     loopDownsweepNodes  base_map nodes = dfsBuild (Just base_map) nodes dsNodeInfoKey dsNodeExpand
    469 526 
     loopModuleNodeInfos base_map       = loopDownsweepNodes base_map . map DSMod
    470 527 
     loopUnits           base_map homud = loopDownsweepNodes base_map . map (DSUnit homud)
    471 528 
     loopInstantiations  base_map       = loopDownsweepNodes base_map . map (uncurry DSInst)
    472 529 
     loopFromInteractive base_map m     = loopDownsweepNodes base_map . (:[]) . DSInteractive m
    473 530
    531 
    +--------------------------------------------------------------------------------
    532 
    +-- * Expanding 'DownsweepNode's into payload and node dependencies
    474 533 
     --------------------------------------------------------------------------------
    475 534
    476 535 
     -- | A 'DownsweepNode' is the basic block of the downsweep algorithm which
    ... ... @@ -516,7 +575,7 @@ dsNodeInfoKey = \case
    516 575 
       DSInst{instantiated_ud}       -> NodeKey_Unit instantiated_ud
    517 576 
       DSInteractive mod _imps       -> NodeKey_Module $ moduleToMnk mod NotBoot
    518 577
    519 
    -dsNodeExpand :: DownsweepNode -> DownsweepM (MGRes (ModuleGraphNode, [DownsweepNode]))
    578 
    +dsNodeExpand :: DownsweepNode -> DownsweepM (NodeRes (ModuleGraphNode, [DownsweepNode]))
    520 579 
     dsNodeExpand = \case
    521 580 
       DSMod (ModuleNodeCompile ms)         -> expandModuleSummary ms
    522 581 
       DSMod (ModuleNodeFixed key loc)      -> expandFixedModuleNode key loc
    ... ... @@ -525,12 +584,29 @@ dsNodeExpand = \case
    525 584 
             , home_context_uid }           -> expandInstantiatedUnit instantiated_ud home_context_uid
    526 585 
       DSInteractive imod iis               -> expandInteractiveImports imod iis
    527 586
    528 
    -expandModuleSummary :: ModSummary -> DownsweepM (MGRes (ModuleGraphNode, [DownsweepNode]))
    587 
    +expandModuleSummary :: ModSummary -> DownsweepM (NodeRes (ModuleGraphNode, [DownsweepNode]))
    529 588 
     expandModuleSummary ms = do -- Didn't work out what the imports mean yet, now do that.
    530 589 
         hsc_env <- asks downsweep_hsc_env
    531 590 
         let home_uid  = ms_unitid ms
    532 591 
             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
    592 
    +    (final_deps, todo) <- unzip <$> mapM (expandModImport home_uid home_unit) (calcDeps ms)
    593 
    +
    594 
    +    -- This has the effect of finding a .hs file if we are looking at the .hs-boot file.
    595 
    +    boot_todo <-
    596 
    +      if | HsBootFile <- ms_hsc_src ms
    597 
    +         -> do
    598 
    +            r <- downsweepSummarise home_unit NotBoot (noLoc $ ms_mod_name ms) NoPkgQual Nothing
    599 
    +            case r of
    600 
    +              FoundHome s -> pure [DSMod s]
    601 
    +              _           -> pure []
    602 
    +         | otherwise      -> pure []
    603 
    +
    604 
    +    return $ NSuccess
    605 
    +      ( ModuleNode (catMaybes final_deps) (ModuleNodeCompile ms)
    606 
    +      , boot_todo ++ concat todo
    607 
    +      )
    608 
    +  where
    609 
    +    expandModImport home_uid home_unit (imp,mb_pkg,gwib) = do
    534 610 
           let GWIB { gwib_mod = L loc mod, gwib_isBoot = is_boot } = gwib
    535 611 
               wanted_mod = L loc mod
    536 612 
           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
    552 628 
               ( Just $ mkModuleEdge imp (NodeKey_Module (mnKey s))
    553 629 
               , [DSMod s] )
    554 630
    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 
    -      )
    631 
    +    calcDeps :: ModSummary -> [(ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))]
    632 
    +    calcDeps ms =
    633 
    +      -- Add a dependency on the HsBoot file if it exists
    634 
    +      -- This gets passed to the loopImports function which just ignores it if it
    635 
    +      -- can't be found.
    636 
    +      [(NormalLevel, NoPkgQual, GWIB (noLoc $ ms_mod_name ms) IsBoot) | NotBoot <- [isBootSummary ms] ] ++
    637 
    +      [(lvl, b, c) | (lvl, b, c) <- msDeps ms ]
    569 638
    570 639 
     -- | Expand a 'ModuleNodeFixed' node
    571 640 
     -- NB: If you ever reach a Fixed node, everything under that also must be fixed.
    572 
    -expandFixedModuleNode :: ModNodeKeyWithUid -> ModLocation -> DownsweepM (MGRes (ModuleGraphNode, [DownsweepNode]))
    641 
    +expandFixedModuleNode :: ModNodeKeyWithUid -> ModLocation -> DownsweepM (NodeRes (ModuleGraphNode, [DownsweepNode]))
    573 642 
     expandFixedModuleNode key loc = do
    574 643 
         hsc_env <- asks downsweep_hsc_env
    575 644 
         -- MP: TODO, we should just read the dependency info from the interface rather than either
    ... ... @@ -603,7 +672,7 @@ expandFixedModuleNode key loc = do
    603 672 
               pure $ Just $ DSMod (ModuleNodeFixed key loc)
    604 673 
             _otherwise ->
    605 674 
               -- If the finder fails, just keep going, there will be another
    606 
    -          -- error later.
    675 
    +          -- error later when we try to expand this dependency.
    607 676 
               pure Nothing
    608 677 
         mk_dep _ (Right uid_dep) = do
    609 678 
           -- Set active unit so that looking loopUnit finds the correct
    ... ... @@ -611,9 +680,22 @@ expandFixedModuleNode key loc = do
    611 680 
           let home_uid = mnkUnitId key
    612 681 
           pure (Just DSUnit{node_uid=uid_dep, home_context_uid=home_uid})
    613 682
    683 
    +    mkFixedEdge :: Either (ImportLevel, ModNodeKeyWithUid) (ImportLevel, UnitId) -> ModuleNodeEdge
    684 
    +    mkFixedEdge (Left (lvl, key))  = mkModuleEdge lvl (NodeKey_Module key)
    685 
    +    mkFixedEdge (Right (lvl, uid)) = mkModuleEdge lvl (NodeKey_ExternalUnit uid)
    686 
    +
    687 
    +    ifaceDeps :: Dependencies -> [Either (ImportLevel, ModNodeKeyWithUid) (ImportLevel, UnitId)]
    688 
    +    ifaceDeps deps =
    689 
    +      [ Left (tcImportLevel lvl, ModNodeKeyWithUid dep uid)
    690 
    +      | (lvl, uid, dep) <- Set.toList (dep_direct_mods deps)
    691 
    +      ] ++
    692 
    +      [ Right (tcImportLevel lvl, uid)
    693 
    +      | (lvl, uid) <- Set.toList (dep_direct_pkgs deps)
    694 
    +      ]
    695 
    +
    614 696 
     -- | Expand a unit id under the context of a certain home unit
    615 697 
     expandUnitNode :: UnitId {-^ @node_uid@ -} -> UnitId {-^ Home unit from where @node_uid@ was introduced -}
    616 
    -               -> DownsweepM (MGRes (ModuleGraphNode, [DownsweepNode]))
    698 
    +               -> DownsweepM (NodeRes (ModuleGraphNode, [DownsweepNode]))
    617 699 
     expandUnitNode node_uid home_context_uid = do
    618 700 
         -- Set active unit so that looking loopUnit finds the correct
    619 701 
         -- -package flags in the unit state.
    ... ... @@ -623,12 +705,12 @@ expandUnitNode node_uid home_context_uid = do
    623 705 
           Just us -> pure $ NSuccess ((UnitNode us node_uid), map (\u -> DSUnit{node_uid=u, home_context_uid{-inherit-}}) us)
    624 706 
           Nothing -> pprPanic "loopUnit" (text "Malformed package database, missing " <+> ppr node_uid)
    625 707
    626 
    -expandInstantiatedUnit :: InstantiatedUnit -> UnitId {-^ Home unit -} -> DownsweepM (MGRes (ModuleGraphNode, [DownsweepNode]))
    708 
    +expandInstantiatedUnit :: InstantiatedUnit -> UnitId {-^ Home unit -} -> DownsweepM (NodeRes (ModuleGraphNode, [DownsweepNode]))
    627 709 
     expandInstantiatedUnit iud home_uid = pure $ NSuccess
    628 710 
       ( InstantiationNode home_uid iud
    629 711 
       , [DSUnit{node_uid=instUnitInstanceOf iud, home_context_uid=home_uid}] )
    630 712
    631 
    -expandInteractiveImports :: Module -> [InteractiveImport] -> DownsweepM (MGRes (ModuleGraphNode, [DownsweepNode]))
    713 
    +expandInteractiveImports :: Module -> [InteractiveImport] -> DownsweepM (NodeRes (ModuleGraphNode, [DownsweepNode]))
    632 714 
     expandInteractiveImports imod imps = do
    633 715 
       hsc_env    <- asks downsweep_hsc_env
    634 716 
       imps_cache <- asks downsweep_imports_cache
    ... ... @@ -686,19 +768,8 @@ expandInteractiveImports imod imps = do
    686 768 
         node_type = ModuleNodeFixed key ml
    687 769
    688 770 
     --------------------------------------------------------------------------------
    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 
    -  ]
    771 
    +-- * Constructing Module Summaries
    772 
    +--------------------------------------------------------------------------------
    702 773
    703 774 
     downsweepSummarise :: HomeUnit
    704 775 
                        -> IsBootInterface
    ... ... @@ -745,35 +816,6 @@ instantiationNodes uid unit_state = map (uid,) iuids_to_check
    745 816 
             , recur <- (indef :) $ goUnitId $ moduleUnit $ snd inst
    746 817 
             ]
    747 818
    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 819 
     getRootSummary ::
    778 820 
       [ModuleName] ->
    779 821 
       ModSummaryCache ->
    ... ... @@ -858,6 +900,10 @@ rootSummariesParallel n_jobs hsc_env diag_wrapper msg get_summary = do
    858 900 
                   throwIO e
    859 901 
                 a -> pure a
    860 902
    903 
    +--------------------------------------------------------------------------------
    904 
    +-- * Check/validate properties and error out
    905 
    +--------------------------------------------------------------------------------
    906 
    +
    861 907 
     -- | This function checks then important property that if both p and q are home units
    862 908 
     -- then any dependency of p, which transitively depends on q is also a home unit.
    863 909 
     --
    ... ... @@ -905,6 +951,10 @@ checkHomeUnitsClosed ue
    905 951 
                           let todo'' = (depends Set.\\ done) `Set.union` todo'
    906 952 
                           in DigraphNode uid uid (Set.toList depends) : go (Set.insert uid done) todo''
    907 953
    954 
    +--------------------------------------------------------------------------------
    955 
    +-- * Enable Code Gen for Template Haskell
    956 
    +--------------------------------------------------------------------------------
    957 
    +
    908 958 
     -- | Update the every ModSummary that is depended on
    909 959 
     -- by a module that needs template haskell. We enable codegen to
    910 960 
     -- the specified target, disable optimization and change the .hi
    ... ... @@ -1223,7 +1273,8 @@ Potential TODOS:
    1223 1273 
     -}
    1224 1274
    1225 1275 
     -----------------------------------------------------------------------------
    1226 
    --- Summarising modules
    1276 
    +-- * Pre-processing and Summarising and modules
    1277 
    +-----------------------------------------------------------------------------
    1227 1278
    1228 1279 
     -- We have two types of summarisation:
    1229 1280 
     --
    ... ... @@ -1639,9 +1690,11 @@ getPreprocessedImports hsc_env src_fn mb_phase maybe_buf = do
    1639 1690 
       return PreprocessedImports {..}
    1640 1691
    1641 1692 
     --------------------------------------------------------------------------------
    1693 
    +-- * Generic traversal of iteratively-built graph: dfsBuild
    1694 
    +--------------------------------------------------------------------------------
    1642 1695
    1643 1696 
     -- | The result of expanding a node in 'dfsBuild'.
    1644 
    -data MGRes v
    1697 
    +data NodeRes v
    1645 1698 
       -- | Computed the node payload successfully
    1646 1699 
       = NSuccess v
    1647 1700 
       -- | Skip a node! This means this node doesn't produce a payload and we can
    ... ... @@ -1657,8 +1710,8 @@ data MGRes v
    1657 1710 
     -- graph by iteratively expanding a node into a payload and a list of children
    1658 1711 
     -- nodes to visit next.
    1659 1712 
     --
    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.
    1713 
    +-- A node is NEVER visited/expanded more than once, as long as the node key
    1714 
    +-- @k@, computed from the node @n@, uniquely identifies that node.
    1662 1715 
     --
    1663 1716 
     -- The first argument @base_map@ is the starting set of already visited nodes
    1664 1717 
     -- (these nodes won't be expanded again!).
    ... ... @@ -1678,17 +1731,17 @@ data MGRes v
    1678 1731 
     --
    1679 1732 
     -- See also Note [Downsweep Control Flow and Caching]
    1680 1733 
     dfsBuild :: (Ord k, Monad m)
    1681 
    -         => Maybe (Map.Map k (MGRes v))
    1734 
    +         => Maybe (Map.Map k (NodeRes v))
    1682 1735 
              -- ^ Base map, existing results. We won't re-expand any of the nodes
    1683 1736 
              -- already present in this map.
    1684 1737 
              -> [n]
    1685 1738 
              -- ^ The root nodes from where to start traversal
    1686 1739 
              -> (n -> k)
    1687 1740 
              -- ^ Compute the key which uniquely identifies this node
    1688 
    -         -> (n -> m (MGRes (v,[n])))
    1741 
    +         -> (n -> m (NodeRes (v,[n])))
    1689 1742 
              -- ^ Expand this node into its payload result and into the list of
    1690 1743 
              -- children nodes to visit next.
    1691 
    -         -> m (Map.Map k (MGRes v))
    1744 
    +         -> m (Map.Map k (NodeRes v))
    1692 1745 
              -- ^ The result accumulates the payload of expanding the root nodes
    1693 1746 
              -- and all nodes transitively reachable from those roots.
    1694 1747 
     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)
    1704 1757 
                    go ss
    1705 1758 
                       (Map.insert k NSkip        visited) -- Skip!
    1706 1759 
                  NSuccess (v,ns) ->
    1707 
    -               go (ns ++ ss {- todo: not use ++ here? -})
    1760 
    +               go (ns ++ ss)
    1708 1761 
                       (Map.insert k (NSuccess v) visited)
    1709 1762 
           where
    1710 1763 
             k = key s

    • —
    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/25ec3570556d915af9e5c1c97daa25ce2e2340f8 at 1784301717