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