    {-# LANGUAGE NondecreasingIndentation #-}

    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE DerivingStrategies #-}
    {-# LANGUAGE ApplicativeDo #-}
    {-# LANGUAGE MultiWayIf #-}
    {-# LANGUAGE RecordWildCards #-}

    -- -----------------------------------------------------------------------------
    --
    -- (c) The University of Glasgow, 2011
    --
    -- This module implements multi-module compilation, and is used
    -- by --make and GHCi.
    --
    -- -----------------------------------------------------------------------------
    module GHC.Driver.Make (
            depanal, depanalE, depanalPartial, checkHomeUnitsClosed,
            load, loadWithCache, load', AnyGhcDiagnostic, LoadHowMuch(..), ModIfaceCache(..), noIfaceCache, newIfaceCache,
            instantiationNodes,

            downsweep,

            topSortModuleGraph,

            ms_home_srcimps, ms_home_imps,

            summariseModule,
            SummariseResult(..),
            summariseFile,
            hscSourceToIsBoot,
            findExtraSigImports,
            implicitRequirementsShallow,

            noModError, cyclicModuleErr,
            SummaryNode,
            IsBootInterface(..), mkNodeKey,

            ModNodeKey, ModNodeKeyWithUid(..),
            ModNodeMap(..), emptyModNodeMap, modNodeMapElems, modNodeMapLookup, modNodeMapInsert, modNodeMapSingleton, modNodeMapUnionWith
            ) where

    import GHC.Prelude
    import GHC.Platform

    import GHC.Tc.Utils.Backpack
    import GHC.Tc.Utils.Monad  ( initIfaceCheck, concatMapM )

    import GHC.Runtime.Interpreter
    import qualified GHC.Linker.Loader as Linker
    import GHC.Linker.Types

    import GHC.Platform.Ways

    import GHC.Driver.Config.Finder (initFinderOpts)
    import GHC.Driver.Config.Parser (initParserOpts)
    import GHC.Driver.Config.Diagnostic
    import GHC.Driver.Phases
    import GHC.Driver.Pipeline
    import GHC.Driver.Session
    import GHC.Driver.Backend
    import GHC.Driver.Monad
    import GHC.Driver.Env
    import GHC.Driver.Errors
    import GHC.Driver.Errors.Types
    import GHC.Driver.Main
    import GHC.Driver.MakeSem

    import GHC.Parser.Header

    import GHC.Iface.Load      ( cannotFindModule )
    import GHC.IfaceToCore     ( typecheckIface )
    import GHC.Iface.Recomp    ( RecompileRequired(..), CompileReason(..) )

    import GHC.Data.Bag        ( listToBag )
    import GHC.Data.Graph.Directed
    import GHC.Data.FastString
    import GHC.Data.Maybe      ( expectJust )
    import GHC.Data.StringBuffer
    import qualified GHC.LanguageExtensions as LangExt

    import GHC.Utils.Exception ( throwIO, SomeAsyncException )
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Utils.Misc
    import GHC.Utils.Error
    import GHC.Utils.Logger
    import GHC.Utils.Fingerprint
    import GHC.Utils.TmpFs

    import GHC.Types.Basic
    import GHC.Types.Error
    import GHC.Types.Target
    import GHC.Types.SourceFile
    import GHC.Types.SourceError
    import GHC.Types.SrcLoc
    import GHC.Types.Unique.Map
    import GHC.Types.PkgQual

    import GHC.Unit
    import GHC.Unit.Env
    import GHC.Unit.Finder
    import GHC.Unit.Module.ModSummary
    import GHC.Unit.Module.ModIface
    import GHC.Unit.Module.Graph
    import GHC.Unit.Home.ModInfo
    import GHC.Unit.Module.ModDetails

    import Data.Either ( rights, partitionEithers, lefts )
    import qualified Data.Map as Map
    import qualified Data.Set as Set

    import Control.Concurrent ( newQSem, waitQSem, signalQSem, ThreadId, killThread, forkIOWithUnmask )
    import qualified GHC.Conc as CC
    import Control.Concurrent.MVar
    import Control.Monad
    import Control.Monad.Trans.Except ( ExceptT(..), runExceptT, throwE )
    import qualified Control.Monad.Catch as MC
    import Data.IORef
    import Data.Maybe
    import Data.Time
    import Data.List (sortOn)
    import Data.Bifunctor (first)
    import System.Directory
    import System.FilePath
    import System.IO        ( fixIO )

    import GHC.Conc ( getNumProcessors, getNumCapabilities, setNumCapabilities )
    import Control.Monad.IO.Class
    import Control.Monad.Trans.Reader
    import GHC.Driver.Pipeline.LogQueue
    import qualified Data.Map.Strict as M
    import GHC.Types.TypeEnv
    import Control.Monad.Trans.State.Lazy
    import Control.Monad.Trans.Class
    import GHC.Driver.Env.KnotVars
    import Control.Concurrent.STM
    import Control.Monad.Trans.Maybe
    import GHC.Runtime.Loader
    import GHC.Rename.Names
    import GHC.Utils.Constants
    import GHC.Types.Unique.DFM (udfmRestrictKeysSet)
    import GHC.Types.Unique
    import GHC.Iface.Errors.Types

    import qualified GHC.Data.Word64Set as W

    -- -----------------------------------------------------------------------------
    -- Loading the program

    -- | Perform a dependency analysis starting from the current targets
    -- and update the session with the new module graph.
    --
    -- Dependency analysis entails parsing the @import@ directives and may
    -- therefore require running certain preprocessors.
    --
    -- Note that each 'ModSummary' in the module graph caches its 'DynFlags'.
    -- These 'DynFlags' are determined by the /current/ session 'DynFlags' and the
    -- @OPTIONS@ and @LANGUAGE@ pragmas of the parsed module.  Thus if you want
    -- changes to the 'DynFlags' to take effect you need to call this function
    -- again.
    -- In case of errors, just throw them.
    --
    depanal :: GhcMonad m =>
               [ModuleName]  -- ^ excluded modules
            -> Bool          -- ^ allow duplicate roots
            -> m ModuleGraph
    depanal :: forall (m :: * -> *).
    GhcMonad m =>
    [ModuleName] -> Bool -> m ModuleGraph
    depanal [ModuleName]
    excluded_mods Bool
    allow_dup_roots = do
        (DriverMessages
    errs, ModuleGraph
    mod_graph) <- [ModuleName] -> Bool -> m (DriverMessages, ModuleGraph)
    forall (m :: * -> *).
    GhcMonad m =>
    [ModuleName] -> Bool -> m (DriverMessages, ModuleGraph)
    depanalE [ModuleName]
    excluded_mods Bool
    allow_dup_roots
        if DriverMessages -> Bool
    forall e. Messages e -> Bool
    isEmptyMessages DriverMessages
    errs
          then ModuleGraph -> m ModuleGraph
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ModuleGraph
    mod_graph
          else Messages GhcMessage -> m ModuleGraph
    forall (io :: * -> *) a. MonadIO io => Messages GhcMessage -> io a
    throwErrors ((DriverMessage -> GhcMessage)
    -> DriverMessages -> Messages GhcMessage
    forall a b. (a -> b) -> Messages a -> Messages b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DriverMessage -> GhcMessage
    GhcDriverMessage DriverMessages
    errs)

    -- | Perform dependency analysis like in 'depanal'.
    -- In case of errors, the errors and an empty module graph are returned.
    depanalE :: GhcMonad m =>     -- New for #17459
                [ModuleName]      -- ^ excluded modules
                -> Bool           -- ^ allow duplicate roots
                -> m (DriverMessages, ModuleGraph)
    depanalE :: forall (m :: * -> *).
    GhcMonad m =>
    [ModuleName] -> Bool -> m (DriverMessages, ModuleGraph)
    depanalE [ModuleName]
    excluded_mods Bool
    allow_dup_roots = do
        HscEnv
    hsc_env <- m HscEnv
    forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
        (DriverMessages
    errs, ModuleGraph
    mod_graph) <- [ModuleName] -> Bool -> m (DriverMessages, ModuleGraph)
    forall (m :: * -> *).
    GhcMonad m =>
    [ModuleName] -> Bool -> m (DriverMessages, ModuleGraph)
    depanalPartial [ModuleName]
    excluded_mods Bool
    allow_dup_roots
        if DriverMessages -> Bool
    forall e. Messages e -> Bool
    isEmptyMessages DriverMessages
    errs
          then do
            HscEnv
    hsc_env <- m HscEnv
    forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
            let one_unit_messages :: IO DriverMessages -> UnitId -> HomeUnitEnv -> IO DriverMessages
    one_unit_messages IO DriverMessages
    get_mod_errs UnitId
    k HomeUnitEnv
    hue = do
                  DriverMessages
    errs <- IO DriverMessages
    get_mod_errs
                  DriverMessages
    unknown_module_err <- HscEnv -> DynFlags -> ModuleGraph -> IO DriverMessages
    warnUnknownModules (HasDebugCallStack => UnitId -> HscEnv -> HscEnv
    UnitId -> HscEnv -> HscEnv
    hscSetActiveUnitId UnitId
    k HscEnv
    hsc_env) (HomeUnitEnv -> DynFlags
    homeUnitEnv_dflags HomeUnitEnv
    hue) ModuleGraph
    mod_graph

                  let unused_home_mod_err :: DriverMessages
    unused_home_mod_err = DynFlags -> [Target] -> ModuleGraph -> DriverMessages
    warnMissingHomeModules (HomeUnitEnv -> DynFlags
    homeUnitEnv_dflags HomeUnitEnv
    hue) (HscEnv -> [Target]
    hsc_targets HscEnv
    hsc_env) ModuleGraph
    mod_graph
                      unused_pkg_err :: DriverMessages
    unused_pkg_err = UnitState -> DynFlags -> ModuleGraph -> DriverMessages
    warnUnusedPackages (HomeUnitEnv -> UnitState
    homeUnitEnv_units HomeUnitEnv
    hue) (HomeUnitEnv -> DynFlags
    homeUnitEnv_dflags HomeUnitEnv
    hue) ModuleGraph
    mod_graph

                  return $ DriverMessages
    errs DriverMessages -> DriverMessages -> DriverMessages
    forall e. Messages e -> Messages e -> Messages e
    `unionMessages` DriverMessages
    unused_home_mod_err
                              DriverMessages -> DriverMessages -> DriverMessages
    forall e. Messages e -> Messages e -> Messages e
    `unionMessages` DriverMessages
    unused_pkg_err
                              DriverMessages -> DriverMessages -> DriverMessages
    forall e. Messages e -> Messages e -> Messages e
    `unionMessages` DriverMessages
    unknown_module_err

            DriverMessages
    all_errs <- IO DriverMessages -> m DriverMessages
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO DriverMessages -> m DriverMessages)
    -> IO DriverMessages -> m DriverMessages
    forall a b. (a -> b) -> a -> b
    $ (IO DriverMessages -> UnitId -> HomeUnitEnv -> IO DriverMessages)
    -> IO DriverMessages
    -> UnitEnvGraph HomeUnitEnv
    -> IO DriverMessages
    forall b a. (b -> UnitId -> a -> b) -> b -> UnitEnvGraph a -> b
    unitEnv_foldWithKey IO DriverMessages -> UnitId -> HomeUnitEnv -> IO DriverMessages
    one_unit_messages (DriverMessages -> IO DriverMessages
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return DriverMessages
    forall e. Messages e
    emptyMessages) (HscEnv -> UnitEnvGraph HomeUnitEnv
    hsc_HUG HscEnv
    hsc_env)
            Messages GhcMessage -> m ()
    forall (m :: * -> *). GhcMonad m => Messages GhcMessage -> m ()
    logDiagnostics (DriverMessage -> GhcMessage
    GhcDriverMessage (DriverMessage -> GhcMessage)
    -> DriverMessages -> Messages GhcMessage
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> DriverMessages
    all_errs)
            HscEnv -> m ()
    forall (m :: * -> *). GhcMonad m => HscEnv -> m ()
    setSession HscEnv
    hsc_env { hsc_mod_graph = mod_graph }
            pure (DriverMessages
    forall e. Messages e
    emptyMessages, ModuleGraph
    mod_graph)
          else do
            -- We don't have a complete module dependency graph,
            -- The graph may be disconnected and is unusable.
            HscEnv -> m ()
    forall (m :: * -> *). GhcMonad m => HscEnv -> m ()
    setSession HscEnv
    hsc_env { hsc_mod_graph = emptyMG }
            pure (DriverMessages
    errs, ModuleGraph
    emptyMG)

    -- | Perform dependency analysis like 'depanal' but return a partial module
    -- graph even in the face of problems with some modules.
    --
    -- Modules which have parse errors in the module header, failing
    -- preprocessors or other issues preventing them from being summarised will
    -- simply be absent from the returned module graph.
    --
    -- Unlike 'depanal' this function will not update 'hsc_mod_graph' with the
    -- new module graph.
    depanalPartial
        :: GhcMonad m
        => [ModuleName]  -- ^ excluded modules
        -> Bool          -- ^ allow duplicate roots
        -> m (DriverMessages, ModuleGraph)
        -- ^ possibly empty 'Bag' of errors and a module graph.
    depanalPartial :: forall (m :: * -> *).
    GhcMonad m =>
    [ModuleName] -> Bool -> m (DriverMessages, ModuleGraph)
    depanalPartial [ModuleName]
    excluded_mods Bool
    allow_dup_roots = do
      HscEnv
    hsc_env <- m HscEnv
    forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
      let
             targets :: [Target]
    targets = HscEnv -> [Target]
    hsc_targets HscEnv
    hsc_env
             old_graph :: ModuleGraph
    old_graph = HscEnv -> ModuleGraph
    hsc_mod_graph HscEnv
    hsc_env
             logger :: Logger
    logger  = HscEnv -> Logger
    hsc_logger HscEnv
    hsc_env

      Logger
    -> SDoc
    -> ((DriverMessages, ModuleGraph) -> ())
    -> m (DriverMessages, ModuleGraph)
    -> m (DriverMessages, ModuleGraph)
    forall (m :: * -> *) a.
    MonadIO m =>
    Logger -> SDoc -> (a -> ()) -> m a -> m a
    withTiming Logger
    logger (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "Chasing dependencies") (() -> (DriverMessages, ModuleGraph) -> ()
    forall a b. a -> b -> a
    const ()) (m (DriverMessages, ModuleGraph)
     -> m (DriverMessages, ModuleGraph))
    -> m (DriverMessages, ModuleGraph)
    -> m (DriverMessages, ModuleGraph)
    forall a b. (a -> b) -> a -> b
    $ do
        IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ Logger -> Int -> SDoc -> IO ()
    debugTraceMsg Logger
    logger Int
    2 ([SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hcat [
                  FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "Chasing modules from: ",
                  [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hcat (SDoc -> [SDoc] -> [SDoc]
    forall doc. IsLine doc => doc -> [doc] -> [doc]
    punctuate SDoc
    forall doc. IsLine doc => doc
    comma ((Target -> SDoc) -> [Target] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map Target -> SDoc
    pprTarget [Target]
    targets))])

        -- Home package modules may have been moved or deleted, and new
        -- source files may have appeared in the home package that shadow
        -- external package modules, so we have to discard the existing
        -- cached finder data.
        IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ FinderCache -> UnitEnv -> IO ()
    flushFinderCaches (HscEnv -> FinderCache
    hsc_FC HscEnv
    hsc_env) (HscEnv -> UnitEnv
    hsc_unit_env HscEnv
    hsc_env)

        ([DriverMessages]
    errs, [ModuleGraphNode]
    graph_nodes) <- IO ([DriverMessages], [ModuleGraphNode])
    -> m ([DriverMessages], [ModuleGraphNode])
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ([DriverMessages], [ModuleGraphNode])
     -> m ([DriverMessages], [ModuleGraphNode]))
    -> IO ([DriverMessages], [ModuleGraphNode])
    -> m ([DriverMessages], [ModuleGraphNode])
    forall a b. (a -> b) -> a -> b
    $ HscEnv
    -> [ModSummary]
    -> [ModuleName]
    -> Bool
    -> IO ([DriverMessages], [ModuleGraphNode])
    downsweep
          HscEnv
    hsc_env (ModuleGraph -> [ModSummary]
    mgModSummaries ModuleGraph
    old_graph)
          [ModuleName]
    excluded_mods Bool
    allow_dup_roots
        let
          mod_graph :: ModuleGraph
    mod_graph = [ModuleGraphNode] -> ModuleGraph
    mkModuleGraph [ModuleGraphNode]
    graph_nodes
        return ([DriverMessages] -> DriverMessages
    forall (f :: * -> *) e. Foldable f => f (Messages e) -> Messages e
    unionManyMessages [DriverMessages]
    errs, ModuleGraph
    mod_graph)

    -- | Collect the instantiations of dependencies to create 'InstantiationNode' work graph nodes.
    -- These are used to represent the type checking that is done after
    -- all the free holes (sigs in current package) relevant to that instantiation
    -- are compiled. This is necessary to catch some instantiation errors.
    --
    -- In the future, perhaps more of the work of instantiation could be moved here,
    -- instead of shoved in with the module compilation nodes. That could simplify
    -- backpack, and maybe hs-boot too.
    instantiationNodes :: UnitId -> UnitState -> [ModuleGraphNode]
    instantiationNodes :: UnitId -> UnitState -> [ModuleGraphNode]
    instantiationNodes UnitId
    uid UnitState
    unit_state = UnitId -> InstantiatedUnit -> ModuleGraphNode
    InstantiationNode UnitId
    uid (InstantiatedUnit -> ModuleGraphNode)
    -> [InstantiatedUnit] -> [ModuleGraphNode]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [InstantiatedUnit]
    iuids_to_check
      where
        iuids_to_check :: [InstantiatedUnit]
        iuids_to_check :: [InstantiatedUnit]
    iuids_to_check =
          [InstantiatedUnit] -> [InstantiatedUnit]
    forall a. Ord a => [a] -> [a]
    nubSort ([InstantiatedUnit] -> [InstantiatedUnit])
    -> [InstantiatedUnit] -> [InstantiatedUnit]
    forall a b. (a -> b) -> a -> b
    $ ((GenUnit UnitId, Maybe PackageArg) -> [InstantiatedUnit])
    -> [(GenUnit UnitId, Maybe PackageArg)] -> [InstantiatedUnit]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (GenUnit UnitId -> [InstantiatedUnit]
    forall {unit}. GenUnit unit -> [GenInstantiatedUnit unit]
    goUnitId (GenUnit UnitId -> [InstantiatedUnit])
    -> ((GenUnit UnitId, Maybe PackageArg) -> GenUnit UnitId)
    -> (GenUnit UnitId, Maybe PackageArg)
    -> [InstantiatedUnit]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (GenUnit UnitId, Maybe PackageArg) -> GenUnit UnitId
    forall a b. (a, b) -> a
    fst) (UnitState -> [(GenUnit UnitId, Maybe PackageArg)]
    explicitUnits UnitState
    unit_state)
         where
          goUnitId :: GenUnit unit -> [GenInstantiatedUnit unit]
    goUnitId GenUnit unit
    uid =
            [ GenInstantiatedUnit unit
    recur
            | VirtUnit GenInstantiatedUnit unit
    indef <- [GenUnit unit
    uid]
            , (ModuleName, GenModule (GenUnit unit))
    inst <- GenInstantiatedUnit unit -> GenInstantiations unit
    forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
    instUnitInsts GenInstantiatedUnit unit
    indef
            , GenInstantiatedUnit unit
    recur <- (GenInstantiatedUnit unit
    indef GenInstantiatedUnit unit
    -> [GenInstantiatedUnit unit] -> [GenInstantiatedUnit unit]
    forall a. a -> [a] -> [a]
    :) ([GenInstantiatedUnit unit] -> [GenInstantiatedUnit unit])
    -> [GenInstantiatedUnit unit] -> [GenInstantiatedUnit unit]
    forall a b. (a -> b) -> a -> b
    $ GenUnit unit -> [GenInstantiatedUnit unit]
    goUnitId (GenUnit unit -> [GenInstantiatedUnit unit])
    -> GenUnit unit -> [GenInstantiatedUnit unit]
    forall a b. (a -> b) -> a -> b
    $ GenModule (GenUnit unit) -> GenUnit unit
    forall unit. GenModule unit -> unit
    moduleUnit (GenModule (GenUnit unit) -> GenUnit unit)
    -> GenModule (GenUnit unit) -> GenUnit unit
    forall a b. (a -> b) -> a -> b
    $ (ModuleName, GenModule (GenUnit unit)) -> GenModule (GenUnit unit)
    forall a b. (a, b) -> b
    snd (ModuleName, GenModule (GenUnit unit))
    inst
            ]

    -- The linking plan for each module. If we need to do linking for a home unit
    -- then this function returns a graph node which depends on all the modules in the home unit.

    -- At the moment nothing can depend on these LinkNodes.
    linkNodes :: [ModuleGraphNode] -> UnitId -> HomeUnitEnv -> Maybe (Either (Messages DriverMessage) ModuleGraphNode)
    linkNodes :: [ModuleGraphNode]
    -> UnitId
    -> HomeUnitEnv
    -> Maybe (Either DriverMessages ModuleGraphNode)
    linkNodes [ModuleGraphNode]
    summaries UnitId
    uid HomeUnitEnv
    hue =
      let dflags :: DynFlags
    dflags = HomeUnitEnv -> DynFlags
    homeUnitEnv_dflags HomeUnitEnv
    hue
          ofile :: Maybe FilePath
    ofile = DynFlags -> Maybe FilePath
    outputFile_ DynFlags
    dflags

          unit_nodes :: [NodeKey]
          unit_nodes :: [NodeKey]
    unit_nodes = (ModuleGraphNode -> NodeKey) -> [ModuleGraphNode] -> [NodeKey]
    forall a b. (a -> b) -> [a] -> [b]
    map ModuleGraphNode -> NodeKey
    mkNodeKey ((ModuleGraphNode -> Bool) -> [ModuleGraphNode] -> [ModuleGraphNode]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((UnitId -> UnitId -> Bool
    forall a. Eq a => a -> a -> Bool
    == UnitId
    uid) (UnitId -> Bool)
    -> (ModuleGraphNode -> UnitId) -> ModuleGraphNode -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModuleGraphNode -> UnitId
    moduleGraphNodeUnitId) [ModuleGraphNode]
    summaries)
      -- Issue a warning for the confusing case where the user
      -- said '-o foo' but we're not going to do any linking.
      -- We attempt linking if either (a) one of the modules is
      -- called Main, or (b) the user said -no-hs-main, indicating
      -- that main() is going to come from somewhere else.
      --
          no_hs_main :: Bool
    no_hs_main = GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_NoHsMain DynFlags
    dflags

          main_sum :: Bool
    main_sum = (NodeKey -> Bool) -> [NodeKey] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (NodeKey -> NodeKey -> Bool
    forall a. Eq a => a -> a -> Bool
    == ModNodeKeyWithUid -> NodeKey
    NodeKey_Module (ModuleNameWithIsBoot -> UnitId -> ModNodeKeyWithUid
    ModNodeKeyWithUid (ModuleName -> IsBootInterface -> ModuleNameWithIsBoot
    forall mod. mod -> IsBootInterface -> GenWithIsBoot mod
    GWIB (DynFlags -> ModuleName
    mainModuleNameIs DynFlags
    dflags) IsBootInterface
    NotBoot) UnitId
    uid)) [NodeKey]
    unit_nodes

          do_linking :: Bool
    do_linking =  Bool
    main_sum Bool -> Bool -> Bool
    || Bool
    no_hs_main Bool -> Bool -> Bool
    || DynFlags -> GhcLink
    ghcLink DynFlags
    dflags GhcLink -> GhcLink -> Bool
    forall a. Eq a => a -> a -> Bool
    == GhcLink
    LinkDynLib Bool -> Bool -> Bool
    || DynFlags -> GhcLink
    ghcLink DynFlags
    dflags GhcLink -> GhcLink -> Bool
    forall a. Eq a => a -> a -> Bool
    == GhcLink
    LinkStaticLib

      in if | DynFlags -> GhcLink
    ghcLink DynFlags
    dflags GhcLink -> GhcLink -> Bool
    forall a. Eq a => a -> a -> Bool
    == GhcLink
    LinkBinary Bool -> Bool -> Bool
    && Maybe FilePath -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe FilePath
    ofile Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    do_linking ->
                Either DriverMessages ModuleGraphNode
    -> Maybe (Either DriverMessages ModuleGraphNode)
    forall a. a -> Maybe a
    Just (DriverMessages -> Either DriverMessages ModuleGraphNode
    forall a b. a -> Either a b
    Left (DriverMessages -> Either DriverMessages ModuleGraphNode)
    -> DriverMessages -> Either DriverMessages ModuleGraphNode
    forall a b. (a -> b) -> a -> b
    $ MsgEnvelope DriverMessage -> DriverMessages
    forall e. MsgEnvelope e -> Messages e
    singleMessage (MsgEnvelope DriverMessage -> DriverMessages)
    -> MsgEnvelope DriverMessage -> DriverMessages
    forall a b. (a -> b) -> a -> b
    $ SrcSpan -> DriverMessage -> MsgEnvelope DriverMessage
    forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
    mkPlainErrorMsgEnvelope SrcSpan
    noSrcSpan (ModuleName -> DriverMessage
    DriverRedirectedNoMain (ModuleName -> DriverMessage) -> ModuleName -> DriverMessage
    forall a b. (a -> b) -> a -> b
    $ DynFlags -> ModuleName
    mainModuleNameIs DynFlags
    dflags))
            -- This should be an error, not a warning (#10895).
            | DynFlags -> GhcLink
    ghcLink DynFlags
    dflags GhcLink -> GhcLink -> Bool
    forall a. Eq a => a -> a -> Bool
    /= GhcLink
    NoLink, Bool
    do_linking -> Either DriverMessages ModuleGraphNode
    -> Maybe (Either DriverMessages ModuleGraphNode)
    forall a. a -> Maybe a
    Just (ModuleGraphNode -> Either DriverMessages ModuleGraphNode
    forall a b. b -> Either a b
    Right ([NodeKey] -> UnitId -> ModuleGraphNode
    LinkNode [NodeKey]
    unit_nodes UnitId
    uid))
            | Bool
    otherwise  -> Maybe (Either DriverMessages ModuleGraphNode)
    forall a. Maybe a
    Nothing

    -- Note [Missing home modules]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -- Sometimes user doesn't want GHC to pick up modules, not explicitly listed
    -- in a command line. For example, cabal may want to enable this warning
    -- when building a library, so that GHC warns user about modules, not listed
    -- neither in `exposed-modules`, nor in `other-modules`.
    --
    -- Here "home module" means a module, that doesn't come from an other package.
    --
    -- For example, if GHC is invoked with modules "A" and "B" as targets,
    -- but "A" imports some other module "C", then GHC will issue a warning
    -- about module "C" not being listed in a command line.
    --
    -- The warning in enabled by `-Wmissing-home-modules`. See #13129
    warnMissingHomeModules ::  DynFlags -> [Target] -> ModuleGraph -> DriverMessages
    warnMissingHomeModules :: DynFlags -> [Target] -> ModuleGraph -> DriverMessages
    warnMissingHomeModules DynFlags
    dflags [Target]
    targets ModuleGraph
    mod_graph =
        if [ModuleName] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ModuleName]
    missing
          then DriverMessages
    forall e. Messages e
    emptyMessages
          else DriverMessages
    warn
      where
        diag_opts :: DiagOpts
    diag_opts = DynFlags -> DiagOpts
    initDiagOpts DynFlags
    dflags

        is_known_module :: ModSummary -> Bool
    is_known_module ModSummary
    mod = (Target -> Bool) -> [Target] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (ModSummary -> Target -> Bool
    is_my_target ModSummary
    mod) [Target]
    targets

        -- We need to be careful to handle the case where (possibly
        -- path-qualified) filenames (aka 'TargetFile') rather than module
        -- names are being passed on the GHC command-line.
        --
        -- For instance, `ghc --make src-exe/Main.hs` and
        -- `ghc --make -isrc-exe Main` are supposed to be equivalent.
        -- Note also that we can't always infer the associated module name
        -- directly from the filename argument.  See #13727.
        is_my_target :: ModSummary -> Target -> Bool
    is_my_target ModSummary
    mod Target
    target =
          let tuid :: UnitId
    tuid = Target -> UnitId
    targetUnitId Target
    target
          in case Target -> TargetId
    targetId Target
    target of
              TargetModule ModuleName
    name
                -> Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName (ModSummary -> Module
    ms_mod ModSummary
    mod) ModuleName -> ModuleName -> Bool
    forall a. Eq a => a -> a -> Bool
    == ModuleName
    name
                    Bool -> Bool -> Bool
    && UnitId
    tuid UnitId -> UnitId -> Bool
    forall a. Eq a => a -> a -> Bool
    == ModSummary -> UnitId
    ms_unitid ModSummary
    mod
              TargetFile FilePath
    target_file Maybe Phase
    _
                | Just FilePath
    mod_file <- ModLocation -> Maybe FilePath
    ml_hs_file (ModSummary -> ModLocation
    ms_location ModSummary
    mod)
                ->
                 DynFlags -> FilePath -> FilePath
    augmentByWorkingDirectory DynFlags
    dflags FilePath
    target_file FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == FilePath
    mod_file Bool -> Bool -> Bool
    ||

                 --  Don't warn on B.hs-boot if B.hs is specified (#16551)
                 FilePath -> FilePath
    addBootSuffix FilePath
    target_file FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == FilePath
    mod_file Bool -> Bool -> Bool
    ||

                 --  We can get a file target even if a module name was
                 --  originally specified in a command line because it can
                 --  be converted in guessTarget (by appending .hs/.lhs).
                 --  So let's convert it back and compare with module name
                 FilePath -> ModuleName
    mkModuleName ((FilePath, FilePath) -> FilePath
    forall a b. (a, b) -> a
    fst ((FilePath, FilePath) -> FilePath)
    -> (FilePath, FilePath) -> FilePath
    forall a b. (a -> b) -> a -> b
    $ FilePath -> (FilePath, FilePath)
    splitExtension FilePath
    target_file)
                  ModuleName -> ModuleName -> Bool
    forall a. Eq a => a -> a -> Bool
    == Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName (ModSummary -> Module
    ms_mod ModSummary
    mod)
              TargetId
    _ -> Bool
    False

        missing :: [ModuleName]
    missing = (ModSummary -> ModuleName) -> [ModSummary] -> [ModuleName]
    forall a b. (a -> b) -> [a] -> [b]
    map (Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName (Module -> ModuleName)
    -> (ModSummary -> Module) -> ModSummary -> ModuleName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModSummary -> Module
    ms_mod) ([ModSummary] -> [ModuleName]) -> [ModSummary] -> [ModuleName]
    forall a b. (a -> b) -> a -> b
    $
          (ModSummary -> Bool) -> [ModSummary] -> [ModSummary]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (ModSummary -> Bool) -> ModSummary -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModSummary -> Bool
    is_known_module) ([ModSummary] -> [ModSummary]) -> [ModSummary] -> [ModSummary]
    forall a b. (a -> b) -> a -> b
    $
            ((ModSummary -> Bool) -> [ModSummary] -> [ModSummary]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\ModSummary
    ms -> ModSummary -> UnitId
    ms_unitid ModSummary
    ms UnitId -> UnitId -> Bool
    forall a. Eq a => a -> a -> Bool
    == DynFlags -> UnitId
    homeUnitId_ DynFlags
    dflags)
                    (ModuleGraph -> [ModSummary]
    mgModSummaries ModuleGraph
    mod_graph))

        warn :: DriverMessages
    warn = MsgEnvelope DriverMessage -> DriverMessages
    forall e. MsgEnvelope e -> Messages e
    singleMessage (MsgEnvelope DriverMessage -> DriverMessages)
    -> MsgEnvelope DriverMessage -> DriverMessages
    forall a b. (a -> b) -> a -> b
    $ DiagOpts -> SrcSpan -> DriverMessage -> MsgEnvelope DriverMessage
    forall e. Diagnostic e => DiagOpts -> SrcSpan -> e -> MsgEnvelope e
    mkPlainMsgEnvelope DiagOpts
    diag_opts SrcSpan
    noSrcSpan
                             (DriverMessage -> MsgEnvelope DriverMessage)
    -> DriverMessage -> MsgEnvelope DriverMessage
    forall a b. (a -> b) -> a -> b
    $ UnitId -> [ModuleName] -> BuildingCabalPackage -> DriverMessage
    DriverMissingHomeModules (DynFlags -> UnitId
    homeUnitId_ DynFlags
    dflags) [ModuleName]
    missing (DynFlags -> BuildingCabalPackage
    checkBuildingCabalPackage DynFlags
    dflags)

    -- Check that any modules we want to reexport or hide are actually in the package.
    warnUnknownModules :: HscEnv -> DynFlags -> ModuleGraph -> IO DriverMessages
    warnUnknownModules :: HscEnv -> DynFlags -> ModuleGraph -> IO DriverMessages
    warnUnknownModules HscEnv
    hsc_env DynFlags
    dflags ModuleGraph
    mod_graph = do
      [ModuleName]
    reexported_warns <- (ModuleName -> IO Bool) -> [ModuleName] -> IO [ModuleName]
    forall (m :: * -> *) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM ModuleName -> IO Bool
    check_reexport (Set ModuleName -> [ModuleName]
    forall a. Set a -> [a]
    Set.toList Set ModuleName
    reexported_mods)
      return $ Set ModuleName -> [ModuleName] -> DriverMessages
    final_msgs Set ModuleName
    hidden_warns [ModuleName]
    reexported_warns
      where
        diag_opts :: DiagOpts
    diag_opts = DynFlags -> DiagOpts
    initDiagOpts DynFlags
    dflags

        unit_mods :: Set ModuleName
    unit_mods = [ModuleName] -> Set ModuleName
    forall a. Ord a => [a] -> Set a
    Set.fromList ((ModSummary -> ModuleName) -> [ModSummary] -> [ModuleName]
    forall a b. (a -> b) -> [a] -> [b]
    map ModSummary -> ModuleName
    ms_mod_name
                      ((ModSummary -> Bool) -> [ModSummary] -> [ModSummary]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\ModSummary
    ms -> ModSummary -> UnitId
    ms_unitid ModSummary
    ms UnitId -> UnitId -> Bool
    forall a. Eq a => a -> a -> Bool
    == DynFlags -> UnitId
    homeUnitId_ DynFlags
    dflags)
                           (ModuleGraph -> [ModSummary]
    mgModSummaries ModuleGraph
    mod_graph)))

        reexported_mods :: Set ModuleName
    reexported_mods = DynFlags -> Set ModuleName
    reexportedModules DynFlags
    dflags
        hidden_mods :: Set ModuleName
    hidden_mods     = DynFlags -> Set ModuleName
    hiddenModules DynFlags
    dflags

        hidden_warns :: Set ModuleName
    hidden_warns = Set ModuleName
    hidden_mods Set ModuleName -> Set ModuleName -> Set ModuleName
    forall a. Ord a => Set a -> Set a -> Set a
    `Set.difference` Set ModuleName
    unit_mods

        lookupModule :: ModuleName -> IO FindResult
    lookupModule ModuleName
    mn = HscEnv -> ModuleName -> PkgQual -> IO FindResult
    findImportedModule HscEnv
    hsc_env ModuleName
    mn PkgQual
    NoPkgQual

        check_reexport :: ModuleName -> IO Bool
    check_reexport ModuleName
    mn = do
          FindResult
    fr <- ModuleName -> IO FindResult
    lookupModule ModuleName
    mn
          case FindResult
    fr of
            Found ModLocation
    _ Module
    m -> Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Module -> UnitId
    moduleUnitId Module
    m UnitId -> UnitId -> Bool
    forall a. Eq a => a -> a -> Bool
    == DynFlags -> UnitId
    homeUnitId_ DynFlags
    dflags)
            FindResult
    _ -> Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True

        warn :: DriverMessage -> DriverMessages
    warn DriverMessage
    diagnostic = MsgEnvelope DriverMessage -> DriverMessages
    forall e. MsgEnvelope e -> Messages e
    singleMessage (MsgEnvelope DriverMessage -> DriverMessages)
    -> MsgEnvelope DriverMessage -> DriverMessages
    forall a b. (a -> b) -> a -> b
    $ DiagOpts -> SrcSpan -> DriverMessage -> MsgEnvelope DriverMessage
    forall e. Diagnostic e => DiagOpts -> SrcSpan -> e -> MsgEnvelope e
    mkPlainMsgEnvelope DiagOpts
    diag_opts SrcSpan
    noSrcSpan
                             (DriverMessage -> MsgEnvelope DriverMessage)
    -> DriverMessage -> MsgEnvelope DriverMessage
    forall a b. (a -> b) -> a -> b
    $ DriverMessage
    diagnostic

        final_msgs :: Set ModuleName -> [ModuleName] -> DriverMessages
    final_msgs Set ModuleName
    hidden_warns [ModuleName]
    reexported_warns
              =
            [DriverMessages] -> DriverMessages
    forall (f :: * -> *) e. Foldable f => f (Messages e) -> Messages e
    unionManyMessages ([DriverMessages] -> DriverMessages)
    -> [DriverMessages] -> DriverMessages
    forall a b. (a -> b) -> a -> b
    $
              [DriverMessage -> DriverMessages
    warn (UnitId -> [ModuleName] -> DriverMessage
    DriverUnknownHiddenModules (DynFlags -> UnitId
    homeUnitId_ DynFlags
    dflags) (Set ModuleName -> [ModuleName]
    forall a. Set a -> [a]
    Set.toList Set ModuleName
    hidden_warns)) | Bool -> Bool
    not (Set ModuleName -> Bool
    forall a. Set a -> Bool
    Set.null Set ModuleName
    hidden_warns)]
              [DriverMessages] -> [DriverMessages] -> [DriverMessages]
    forall a. [a] -> [a] -> [a]
    ++ [DriverMessage -> DriverMessages
    warn (UnitId -> [ModuleName] -> DriverMessage
    DriverUnknownReexportedModules (DynFlags -> UnitId
    homeUnitId_ DynFlags
    dflags) [ModuleName]
    reexported_warns) | Bool -> Bool
    not ([ModuleName] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ModuleName]
    reexported_warns)]

    -- | Describes which modules of the module graph need to be loaded.
    data LoadHowMuch
       = LoadAllTargets
         -- ^ Load all targets and its dependencies.
       | LoadUpTo HomeUnitModule
         -- ^ Load only the given module and its dependencies.
       | LoadDependenciesOf HomeUnitModule
         -- ^ Load only the dependencies of the given module, but not the module
         -- itself.

    {-
    Note [Caching HomeModInfo]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~

    API clients who call `load` like to cache the HomeModInfo in memory between
    calls to this function. In the old days, this cache was a simple MVar which stored
    a HomePackageTable. This was insufficient, as the interface files for boot modules
    were not recorded in the cache. In the less old days, the cache was returned at the
    end of load, and supplied at the start of load, however, this was not sufficient
    because it didn't account for the possibility of exceptions such as SIGINT (#20780).

    So now, in the current day, we have this ModIfaceCache abstraction which
    can incrementally be updated during the process of upsweep. This allows us
    to store interface files for boot modules in an exception-safe way.

    When the final version of an interface file is completed then it is placed into
    the cache. The contents of the cache is retrieved, and the cache cleared, by iface_clearCache.

    Note that because we only store the ModIface and Linkable in the ModIfaceCache,
    hydration and rehydration is totally irrelevant, and we just store the CachedIface as
    soon as it is completed.

    -}

    -- Abstract interface to a cache of HomeModInfo
    -- See Note [Caching HomeModInfo]
    data ModIfaceCache = ModIfaceCache { ModIfaceCache -> IO [CachedIface]
    iface_clearCache :: IO [CachedIface]
                                       , ModIfaceCache -> CachedIface -> IO ()
    iface_addToCache :: CachedIface -> IO () }

    addHmiToCache :: ModIfaceCache -> HomeModInfo -> IO ()
    addHmiToCache :: ModIfaceCache -> HomeModInfo -> IO ()
    addHmiToCache ModIfaceCache
    c (HomeModInfo ModIface
    i ModDetails
    _ HomeModLinkable
    l) = ModIfaceCache -> CachedIface -> IO ()
    iface_addToCache ModIfaceCache
    c (ModIface -> HomeModLinkable -> CachedIface
    CachedIface ModIface
    i HomeModLinkable
    l)

    data CachedIface = CachedIface { CachedIface -> ModIface
    cached_modiface :: !ModIface
                                   , CachedIface -> HomeModLinkable
    cached_linkable :: !HomeModLinkable }

    instance Outputable CachedIface where
      ppr :: CachedIface -> SDoc
    ppr (CachedIface ModIface
    mi HomeModLinkable
    ln) = [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hsep [FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "CachedIface", ModNodeKeyWithUid -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (ModIface -> ModNodeKeyWithUid
    miKey ModIface
    mi), HomeModLinkable -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HomeModLinkable
    ln]

    noIfaceCache :: Maybe ModIfaceCache
    noIfaceCache :: Maybe ModIfaceCache
    noIfaceCache = Maybe ModIfaceCache
    forall a. Maybe a
    Nothing

    newIfaceCache :: IO ModIfaceCache
    newIfaceCache :: IO ModIfaceCache
    newIfaceCache = do
      IORef [CachedIface]
    ioref <- [CachedIface] -> IO (IORef [CachedIface])
    forall a. a -> IO (IORef a)
    newIORef []
      return $
        ModIfaceCache
          { iface_clearCache :: IO [CachedIface]
    iface_clearCache = IORef [CachedIface]
    -> ([CachedIface] -> ([CachedIface], [CachedIface]))
    -> IO [CachedIface]
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' IORef [CachedIface]
    ioref (\[CachedIface]
    c -> ([], [CachedIface]
    c))
          , iface_addToCache :: CachedIface -> IO ()
    iface_addToCache = \CachedIface
    hmi -> IORef [CachedIface]
    -> ([CachedIface] -> ([CachedIface], ())) -> IO ()
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' IORef [CachedIface]
    ioref (\[CachedIface]
    c -> (CachedIface
    hmiCachedIface -> [CachedIface] -> [CachedIface]
    forall a. a -> [a] -> [a]
    :[CachedIface]
    c, ()))
          }

    -- | Try to load the program.  See 'LoadHowMuch' for the different modes.
    --
    -- This function implements the core of GHC's @--make@ mode.  It preprocesses,
    -- compiles and loads the specified modules, avoiding re-compilation wherever
    -- possible.  Depending on the backend (see 'DynFlags.backend' field) compiling
    -- and loading may result in files being created on disk.
    --
    -- Calls the 'defaultWarnErrLogger' after each compiling each module, whether
    -- successful or not.
    --
    -- If errors are encountered during dependency analysis, the module `depanalE`
    -- returns together with the errors an empty ModuleGraph.
    -- After processing this empty ModuleGraph, the errors of depanalE are thrown.
    -- All other errors are reported using the 'defaultWarnErrLogger'.

    load :: GhcMonad f => LoadHowMuch -> f SuccessFlag
    load :: forall (f :: * -> *). GhcMonad f => LoadHowMuch -> f SuccessFlag
    load LoadHowMuch
    how_much = Maybe ModIfaceCache
    -> (GhcMessage -> AnyGhcDiagnostic) -> LoadHowMuch -> f SuccessFlag
    forall (m :: * -> *).
    GhcMonad m =>
    Maybe ModIfaceCache
    -> (GhcMessage -> AnyGhcDiagnostic) -> LoadHowMuch -> m SuccessFlag
    loadWithCache Maybe ModIfaceCache
    noIfaceCache GhcMessage -> AnyGhcDiagnostic
    forall a.
    (Typeable a, Diagnostic a) =>
    a -> UnknownDiagnostic (DiagnosticOpts a)
    mkUnknownDiagnostic LoadHowMuch
    how_much

    mkBatchMsg :: HscEnv -> Messager
    mkBatchMsg :: HscEnv -> Messager
    mkBatchMsg HscEnv
    hsc_env =
      if Set UnitId -> Int
    forall a. Set a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (HscEnv -> Set UnitId
    hsc_all_home_unit_ids HscEnv
    hsc_env) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1
        -- This also displays what unit each module is from.
        then Messager
    batchMultiMsg
        else Messager
    batchMsg

    type AnyGhcDiagnostic = UnknownDiagnostic (DiagnosticOpts GhcMessage)

    loadWithCache :: GhcMonad m => Maybe ModIfaceCache -- ^ Instructions about how to cache interfaces as we create them.
                                -> (GhcMessage -> AnyGhcDiagnostic) -- ^ How to wrap error messages before they are displayed to a user.
                                                                    -- If you are using the GHC API you can use this to override how messages
                                                                    -- created during 'loadWithCache' are displayed to the user.
                                -> LoadHowMuch -- ^ How much `loadWithCache` should load
                                -> m SuccessFlag
    loadWithCache :: forall (m :: * -> *).
    GhcMonad m =>
    Maybe ModIfaceCache
    -> (GhcMessage -> AnyGhcDiagnostic) -> LoadHowMuch -> m SuccessFlag
    loadWithCache Maybe ModIfaceCache
    cache GhcMessage -> AnyGhcDiagnostic
    diag_wrapper LoadHowMuch
    how_much = do
        (DriverMessages
    errs, ModuleGraph
    mod_graph) <- [ModuleName] -> Bool -> m (DriverMessages, ModuleGraph)
    forall (m :: * -> *).
    GhcMonad m =>
    [ModuleName] -> Bool -> m (DriverMessages, ModuleGraph)
    depanalE [] Bool
    False                        -- #17459
        Messager
    msg <- HscEnv -> Messager
    mkBatchMsg (HscEnv -> Messager) -> m HscEnv -> m Messager
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> m HscEnv
    forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
        SuccessFlag
    success <- Maybe ModIfaceCache
    -> LoadHowMuch
    -> (GhcMessage -> AnyGhcDiagnostic)
    -> Maybe Messager
    -> ModuleGraph
    -> m SuccessFlag
    forall (m :: * -> *).
    GhcMonad m =>
    Maybe ModIfaceCache
    -> LoadHowMuch
    -> (GhcMessage -> AnyGhcDiagnostic)
    -> Maybe Messager
    -> ModuleGraph
    -> m SuccessFlag
    load' Maybe ModIfaceCache
    cache LoadHowMuch
    how_much GhcMessage -> AnyGhcDiagnostic
    diag_wrapper (Messager -> Maybe Messager
    forall a. a -> Maybe a
    Just Messager
    msg) ModuleGraph
    mod_graph
        if DriverMessages -> Bool
    forall e. Messages e -> Bool
    isEmptyMessages DriverMessages
    errs
          then SuccessFlag -> m SuccessFlag
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure SuccessFlag
    success
          else Messages GhcMessage -> m SuccessFlag
    forall (io :: * -> *) a. MonadIO io => Messages GhcMessage -> io a
    throwErrors ((DriverMessage -> GhcMessage)
    -> DriverMessages -> Messages GhcMessage
    forall a b. (a -> b) -> Messages a -> Messages b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DriverMessage -> GhcMessage
    GhcDriverMessage DriverMessages
    errs)

    -- Note [Unused packages]
    -- ~~~~~~~~~~~~~~~~~~~~~~
    -- Cabal passes `--package-id` flag for each direct dependency. But GHC
    -- loads them lazily, so when compilation is done, we have a list of all
    -- actually loaded packages. All the packages, specified on command line,
    -- but never loaded, are probably unused dependencies.

    warnUnusedPackages :: UnitState -> DynFlags -> ModuleGraph -> DriverMessages
    warnUnusedPackages :: UnitState -> DynFlags -> ModuleGraph -> DriverMessages
    warnUnusedPackages UnitState
    us DynFlags
    dflags ModuleGraph
    mod_graph =
        let diag_opts :: DiagOpts
    diag_opts = DynFlags -> DiagOpts
    initDiagOpts DynFlags
    dflags

            home_mod_sum :: [ModSummary]
    home_mod_sum = (ModSummary -> Bool) -> [ModSummary] -> [ModSummary]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\ModSummary
    ms -> DynFlags -> UnitId
    homeUnitId_ DynFlags
    dflags UnitId -> UnitId -> Bool
    forall a. Eq a => a -> a -> Bool
    == ModSummary -> UnitId
    ms_unitid ModSummary
    ms) (ModuleGraph -> [ModSummary]
    mgModSummaries ModuleGraph
    mod_graph)

        -- Only need non-source imports here because SOURCE imports are always HPT
            loadedPackages :: [UnitInfo]
    loadedPackages = [[UnitInfo]] -> [UnitInfo]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[UnitInfo]] -> [UnitInfo]) -> [[UnitInfo]] -> [UnitInfo]
    forall a b. (a -> b) -> a -> b
    $
              ((PkgQual, GenLocated SrcSpan ModuleName) -> Maybe [UnitInfo])
    -> [(PkgQual, GenLocated SrcSpan ModuleName)] -> [[UnitInfo]]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (\(PkgQual
    fs, GenLocated SrcSpan ModuleName
    mn) -> UnitState -> ModuleName -> PkgQual -> Maybe [UnitInfo]
    lookupModulePackage UnitState
    us (GenLocated SrcSpan ModuleName -> ModuleName
    forall l e. GenLocated l e -> e
    unLoc GenLocated SrcSpan ModuleName
    mn) PkgQual
    fs)
                ([(PkgQual, GenLocated SrcSpan ModuleName)] -> [[UnitInfo]])
    -> [(PkgQual, GenLocated SrcSpan ModuleName)] -> [[UnitInfo]]
    forall a b. (a -> b) -> a -> b
    $ (ModSummary -> [(PkgQual, GenLocated SrcSpan ModuleName)])
    -> [ModSummary] -> [(PkgQual, GenLocated SrcSpan ModuleName)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ModSummary -> [(PkgQual, GenLocated SrcSpan ModuleName)]
    ms_imps [ModSummary]
    home_mod_sum

            any_import_ghc_prim :: Bool
    any_import_ghc_prim = (ModSummary -> Bool) -> [ModSummary] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ModSummary -> Bool
    ms_ghc_prim_import [ModSummary]
    home_mod_sum

            used_args :: Set UnitId
    used_args = [UnitId] -> Set UnitId
    forall a. Ord a => [a] -> Set a
    Set.fromList ((UnitInfo -> UnitId) -> [UnitInfo] -> [UnitId]
    forall a b. (a -> b) -> [a] -> [b]
    map UnitInfo -> UnitId
    forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> uid
    unitId [UnitInfo]
    loadedPackages)
                          Set UnitId -> Set UnitId -> Set UnitId
    forall a. Ord a => Set a -> Set a -> Set a
    `Set.union` [UnitId] -> Set UnitId
    forall a. Ord a => [a] -> Set a
    Set.fromList [ UnitId
    primUnitId |  Bool
    any_import_ghc_prim ]

            resolve :: (GenUnit UnitId, Maybe PackageArg)
    -> Maybe (UnitId, PackageName, Version, PackageArg)
    resolve (GenUnit UnitId
    u,Maybe PackageArg
    mflag) = do
                      -- The units which we depend on via the command line explicitly
                      PackageArg
    flag <- Maybe PackageArg
    mflag
                      -- Which we can find the UnitInfo for (should be all of them)
                      UnitInfo
    ui <- UnitState -> GenUnit UnitId -> Maybe UnitInfo
    lookupUnit UnitState
    us GenUnit UnitId
    u
                      -- Which are not explicitly used
                      Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (UnitId -> Set UnitId -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.notMember (UnitInfo -> UnitId
    forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> uid
    unitId UnitInfo
    ui) Set UnitId
    used_args)
                      return (UnitInfo -> UnitId
    forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> uid
    unitId UnitInfo
    ui, UnitInfo -> PackageName
    forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> srcpkgname
    unitPackageName UnitInfo
    ui, UnitInfo -> Version
    forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Version
    unitPackageVersion UnitInfo
    ui, PackageArg
    flag)

            unusedArgs :: [(UnitId, PackageName, Version, PackageArg)]
    unusedArgs = ((UnitId, PackageName, Version, PackageArg) -> UnitId)
    -> [(UnitId, PackageName, Version, PackageArg)]
    -> [(UnitId, PackageName, Version, PackageArg)]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortOn (\(UnitId
    u,PackageName
    _,Version
    _,PackageArg
    _) -> UnitId
    u) ([(UnitId, PackageName, Version, PackageArg)]
     -> [(UnitId, PackageName, Version, PackageArg)])
    -> [(UnitId, PackageName, Version, PackageArg)]
    -> [(UnitId, PackageName, Version, PackageArg)]
    forall a b. (a -> b) -> a -> b
    $ ((GenUnit UnitId, Maybe PackageArg)
     -> Maybe (UnitId, PackageName, Version, PackageArg))
    -> [(GenUnit UnitId, Maybe PackageArg)]
    -> [(UnitId, PackageName, Version, PackageArg)]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (GenUnit UnitId, Maybe PackageArg)
    -> Maybe (UnitId, PackageName, Version, PackageArg)
    resolve (UnitState -> [(GenUnit UnitId, Maybe PackageArg)]
    explicitUnits UnitState
    us)

            warn :: DriverMessages
    warn = MsgEnvelope DriverMessage -> DriverMessages
    forall e. MsgEnvelope e -> Messages e
    singleMessage (MsgEnvelope DriverMessage -> DriverMessages)
    -> MsgEnvelope DriverMessage -> DriverMessages
    forall a b. (a -> b) -> a -> b
    $ DiagOpts -> SrcSpan -> DriverMessage -> MsgEnvelope DriverMessage
    forall e. Diagnostic e => DiagOpts -> SrcSpan -> e -> MsgEnvelope e
    mkPlainMsgEnvelope DiagOpts
    diag_opts SrcSpan
    noSrcSpan ([(UnitId, PackageName, Version, PackageArg)] -> DriverMessage
    DriverUnusedPackages [(UnitId, PackageName, Version, PackageArg)]
    unusedArgs)

        in if [(UnitId, PackageName, Version, PackageArg)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(UnitId, PackageName, Version, PackageArg)]
    unusedArgs
            then DriverMessages
    forall e. Messages e
    emptyMessages
            else DriverMessages
    warn

    -- | A ModuleGraphNode which also has a hs-boot file, and the list of nodes on any
    -- path from module to its boot file.
    data ModuleGraphNodeWithBootFile
      = ModuleGraphNodeWithBootFile
         ModuleGraphNode
           -- ^ The module itself (not the hs-boot module)
         [NodeKey]
           -- ^ The modules in between the module and its hs-boot file,
           -- not including the hs-boot file itself.

    instance Outputable ModuleGraphNodeWithBootFile where
      ppr :: ModuleGraphNodeWithBootFile -> SDoc
    ppr (ModuleGraphNodeWithBootFile ModuleGraphNode
    mgn [NodeKey]
    deps) = FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "ModeGraphNodeWithBootFile: " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> ModuleGraphNode -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ModuleGraphNode
    mgn SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ [NodeKey] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [NodeKey]
    deps

    -- | A 'BuildPlan' is the result of attempting to linearise a single strongly-connected
    -- component of the module graph.
    data BuildPlan
      -- | A simple, single module all alone (which *might* have an hs-boot file, if it isn't part of a cycle)
      = SingleModule ModuleGraphNode
      -- | A resolved cycle, linearised by hs-boot files
      | ResolvedCycle [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
      -- | An actual cycle, which wasn't resolved by hs-boot files
      | UnresolvedCycle [ModuleGraphNode]

    instance Outputable BuildPlan where
      ppr :: BuildPlan -> SDoc
    ppr (SingleModule ModuleGraphNode
    mgn) = FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "SingleModule" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (ModuleGraphNode -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ModuleGraphNode
    mgn)
      ppr (ResolvedCycle [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    mgn)   = FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "ResolvedCycle:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [Either ModuleGraphNode ModuleGraphNodeWithBootFile] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    mgn
      ppr (UnresolvedCycle [ModuleGraphNode]
    mgn) = FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "UnresolvedCycle:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [ModuleGraphNode] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [ModuleGraphNode]
    mgn

    -- Just used for an assertion
    countMods :: BuildPlan -> Int
    countMods :: BuildPlan -> Int
    countMods (SingleModule ModuleGraphNode
    _) = Int
    1
    countMods (ResolvedCycle [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    ns) = [Either ModuleGraphNode ModuleGraphNodeWithBootFile] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    ns
    countMods (UnresolvedCycle [ModuleGraphNode]
    ns) = [ModuleGraphNode] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ModuleGraphNode]
    ns

    -- See Note [Upsweep] for a high-level description.
    createBuildPlan :: ModuleGraph -> Maybe HomeUnitModule -> [BuildPlan]
    createBuildPlan :: ModuleGraph -> Maybe HomeUnitModule -> [BuildPlan]
    createBuildPlan ModuleGraph
    mod_graph Maybe HomeUnitModule
    maybe_top_mod =
        let -- Step 1: Compute SCCs without .hi-boot files, to find the cycles
            cycle_mod_graph :: [SCC ModuleGraphNode]
    cycle_mod_graph = Bool
    -> ModuleGraph -> Maybe HomeUnitModule -> [SCC ModuleGraphNode]
    topSortModuleGraph Bool
    True ModuleGraph
    mod_graph Maybe HomeUnitModule
    maybe_top_mod

            -- Step 2: Reanalyse loops, with relevant boot modules, to solve the cycles.
            build_plan :: [BuildPlan]
            build_plan :: [BuildPlan]
    build_plan
              -- Fast path, if there are no boot modules just do a normal toposort
              | ModuleEnv (ModuleGraphNode, [ModuleGraphNode]) -> Bool
    forall a. ModuleEnv a -> Bool
    isEmptyModuleEnv ModuleEnv (ModuleGraphNode, [ModuleGraphNode])
    boot_modules = [SCC ModuleGraphNode] -> [BuildPlan]
    collapseAcyclic ([SCC ModuleGraphNode] -> [BuildPlan])
    -> [SCC ModuleGraphNode] -> [BuildPlan]
    forall a b. (a -> b) -> a -> b
    $ Bool
    -> ModuleGraph -> Maybe HomeUnitModule -> [SCC ModuleGraphNode]
    topSortModuleGraph Bool
    False ModuleGraph
    mod_graph Maybe HomeUnitModule
    maybe_top_mod
              | Bool
    otherwise = [SCC ModuleGraphNode] -> [ModuleGraphNode] -> [BuildPlan]
    toBuildPlan [SCC ModuleGraphNode]
    cycle_mod_graph []

            toBuildPlan :: [SCC ModuleGraphNode] -> [ModuleGraphNode] -> [BuildPlan]
            toBuildPlan :: [SCC ModuleGraphNode] -> [ModuleGraphNode] -> [BuildPlan]
    toBuildPlan [] [ModuleGraphNode]
    mgn = [SCC ModuleGraphNode] -> [BuildPlan]
    collapseAcyclic ([ModuleGraphNode] -> [SCC ModuleGraphNode]
    topSortWithBoot [ModuleGraphNode]
    mgn)
            toBuildPlan ((AcyclicSCC ModuleGraphNode
    node):[SCC ModuleGraphNode]
    sccs) [ModuleGraphNode]
    mgn = [SCC ModuleGraphNode] -> [ModuleGraphNode] -> [BuildPlan]
    toBuildPlan [SCC ModuleGraphNode]
    sccs (ModuleGraphNode
    nodeModuleGraphNode -> [ModuleGraphNode] -> [ModuleGraphNode]
    forall a. a -> [a] -> [a]
    :[ModuleGraphNode]
    mgn)
            -- Interesting case
            toBuildPlan ((CyclicSCC [ModuleGraphNode]
    nodes):[SCC ModuleGraphNode]
    sccs) [ModuleGraphNode]
    mgn =
              let acyclic :: [BuildPlan]
    acyclic = [SCC ModuleGraphNode] -> [BuildPlan]
    collapseAcyclic ([ModuleGraphNode] -> [SCC ModuleGraphNode]
    topSortWithBoot [ModuleGraphNode]
    mgn)
                  -- Now perform another toposort but just with these nodes and relevant hs-boot files.
                  -- The result should be acyclic, if it's not, then there's an unresolved cycle in the graph.
                  mresolved_cycle :: Either
      [ModuleGraphNode]
      [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    mresolved_cycle = [SCC ModuleGraphNode]
    -> Either
         [ModuleGraphNode]
         [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    collapseSCC ([ModuleGraphNode] -> [SCC ModuleGraphNode]
    topSortWithBoot [ModuleGraphNode]
    nodes)
              in [BuildPlan]
    acyclic [BuildPlan] -> [BuildPlan] -> [BuildPlan]
    forall a. [a] -> [a] -> [a]
    ++ [([ModuleGraphNode] -> BuildPlan)
    -> ([Either ModuleGraphNode ModuleGraphNodeWithBootFile]
        -> BuildPlan)
    -> Either
         [ModuleGraphNode]
         [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    -> BuildPlan
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either [ModuleGraphNode] -> BuildPlan
    UnresolvedCycle [Either ModuleGraphNode ModuleGraphNodeWithBootFile] -> BuildPlan
    ResolvedCycle Either
      [ModuleGraphNode]
      [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    mresolved_cycle] [BuildPlan] -> [BuildPlan] -> [BuildPlan]
    forall a. [a] -> [a] -> [a]
    ++ [SCC ModuleGraphNode] -> [ModuleGraphNode] -> [BuildPlan]
    toBuildPlan [SCC ModuleGraphNode]
    sccs []

            (Graph SummaryNode
    mg, NodeKey -> Maybe SummaryNode
    lookup_node) = Bool
    -> [ModuleGraphNode]
    -> (Graph SummaryNode, NodeKey -> Maybe SummaryNode)
    moduleGraphNodes Bool
    False (ModuleGraph -> [ModuleGraphNode]
    mgModSummaries' ModuleGraph
    mod_graph)
            trans_deps_map :: Map NodeKey (Set NodeKey)
    trans_deps_map = Graph SummaryNode
    -> (SummaryNode -> NodeKey) -> Map NodeKey (Set NodeKey)
    forall key node.
    Ord key =>
    Graph node -> (node -> key) -> Map key (Set key)
    allReachable Graph SummaryNode
    mg (ModuleGraphNode -> NodeKey
    mkNodeKey (ModuleGraphNode -> NodeKey)
    -> (SummaryNode -> ModuleGraphNode) -> SummaryNode -> NodeKey
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SummaryNode -> ModuleGraphNode
    forall key payload. Node key payload -> payload
    node_payload)
            -- Compute the intermediate modules between a file and its hs-boot file.
            -- See Step 2a in Note [Upsweep]
            boot_path :: ModuleName -> UnitId -> [ModuleGraphNode]
    boot_path ModuleName
    mn UnitId
    uid =
              (NodeKey -> ModuleGraphNode) -> [NodeKey] -> [ModuleGraphNode]
    forall a b. (a -> b) -> [a] -> [b]
    map (SummaryNode -> ModuleGraphNode
    summaryNodeSummary (SummaryNode -> ModuleGraphNode)
    -> (NodeKey -> SummaryNode) -> NodeKey -> ModuleGraphNode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> Maybe SummaryNode -> SummaryNode
    forall a. HasCallStack => FilePath -> Maybe a -> a
    expectJust FilePath
    "toNode" (Maybe SummaryNode -> SummaryNode)
    -> (NodeKey -> Maybe SummaryNode) -> NodeKey -> SummaryNode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NodeKey -> Maybe SummaryNode
    lookup_node) ([NodeKey] -> [ModuleGraphNode]) -> [NodeKey] -> [ModuleGraphNode]
    forall a b. (a -> b) -> a -> b
    $ Set NodeKey -> [NodeKey]
    forall a. Set a -> [a]
    Set.toList (Set NodeKey -> [NodeKey]) -> Set NodeKey -> [NodeKey]
    forall a b. (a -> b) -> a -> b
    $
              -- Don't include the boot module itself
              NodeKey -> Set NodeKey -> Set NodeKey
    forall a. Ord a => a -> Set a -> Set a
    Set.delete (ModNodeKeyWithUid -> NodeKey
    NodeKey_Module (IsBootInterface -> ModNodeKeyWithUid
    key IsBootInterface
    IsBoot))  (Set NodeKey -> Set NodeKey) -> Set NodeKey -> Set NodeKey
    forall a b. (a -> b) -> a -> b
    $
              -- Keep intermediate dependencies: as per Step 2a in Note [Upsweep], these are
              -- the transitive dependencies of the non-boot file which transitively depend
              -- on the boot file.
              (NodeKey -> Bool) -> Set NodeKey -> Set NodeKey
    forall a. (a -> Bool) -> Set a -> Set a
    Set.filter (\NodeKey
    nk -> NodeKey -> UnitId
    nodeKeyUnitId NodeKey
    nk UnitId -> UnitId -> Bool
    forall a. Eq a => a -> a -> Bool
    == UnitId
    uid  -- Cheap test
                                  Bool -> Bool -> Bool
    && (ModNodeKeyWithUid -> NodeKey
    NodeKey_Module (IsBootInterface -> ModNodeKeyWithUid
    key IsBootInterface
    IsBoot)) NodeKey -> Set NodeKey -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` FilePath -> Maybe (Set NodeKey) -> Set NodeKey
    forall a. HasCallStack => FilePath -> Maybe a -> a
    expectJust FilePath
    "dep_on_boot" (NodeKey -> Map NodeKey (Set NodeKey) -> Maybe (Set NodeKey)
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup NodeKey
    nk Map NodeKey (Set NodeKey)
    trans_deps_map)) (Set NodeKey -> Set NodeKey) -> Set NodeKey -> Set NodeKey
    forall a b. (a -> b) -> a -> b
    $
              FilePath -> Maybe (Set NodeKey) -> Set NodeKey
    forall a. HasCallStack => FilePath -> Maybe a -> a
    expectJust FilePath
    "not_boot_dep" (NodeKey -> Map NodeKey (Set NodeKey) -> Maybe (Set NodeKey)
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup (ModNodeKeyWithUid -> NodeKey
    NodeKey_Module (IsBootInterface -> ModNodeKeyWithUid
    key IsBootInterface
    NotBoot)) Map NodeKey (Set NodeKey)
    trans_deps_map)
              where
                key :: IsBootInterface -> ModNodeKeyWithUid
    key IsBootInterface
    ib = ModuleNameWithIsBoot -> UnitId -> ModNodeKeyWithUid
    ModNodeKeyWithUid (ModuleName -> IsBootInterface -> ModuleNameWithIsBoot
    forall mod. mod -> IsBootInterface -> GenWithIsBoot mod
    GWIB ModuleName
    mn IsBootInterface
    ib) UnitId
    uid

            -- An environment mapping a module to its hs-boot file and all nodes on the path between the two, if one exists
            boot_modules :: ModuleEnv (ModuleGraphNode, [ModuleGraphNode])
    boot_modules = [(Module, (ModuleGraphNode, [ModuleGraphNode]))]
    -> ModuleEnv (ModuleGraphNode, [ModuleGraphNode])
    forall a. [(Module, a)] -> ModuleEnv a
    mkModuleEnv
              [ (ModSummary -> Module
    ms_mod ModSummary
    ms, (ModuleGraphNode
    m, ModuleName -> UnitId -> [ModuleGraphNode]
    boot_path (ModSummary -> ModuleName
    ms_mod_name ModSummary
    ms) (ModSummary -> UnitId
    ms_unitid ModSummary
    ms))) | m :: ModuleGraphNode
    m@(ModuleNode [NodeKey]
    _ ModSummary
    ms) <- (ModuleGraph -> [ModuleGraphNode]
    mgModSummaries' ModuleGraph
    mod_graph), ModSummary -> IsBootInterface
    isBootSummary ModSummary
    ms IsBootInterface -> IsBootInterface -> Bool
    forall a. Eq a => a -> a -> Bool
    == IsBootInterface
    IsBoot]

            select_boot_modules :: [ModuleGraphNode] -> [ModuleGraphNode]
            select_boot_modules :: [ModuleGraphNode] -> [ModuleGraphNode]
    select_boot_modules = (ModuleGraphNode -> Maybe ModuleGraphNode)
    -> [ModuleGraphNode] -> [ModuleGraphNode]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (((ModuleGraphNode, [ModuleGraphNode]) -> ModuleGraphNode)
    -> Maybe (ModuleGraphNode, [ModuleGraphNode])
    -> Maybe ModuleGraphNode
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (ModuleGraphNode, [ModuleGraphNode]) -> ModuleGraphNode
    forall a b. (a, b) -> a
    fst (Maybe (ModuleGraphNode, [ModuleGraphNode])
     -> Maybe ModuleGraphNode)
    -> (ModuleGraphNode -> Maybe (ModuleGraphNode, [ModuleGraphNode]))
    -> ModuleGraphNode
    -> Maybe ModuleGraphNode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModuleGraphNode -> Maybe (ModuleGraphNode, [ModuleGraphNode])
    get_boot_module)

            get_boot_module :: ModuleGraphNode -> Maybe (ModuleGraphNode, [ModuleGraphNode])
            get_boot_module :: ModuleGraphNode -> Maybe (ModuleGraphNode, [ModuleGraphNode])
    get_boot_module ModuleGraphNode
    m = case ModuleGraphNode
    m of ModuleNode [NodeKey]
    _ ModSummary
    ms | HscSource
    HsSrcFile <- ModSummary -> HscSource
    ms_hsc_src ModSummary
    ms -> ModuleEnv (ModuleGraphNode, [ModuleGraphNode])
    -> Module -> Maybe (ModuleGraphNode, [ModuleGraphNode])
    forall a. ModuleEnv a -> Module -> Maybe a
    lookupModuleEnv ModuleEnv (ModuleGraphNode, [ModuleGraphNode])
    boot_modules (ModSummary -> Module
    ms_mod ModSummary
    ms); ModuleGraphNode
    _ -> Maybe (ModuleGraphNode, [ModuleGraphNode])
    forall a. Maybe a
    Nothing

            -- Any cycles should be resolved now
            collapseSCC :: [SCC ModuleGraphNode] -> Either [ModuleGraphNode] [(Either ModuleGraphNode ModuleGraphNodeWithBootFile)]
            -- Must be at least two nodes, as we were in a cycle
            collapseSCC :: [SCC ModuleGraphNode]
    -> Either
         [ModuleGraphNode]
         [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    collapseSCC [AcyclicSCC ModuleGraphNode
    node1, AcyclicSCC ModuleGraphNode
    node2] = [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    -> Either
         [ModuleGraphNode]
         [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    forall a b. b -> Either a b
    Right [ModuleGraphNode
    -> Either ModuleGraphNode ModuleGraphNodeWithBootFile
    toNodeWithBoot ModuleGraphNode
    node1, ModuleGraphNode
    -> Either ModuleGraphNode ModuleGraphNodeWithBootFile
    toNodeWithBoot ModuleGraphNode
    node2]
            collapseSCC (AcyclicSCC ModuleGraphNode
    node : [SCC ModuleGraphNode]
    nodes) = ([ModuleGraphNode]
     -> Either
          [ModuleGraphNode]
          [Either ModuleGraphNode ModuleGraphNodeWithBootFile])
    -> ([Either ModuleGraphNode ModuleGraphNodeWithBootFile]
        -> Either
             [ModuleGraphNode]
             [Either ModuleGraphNode ModuleGraphNodeWithBootFile])
    -> Either
         [ModuleGraphNode]
         [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    -> Either
         [ModuleGraphNode]
         [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either ([ModuleGraphNode]
    -> Either
         [ModuleGraphNode]
         [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    forall a b. a -> Either a b
    Left ([ModuleGraphNode]
     -> Either
          [ModuleGraphNode]
          [Either ModuleGraphNode ModuleGraphNodeWithBootFile])
    -> ([ModuleGraphNode] -> [ModuleGraphNode])
    -> [ModuleGraphNode]
    -> Either
         [ModuleGraphNode]
         [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ModuleGraphNode
    node ModuleGraphNode -> [ModuleGraphNode] -> [ModuleGraphNode]
    forall a. a -> [a] -> [a]
    :)) ([Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    -> Either
         [ModuleGraphNode]
         [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    forall a b. b -> Either a b
    Right ([Either ModuleGraphNode ModuleGraphNodeWithBootFile]
     -> Either
          [ModuleGraphNode]
          [Either ModuleGraphNode ModuleGraphNodeWithBootFile])
    -> ([Either ModuleGraphNode ModuleGraphNodeWithBootFile]
        -> [Either ModuleGraphNode ModuleGraphNodeWithBootFile])
    -> [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    -> Either
         [ModuleGraphNode]
         [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ModuleGraphNode
    -> Either ModuleGraphNode ModuleGraphNodeWithBootFile
    toNodeWithBoot ModuleGraphNode
    node Either ModuleGraphNode ModuleGraphNodeWithBootFile
    -> [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    -> [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    forall a. a -> [a] -> [a]
    :)) ([SCC ModuleGraphNode]
    -> Either
         [ModuleGraphNode]
         [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    collapseSCC [SCC ModuleGraphNode]
    nodes)
            -- Cyclic
            collapseSCC [SCC ModuleGraphNode]
    nodes = [ModuleGraphNode]
    -> Either
         [ModuleGraphNode]
         [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    forall a b. a -> Either a b
    Left ([SCC ModuleGraphNode] -> [ModuleGraphNode]
    forall a. [SCC a] -> [a]
    flattenSCCs [SCC ModuleGraphNode]
    nodes)

            toNodeWithBoot :: ModuleGraphNode -> Either ModuleGraphNode ModuleGraphNodeWithBootFile
            toNodeWithBoot :: ModuleGraphNode
    -> Either ModuleGraphNode ModuleGraphNodeWithBootFile
    toNodeWithBoot ModuleGraphNode
    mn =
              case ModuleGraphNode -> Maybe (ModuleGraphNode, [ModuleGraphNode])
    get_boot_module ModuleGraphNode
    mn of
                -- The node doesn't have a boot file
                Maybe (ModuleGraphNode, [ModuleGraphNode])
    Nothing -> ModuleGraphNode
    -> Either ModuleGraphNode ModuleGraphNodeWithBootFile
    forall a b. a -> Either a b
    Left ModuleGraphNode
    mn
                -- The node does have a boot file
                Just (ModuleGraphNode, [ModuleGraphNode])
    path -> ModuleGraphNodeWithBootFile
    -> Either ModuleGraphNode ModuleGraphNodeWithBootFile
    forall a b. b -> Either a b
    Right (ModuleGraphNode -> [NodeKey] -> ModuleGraphNodeWithBootFile
    ModuleGraphNodeWithBootFile ModuleGraphNode
    mn ((ModuleGraphNode -> NodeKey) -> [ModuleGraphNode] -> [NodeKey]
    forall a b. (a -> b) -> [a] -> [b]
    map ModuleGraphNode -> NodeKey
    mkNodeKey ((ModuleGraphNode, [ModuleGraphNode]) -> [ModuleGraphNode]
    forall a b. (a, b) -> b
    snd (ModuleGraphNode, [ModuleGraphNode])
    path)))

            -- The toposort and accumulation of acyclic modules is solely to pick-up
            -- hs-boot files which are **not** part of cycles.
            collapseAcyclic :: [SCC ModuleGraphNode] -> [BuildPlan]
            collapseAcyclic :: [SCC ModuleGraphNode] -> [BuildPlan]
    collapseAcyclic (AcyclicSCC ModuleGraphNode
    node : [SCC ModuleGraphNode]
    nodes) = ModuleGraphNode -> BuildPlan
    SingleModule ModuleGraphNode
    node BuildPlan -> [BuildPlan] -> [BuildPlan]
    forall a. a -> [a] -> [a]
    : [SCC ModuleGraphNode] -> [BuildPlan]
    collapseAcyclic [SCC ModuleGraphNode]
    nodes
            collapseAcyclic (CyclicSCC [ModuleGraphNode]
    cy_nodes : [SCC ModuleGraphNode]
    nodes) = ([ModuleGraphNode] -> BuildPlan
    UnresolvedCycle [ModuleGraphNode]
    cy_nodes) BuildPlan -> [BuildPlan] -> [BuildPlan]
    forall a. a -> [a] -> [a]
    : [SCC ModuleGraphNode] -> [BuildPlan]
    collapseAcyclic [SCC ModuleGraphNode]
    nodes
            collapseAcyclic [] = []

            topSortWithBoot :: [ModuleGraphNode] -> [SCC ModuleGraphNode]
    topSortWithBoot [ModuleGraphNode]
    nodes = Bool
    -> [ModuleGraphNode]
    -> Maybe HomeUnitModule
    -> [SCC ModuleGraphNode]
    topSortModules Bool
    False ([ModuleGraphNode] -> [ModuleGraphNode]
    select_boot_modules [ModuleGraphNode]
    nodes [ModuleGraphNode] -> [ModuleGraphNode] -> [ModuleGraphNode]
    forall a. [a] -> [a] -> [a]
    ++ [ModuleGraphNode]
    nodes) Maybe HomeUnitModule
    forall a. Maybe a
    Nothing

      in

        Bool -> SDoc -> [BuildPlan] -> [BuildPlan]
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr ([Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ((BuildPlan -> Int) -> [BuildPlan] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map BuildPlan -> Int
    countMods [BuildPlan]
    build_plan) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == [ModuleGraphNode] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (ModuleGraph -> [ModuleGraphNode]
    mgModSummaries' ModuleGraph
    mod_graph))
                  ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "Build plan missing nodes:", (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "PLAN:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Int -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ([Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ((BuildPlan -> Int) -> [BuildPlan] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map BuildPlan -> Int
    countMods [BuildPlan]
    build_plan))), (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "GRAPH:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Int -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ([ModuleGraphNode] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (ModuleGraph -> [ModuleGraphNode]
    mgModSummaries' ModuleGraph
    mod_graph )))])
                  [BuildPlan]
    build_plan

    mkWorkerLimit :: DynFlags -> IO WorkerLimit
    mkWorkerLimit :: DynFlags -> IO WorkerLimit
    mkWorkerLimit DynFlags
    dflags =
      case DynFlags -> Maybe ParMakeCount
    parMakeCount DynFlags
    dflags of
        Maybe ParMakeCount
    Nothing -> WorkerLimit -> IO WorkerLimit
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (WorkerLimit -> IO WorkerLimit) -> WorkerLimit -> IO WorkerLimit
    forall a b. (a -> b) -> a -> b
    $ Int -> WorkerLimit
    num_procs Int
    1
        Just (ParMakeSemaphore FilePath
    h) -> WorkerLimit -> IO WorkerLimit
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (SemaphoreName -> WorkerLimit
    JSemLimit (FilePath -> SemaphoreName
    SemaphoreName FilePath
    h))
        Just ParMakeCount
    ParMakeNumProcessors -> Int -> WorkerLimit
    num_procs (Int -> WorkerLimit) -> IO Int -> IO WorkerLimit
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO Int
    getNumProcessors
        Just (ParMakeThisMany Int
    n) -> WorkerLimit -> IO WorkerLimit
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (WorkerLimit -> IO WorkerLimit) -> WorkerLimit -> IO WorkerLimit
    forall a b. (a -> b) -> a -> b
    $ Int -> WorkerLimit
    num_procs Int
    n
      where
        num_procs :: Int -> WorkerLimit
    num_procs Int
    x = Int -> WorkerLimit
    NumProcessorsLimit (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    1 Int
    x)

    isWorkerLimitSequential :: WorkerLimit -> Bool
    isWorkerLimitSequential :: WorkerLimit -> Bool
    isWorkerLimitSequential (NumProcessorsLimit Int
    x) = Int
    x Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    1
    isWorkerLimitSequential (JSemLimit {})         = Bool
    False

    -- | This describes what we use to limit the number of jobs, either we limit it
    -- ourselves to a specific number or we have an external parallelism semaphore
    -- limit it for us.
    data WorkerLimit
      = NumProcessorsLimit Int
      | JSemLimit
        SemaphoreName
          -- ^ Semaphore name to use
      deriving WorkerLimit -> WorkerLimit -> Bool
    (WorkerLimit -> WorkerLimit -> Bool)
    -> (WorkerLimit -> WorkerLimit -> Bool) -> Eq WorkerLimit
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: WorkerLimit -> WorkerLimit -> Bool
    == :: WorkerLimit -> WorkerLimit -> Bool
    $c/= :: WorkerLimit -> WorkerLimit -> Bool
    /= :: WorkerLimit -> WorkerLimit -> Bool
    Eq

    -- | Generalized version of 'load' which also supports a custom
    -- 'Messager' (for reporting progress) and 'ModuleGraph' (generally
    -- produced by calling 'depanal'.
    load' :: GhcMonad m => Maybe ModIfaceCache -> LoadHowMuch -> (GhcMessage -> AnyGhcDiagnostic) -> Maybe Messager -> ModuleGraph -> m SuccessFlag
    load' :: forall (m :: * -> *).
    GhcMonad m =>
    Maybe ModIfaceCache
    -> LoadHowMuch
    -> (GhcMessage -> AnyGhcDiagnostic)
    -> Maybe Messager
    -> ModuleGraph
    -> m SuccessFlag
    load' Maybe ModIfaceCache
    mhmi_cache LoadHowMuch
    how_much GhcMessage -> AnyGhcDiagnostic
    diag_wrapper Maybe Messager
    mHscMessage ModuleGraph
    mod_graph = do
        -- In normal usage plugins are initialised already by ghc/Main.hs this is protective
        -- for any client who might interact with GHC via load'.
        -- See Note [Timing of plugin initialization]
        m ()
    forall (m :: * -> *). GhcMonad m => m ()
    initializeSessionPlugins
        (HscEnv -> HscEnv) -> m ()
    forall (m :: * -> *). GhcMonad m => (HscEnv -> HscEnv) -> m ()
    modifySession ((HscEnv -> HscEnv) -> m ()) -> (HscEnv -> HscEnv) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \HscEnv
    hsc_env -> HscEnv
    hsc_env { hsc_mod_graph = mod_graph }
        m ()
    forall (m :: * -> *). GhcMonad m => m ()
    guessOutputFile
        HscEnv
    hsc_env <- m HscEnv
    forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession

        let dflags :: DynFlags
    dflags = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env
        let logger :: Logger
    logger = HscEnv -> Logger
    hsc_logger HscEnv
    hsc_env
        let interp :: Interp
    interp = HscEnv -> Interp
    hscInterp HscEnv
    hsc_env

        -- The "bad" boot modules are the ones for which we have
        -- B.hs-boot in the module graph, but no B.hs
        -- The downsweep should have ensured this does not happen
        -- (see msDeps)
        let all_home_mods :: Set HomeUnitModule
    all_home_mods =
              [HomeUnitModule] -> Set HomeUnitModule
    forall a. Ord a => [a] -> Set a
    Set.fromList [ UnitId -> ModuleName -> HomeUnitModule
    forall unit. unit -> ModuleName -> GenModule unit
    Module (ModSummary -> UnitId
    ms_unitid ModSummary
    s) (ModSummary -> ModuleName
    ms_mod_name ModSummary
    s)
                        | ModSummary
    s <- ModuleGraph -> [ModSummary]
    mgModSummaries ModuleGraph
    mod_graph, ModSummary -> IsBootInterface
    isBootSummary ModSummary
    s IsBootInterface -> IsBootInterface -> Bool
    forall a. Eq a => a -> a -> Bool
    == IsBootInterface
    NotBoot]
        -- TODO: Figure out what the correct form of this assert is. It's violated
        -- when you have HsBootMerge nodes in the graph: then you'll have hs-boot
        -- files without corresponding hs files.
        --  bad_boot_mods = [s        | s <- mod_graph, isBootSummary s,
        --                              not (ms_mod_name s `elem` all_home_mods)]
        -- assert (null bad_boot_mods ) return ()

        -- check that the module given in HowMuch actually exists, otherwise
        -- topSortModuleGraph will bomb later.
        let checkHowMuch :: LoadHowMuch -> m SuccessFlag -> m SuccessFlag
    checkHowMuch (LoadUpTo HomeUnitModule
    m)           = HomeUnitModule -> m SuccessFlag -> m SuccessFlag
    checkMod HomeUnitModule
    m
            checkHowMuch (LoadDependenciesOf HomeUnitModule
    m) = HomeUnitModule -> m SuccessFlag -> m SuccessFlag
    checkMod HomeUnitModule
    m
            checkHowMuch LoadHowMuch
    _ = m SuccessFlag -> m SuccessFlag
    forall a. a -> a
    id

            checkMod :: HomeUnitModule -> m SuccessFlag -> m SuccessFlag
    checkMod HomeUnitModule
    m m SuccessFlag
    and_then
                | HomeUnitModule
    m HomeUnitModule -> Set HomeUnitModule -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set HomeUnitModule
    all_home_mods = m SuccessFlag
    and_then
                | Bool
    otherwise = do
                        IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ Logger -> SDoc -> IO ()
    errorMsg Logger
    logger
                            (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "no such module:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> SDoc
    quotes (UnitId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (HomeUnitModule -> UnitId
    forall unit. GenModule unit -> unit
    moduleUnit HomeUnitModule
    m) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    colon SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> ModuleName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (HomeUnitModule -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName HomeUnitModule
    m)))
                        return SuccessFlag
    Failed

        LoadHowMuch -> m SuccessFlag -> m SuccessFlag
    checkHowMuch LoadHowMuch
    how_much (m SuccessFlag -> m SuccessFlag) -> m SuccessFlag -> m SuccessFlag
    forall a b. (a -> b) -> a -> b
    $ do

        -- mg2_with_srcimps drops the hi-boot nodes, returning a
        -- graph with cycles. It is just used for warning about unnecessary source imports.
        let mg2_with_srcimps :: [SCC ModuleGraphNode]
            mg2_with_srcimps :: [SCC ModuleGraphNode]
    mg2_with_srcimps = Bool
    -> ModuleGraph -> Maybe HomeUnitModule -> [SCC ModuleGraphNode]
    topSortModuleGraph Bool
    True ModuleGraph
    mod_graph Maybe HomeUnitModule
    forall a. Maybe a
    Nothing

        -- If we can determine that any of the {-# SOURCE #-} imports
        -- are definitely unnecessary, then emit a warning.
        [SCC ModSummary] -> m ()
    forall (m :: * -> *). GhcMonad m => [SCC ModSummary] -> m ()
    warnUnnecessarySourceImports ([SCC ModuleGraphNode] -> [SCC ModSummary]
    filterToposortToModules [SCC ModuleGraphNode]
    mg2_with_srcimps)

        let maybe_top_mod :: Maybe HomeUnitModule
    maybe_top_mod = case LoadHowMuch
    how_much of
                              LoadUpTo HomeUnitModule
    m           -> HomeUnitModule -> Maybe HomeUnitModule
    forall a. a -> Maybe a
    Just HomeUnitModule
    m
                              LoadDependenciesOf HomeUnitModule
    m -> HomeUnitModule -> Maybe HomeUnitModule
    forall a. a -> Maybe a
    Just HomeUnitModule
    m
                              LoadHowMuch
    _                    -> Maybe HomeUnitModule
    forall a. Maybe a
    Nothing

            build_plan :: [BuildPlan]
    build_plan = ModuleGraph -> Maybe HomeUnitModule -> [BuildPlan]
    createBuildPlan ModuleGraph
    mod_graph Maybe HomeUnitModule
    maybe_top_mod

        [CachedIface]
    cache <- IO [CachedIface] -> m [CachedIface]
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [CachedIface] -> m [CachedIface])
    -> IO [CachedIface] -> m [CachedIface]
    forall a b. (a -> b) -> a -> b
    $ IO [CachedIface]
    -> (ModIfaceCache -> IO [CachedIface])
    -> Maybe ModIfaceCache
    -> IO [CachedIface]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ([CachedIface] -> IO [CachedIface]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []) ModIfaceCache -> IO [CachedIface]
    iface_clearCache Maybe ModIfaceCache
    mhmi_cache
        let
            -- prune the HPT so everything is not retained when doing an
            -- upsweep.
            !pruned_cache :: [HomeModInfo]
    pruned_cache = [CachedIface] -> [ModSummary] -> [HomeModInfo]
    pruneCache [CachedIface]
    cache
                                ([SCC ModSummary] -> [ModSummary]
    forall a. [SCC a] -> [a]
    flattenSCCs ([SCC ModuleGraphNode] -> [SCC ModSummary]
    filterToposortToModules  [SCC ModuleGraphNode]
    mg2_with_srcimps))

        -- before we unload anything, make sure we don't leave an old
        -- interactive context around pointing to dead bindings.  Also,
        -- write an empty HPT to allow the old HPT to be GC'd.

        let pruneHomeUnitEnv :: HomeUnitEnv -> HomeUnitEnv
    pruneHomeUnitEnv HomeUnitEnv
    hme = HomeUnitEnv
    hme { homeUnitEnv_hpt = emptyHomePackageTable }
        HscEnv -> m ()
    forall (m :: * -> *). GhcMonad m => HscEnv -> m ()
    setSession (HscEnv -> m ()) -> HscEnv -> m ()
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> HscEnv
    discardIC (HscEnv -> HscEnv) -> HscEnv -> HscEnv
    forall a b. (a -> b) -> a -> b
    $ (UnitEnvGraph HomeUnitEnv -> UnitEnvGraph HomeUnitEnv)
    -> HscEnv -> HscEnv
    hscUpdateHUG ((HomeUnitEnv -> HomeUnitEnv)
    -> UnitEnvGraph HomeUnitEnv -> UnitEnvGraph HomeUnitEnv
    forall v. (v -> v) -> UnitEnvGraph v -> UnitEnvGraph v
    unitEnv_map HomeUnitEnv -> HomeUnitEnv
    pruneHomeUnitEnv) HscEnv
    hsc_env
        HscEnv
    hsc_env <- m HscEnv
    forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession

        -- Unload everything
        IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ Interp -> HscEnv -> IO ()
    unload Interp
    interp HscEnv
    hsc_env

        IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ Logger -> Int -> SDoc -> IO ()
    debugTraceMsg Logger
    logger Int
    2 (SDoc -> Int -> SDoc -> SDoc
    hang (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "Ready for upsweep")
                                        Int
    2 ([BuildPlan] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [BuildPlan]
    build_plan))

        WorkerLimit
    worker_limit <- IO WorkerLimit -> m WorkerLimit
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO WorkerLimit -> m WorkerLimit)
    -> IO WorkerLimit -> m WorkerLimit
    forall a b. (a -> b) -> a -> b
    $ DynFlags -> IO WorkerLimit
    mkWorkerLimit DynFlags
    dflags

        (SuccessFlag
    upsweep_ok, [HomeModInfo]
    new_deps) <- m (SuccessFlag, [HomeModInfo]) -> m (SuccessFlag, [HomeModInfo])
    forall (m :: * -> *) a. GhcMonad m => m a -> m a
    withDeferredDiagnostics (m (SuccessFlag, [HomeModInfo]) -> m (SuccessFlag, [HomeModInfo]))
    -> m (SuccessFlag, [HomeModInfo]) -> m (SuccessFlag, [HomeModInfo])
    forall a b. (a -> b) -> a -> b
    $ do
          HscEnv
    hsc_env <- m HscEnv
    forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
          IO (SuccessFlag, [HomeModInfo]) -> m (SuccessFlag, [HomeModInfo])
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (SuccessFlag, [HomeModInfo]) -> m (SuccessFlag, [HomeModInfo]))
    -> IO (SuccessFlag, [HomeModInfo])
    -> m (SuccessFlag, [HomeModInfo])
    forall a b. (a -> b) -> a -> b
    $ WorkerLimit
    -> HscEnv
    -> Maybe ModIfaceCache
    -> (GhcMessage -> AnyGhcDiagnostic)
    -> Maybe Messager
    -> Map ModNodeKeyWithUid HomeModInfo
    -> [BuildPlan]
    -> IO (SuccessFlag, [HomeModInfo])
    upsweep WorkerLimit
    worker_limit HscEnv
    hsc_env Maybe ModIfaceCache
    mhmi_cache GhcMessage -> AnyGhcDiagnostic
    diag_wrapper Maybe Messager
    mHscMessage ([HomeModInfo] -> Map ModNodeKeyWithUid HomeModInfo
    toCache [HomeModInfo]
    pruned_cache) [BuildPlan]
    build_plan
        (HscEnv -> HscEnv) -> m ()
    forall (m :: * -> *). GhcMonad m => (HscEnv -> HscEnv) -> m ()
    modifySession ([HomeModInfo] -> HscEnv -> HscEnv
    addDepsToHscEnv [HomeModInfo]
    new_deps)
        case SuccessFlag
    upsweep_ok of
          SuccessFlag
    Failed -> SuccessFlag -> m SuccessFlag
    forall (m :: * -> *). GhcMonad m => SuccessFlag -> m SuccessFlag
    loadFinish SuccessFlag
    upsweep_ok
          SuccessFlag
    Succeeded -> do
              IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ Logger -> Int -> SDoc -> IO ()
    debugTraceMsg Logger
    logger Int
    2 (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "Upsweep completely successful.")
              SuccessFlag -> m SuccessFlag
    forall (m :: * -> *). GhcMonad m => SuccessFlag -> m SuccessFlag
    loadFinish SuccessFlag
    upsweep_ok

    -- | Finish up after a load.
    loadFinish :: GhcMonad m => SuccessFlag -> m SuccessFlag
    -- Empty the interactive context and set the module context to the topmost
    -- newly loaded module, or the Prelude if none were loaded.
    loadFinish :: forall (m :: * -> *). GhcMonad m => SuccessFlag -> m SuccessFlag
    loadFinish SuccessFlag
    all_ok
      = do (HscEnv -> HscEnv) -> m ()
    forall (m :: * -> *). GhcMonad m => (HscEnv -> HscEnv) -> m ()
    modifySession HscEnv -> HscEnv
    discardIC
           return SuccessFlag
    all_ok

    -- | If there is no -o option, guess the name of target executable
    -- by using top-level source file name as a base.
    guessOutputFile :: GhcMonad m => m ()
    guessOutputFile :: forall (m :: * -> *). GhcMonad m => m ()
    guessOutputFile = (HscEnv -> HscEnv) -> m ()
    forall (m :: * -> *). GhcMonad m => (HscEnv -> HscEnv) -> m ()
    modifySession ((HscEnv -> HscEnv) -> m ()) -> (HscEnv -> HscEnv) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \HscEnv
    env ->
        -- Force mod_graph to avoid leaking env
        let !mod_graph :: ModuleGraph
    mod_graph = HscEnv -> ModuleGraph
    hsc_mod_graph HscEnv
    env
            new_home_graph :: UnitEnvGraph HomeUnitEnv
    new_home_graph =
              ((HomeUnitEnv -> HomeUnitEnv)
     -> UnitEnvGraph HomeUnitEnv -> UnitEnvGraph HomeUnitEnv)
    -> UnitEnvGraph HomeUnitEnv
    -> (HomeUnitEnv -> HomeUnitEnv)
    -> UnitEnvGraph HomeUnitEnv
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (HomeUnitEnv -> HomeUnitEnv)
    -> UnitEnvGraph HomeUnitEnv -> UnitEnvGraph HomeUnitEnv
    forall v. (v -> v) -> UnitEnvGraph v -> UnitEnvGraph v
    unitEnv_map (HscEnv -> UnitEnvGraph HomeUnitEnv
    hsc_HUG HscEnv
    env) ((HomeUnitEnv -> HomeUnitEnv) -> UnitEnvGraph HomeUnitEnv)
    -> (HomeUnitEnv -> HomeUnitEnv) -> UnitEnvGraph HomeUnitEnv
    forall a b. (a -> b) -> a -> b
    $ \HomeUnitEnv
    hue ->
                let dflags :: DynFlags
    dflags = HomeUnitEnv -> DynFlags
    homeUnitEnv_dflags HomeUnitEnv
    hue
                    platform :: Platform
    platform = DynFlags -> Platform
    targetPlatform DynFlags
    dflags
                    mainModuleSrcPath :: Maybe String
                    mainModuleSrcPath :: Maybe FilePath
    mainModuleSrcPath = do
                      ModSummary
    ms <- ModuleGraph -> Module -> Maybe ModSummary
    mgLookupModule ModuleGraph
    mod_graph (HomeUnitEnv -> Module
    mainModIs HomeUnitEnv
    hue)
                      ModLocation -> Maybe FilePath
    ml_hs_file (ModSummary -> ModLocation
    ms_location ModSummary
    ms)
                    name :: Maybe FilePath
    name = (FilePath -> FilePath) -> Maybe FilePath -> Maybe FilePath
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap FilePath -> FilePath
    dropExtension Maybe FilePath
    mainModuleSrcPath

                    -- MP: This exception is quite sensitive to being forced, if you
                    -- force it here then the error message is different because it gets
                    -- caught by a different error handler than the test (T9930fail) expects.
                    -- Putting an exception into DynFlags is probably not a great design but
                    -- I'll write this comment rather than more eagerly force the exception.
                    name_exe :: Maybe FilePath
    name_exe = do
                      -- we must add the .exe extension unconditionally here, otherwise
                      -- when name has an extension of its own, the .exe extension will
                     -- not be added by GHC.Driver.Pipeline.exeFileName.  See #2248
                     !FilePath
    name' <- case Platform -> ArchOS
    platformArchOS Platform
    platform of
                                 ArchOS Arch
    _ OS
    OSMinGW32  -> (FilePath -> FilePath) -> Maybe FilePath -> Maybe FilePath
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (FilePath -> FilePath -> FilePath
    <.> FilePath
    "exe") Maybe FilePath
    name
                                 ArchOS Arch
    ArchWasm32 OS
    _ -> (FilePath -> FilePath) -> Maybe FilePath -> Maybe FilePath
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (FilePath -> FilePath -> FilePath
    <.> FilePath
    "wasm") Maybe FilePath
    name
                                 ArchOS
    _ -> Maybe FilePath
    name
                     FilePath
    mainModuleSrcPath' <- Maybe FilePath
    mainModuleSrcPath
                     -- #9930: don't clobber input files (unless they ask for it)
                     if FilePath
    name' FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == FilePath
    mainModuleSrcPath'
                       then GhcException -> Maybe FilePath
    forall a. GhcException -> a
    throwGhcException (GhcException -> Maybe FilePath)
    -> (FilePath -> GhcException) -> FilePath -> Maybe FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> GhcException
    UsageError (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
    forall a b. (a -> b) -> a -> b
    $
                            FilePath
    "default output name would overwrite the input file; " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++
                            FilePath
    "must specify -o explicitly"
                       else FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just FilePath
    name'
                in
                  case DynFlags -> Maybe FilePath
    outputFile_ DynFlags
    dflags of
                    Just FilePath
    _ -> HomeUnitEnv
    hue
                    Maybe FilePath
    Nothing -> HomeUnitEnv
    hue {homeUnitEnv_dflags = dflags { outputFile_ = name_exe } }
        in HscEnv
    env { hsc_unit_env = (hsc_unit_env env) { ue_home_unit_graph = new_home_graph } }

    -- -----------------------------------------------------------------------------
    --
    -- | Prune the HomePackageTable
    --
    -- Before doing an upsweep, we can throw away:
    --
    --   - all ModDetails, all linked code
    --   - all unlinked code that is out of date with respect to
    --     the source file
    --
    -- This is VERY IMPORTANT otherwise we'll end up requiring 2x the
    -- space at the end of the upsweep, because the topmost ModDetails of the
    -- old HPT holds on to the entire type environment from the previous
    -- compilation.
    -- Note [GHC Heap Invariants]
    pruneCache :: [CachedIface]
                          -> [ModSummary]
                          -> [HomeModInfo]
    pruneCache :: [CachedIface] -> [ModSummary] -> [HomeModInfo]
    pruneCache [CachedIface]
    hpt [ModSummary]
    summ
      = (CachedIface -> HomeModInfo) -> [CachedIface] -> [HomeModInfo]
    forall a b. (a -> b) -> [a] -> [b]
    strictMap CachedIface -> HomeModInfo
    prune [CachedIface]
    hpt
      where prune :: CachedIface -> HomeModInfo
    prune (CachedIface { cached_modiface :: CachedIface -> ModIface
    cached_modiface = ModIface
    iface
                               , cached_linkable :: CachedIface -> HomeModLinkable
    cached_linkable = HomeModLinkable
    linkable
                               }) = ModIface -> ModDetails -> HomeModLinkable -> HomeModInfo
    HomeModInfo ModIface
    iface ModDetails
    emptyModDetails HomeModLinkable
    linkable'
              where
               modl :: ModNodeKeyWithUid
    modl = ModIface -> ModNodeKeyWithUid
    miKey ModIface
    iface
               linkable' :: HomeModLinkable
    linkable'
                    | Just ModSummary
    ms <- ModNodeKeyWithUid
    -> Map ModNodeKeyWithUid ModSummary -> Maybe ModSummary
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup ModNodeKeyWithUid
    modl Map ModNodeKeyWithUid ModSummary
    ms_map
                    , ModIface -> Fingerprint
    forall (phase :: ModIfacePhase). ModIface_ phase -> Fingerprint
    mi_src_hash ModIface
    iface Fingerprint -> Fingerprint -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ModSummary -> Fingerprint
    ms_hs_hash ModSummary
    ms
                    = HomeModLinkable
    emptyHomeModInfoLinkable
                    | Bool
    otherwise
                    = HomeModLinkable
    linkable

            -- Using UFM Module is safe for determinism because the map is just used for a transient lookup. The cache should be unique and a key clash is an error.
            ms_map :: Map ModNodeKeyWithUid ModSummary
    ms_map = (ModSummary -> ModSummary -> ModSummary)
    -> [(ModNodeKeyWithUid, ModSummary)]
    -> Map ModNodeKeyWithUid ModSummary
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    M.fromListWith
                      (\ModSummary
    ms1 ModSummary
    ms2 -> Bool -> SDoc -> ModSummary -> ModSummary
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr Bool
    False (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "prune_cache" SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ (ModSummary -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ModSummary
    ms1 SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> ModSummary -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ModSummary
    ms2))
                                   ModSummary
    ms2)
                      [(ModSummary -> ModNodeKeyWithUid
    msKey ModSummary
    ms, ModSummary
    ms) | ModSummary
    ms <- [ModSummary]
    summ]

    -- ---------------------------------------------------------------------------
    --
    -- | Unloading
    unload :: Interp -> HscEnv -> IO ()
    unload :: Interp -> HscEnv -> IO ()
    unload Interp
    interp HscEnv
    hsc_env
      = case DynFlags -> GhcLink
    ghcLink (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env) of
            GhcLink
    LinkInMemory -> Interp -> HscEnv -> [Linkable] -> IO ()
    Linker.unload Interp
    interp HscEnv
    hsc_env []
            GhcLink
    _other -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    {- Parallel Upsweep

    The parallel upsweep attempts to concurrently compile the modules in the
    compilation graph using multiple Haskell threads.

    The Algorithm

    * The list of `MakeAction`s are created by `interpretBuildPlan`. A `MakeAction` is
    a pair of an `IO a` action and a `MVar a`, where to place the result.
      The list is sorted topologically, so can be executed in order without fear of
      blocking.
    * runPipelines takes this list and eventually passes it to runLoop which executes
      each action and places the result into the right MVar.
    * The amount of parallelism is controlled by a semaphore. This is just used around the
      module compilation step, so that only the right number of modules are compiled at
      the same time which reduces overall memory usage and allocations.
    * Each proper node has a LogQueue, which dictates where to send it's output.
    * The LogQueue is placed into the LogQueueQueue when the action starts and a worker
      thread processes the LogQueueQueue printing logs for each module in a stable order.
    * The result variable for an action producing `a` is of type `Maybe a`, therefore
      it is still filled on a failure. If a module fails to compile, the
      failure is propagated through the whole module graph and any modules which didn't
      depend on the failure can still be compiled. This behaviour also makes the code
      quite a bit cleaner.
    -}

    {-

    Note [--make mode]
    ~~~~~~~~~~~~~~~~~
    There are two main parts to `--make` mode.

    1. `downsweep`: Starts from the top of the module graph and computes dependencies.
    2. `upsweep`: Starts from the bottom of the module graph and compiles modules.

    The result of the downsweep is a 'ModuleGraph', which is then passed to 'upsweep' which
    computers how to build this ModuleGraph.

    Note [Upsweep]
    ~~~~~~~~~~~~~~
    Upsweep takes a 'ModuleGraph' as input, computes a build plan and then executes
    the plan in order to compile the project.

    The first step is computing the build plan from a 'ModuleGraph'.

    The output of this step is a `[BuildPlan]`, which is a topologically sorted plan for
    how to build all the modules.

    ```
    data BuildPlan = SingleModule ModuleGraphNode  -- A simple, single module all alone but *might* have an hs-boot file which isn't part of a cycle
                   | ResolvedCycle [Either ModuleGraphNode ModuleGraphNodeWithBoot]   -- A resolved cycle, linearised by hs-boot files
                   | UnresolvedCycle [ModuleGraphNode] -- An actual cycle, which wasn't resolved by hs-boot files
    ```

    The plan is computed in two steps:

    Step 1:  Topologically sort the module graph without hs-boot files. This returns a [SCC ModuleGraphNode] which contains
             cycles.
    Step 2:  For each cycle, topologically sort the modules in the cycle *with* the relevant hs-boot files. This should
             result in an acyclic build plan if the hs-boot files are sufficient to resolve the cycle.
    Step 2a: For each module in the cycle, if the module has a boot file then compute the
             modules on the path between it and the hs-boot file.
             These are the intermediate modules which:
                (1) are (transitive) dependencies of the non-boot module, and
                (2) have the boot module as a (transitive) dependency.
             In particular, all such intermediate modules must appear in the same unit as
             the module under consideration, as module cycles cannot cross unit boundaries.
             This information is stored in ModuleGraphNodeWithBoot.

    The `[BuildPlan]` is then interpreted by the `interpretBuildPlan` function.

    * SingleModule nodes are compiled normally by either the upsweep_inst or upsweep_mod functions.
    * ResolvedCycles need to compiled "together" so that modules outside the cycle are presented
      with a consistent knot-tied version of modules at the end.
        - When the ModuleGraphNodeWithBoot nodes are compiled then suitable rehydration
          is performed both before and after the module in question is compiled.
          See Note [Hydrating Modules] for more information.
    * UnresolvedCycles are indicative of a proper cycle, unresolved by hs-boot files
      and are reported as an error to the user.

    The main trickiness of `interpretBuildPlan` is deciding which version of a dependency
    is visible from each module. For modules which are not in a cycle, there is just
    one version of a module, so that is always used. For modules in a cycle, there are two versions of
    'HomeModInfo'.

    1. Internal to loop: The version created whilst compiling the loop by upsweep_mod.
    2. External to loop: The knot-tied version created by typecheckLoop.

    Whilst compiling a module inside the loop, we need to use the (1). For a module which
    is outside of the loop which depends on something from in the loop, the (2) version
    is used.

    As the plan is interpreted, which version of a HomeModInfo is visible is updated
    by updating a map held in a state monad. So after a loop has finished being compiled,
    the visible module is the one created by typecheckLoop and the internal version is not
    used again.

    This plan also ensures the most important invariant to do with module loops:

    > If you depend on anything within a module loop, before you can use the dependency,
      the whole loop has to finish compiling.

    The end result of `interpretBuildPlan` is a `[MakeAction]`, which are pairs
    of `IO a` actions and a `MVar (Maybe a)`, somewhere to put the result of running
    the action. This list is topologically sorted, so can be run in order to compute
    the whole graph.

    As well as this `interpretBuildPlan` also outputs an `IO [Maybe (Maybe HomeModInfo)]` which
    can be queried at the end to get the result of all modules at the end, with their proper
    visibility. For example, if any module in a loop fails then all modules in that loop will
    report as failed because the visible node at the end will be the result of checking
    these modules together.

    -}

    -- | Simple wrapper around MVar which allows a functor instance.
    data ResultVar b = forall a . ResultVar (a -> b) (MVar (Maybe a))

    deriving instance Functor ResultVar

    mkResultVar :: MVar (Maybe a) -> ResultVar a
    mkResultVar :: forall a. MVar (Maybe a) -> ResultVar a
    mkResultVar = (a -> a) -> MVar (Maybe a) -> ResultVar a
    forall b a. (a -> b) -> MVar (Maybe a) -> ResultVar b
    ResultVar a -> a
    forall a. a -> a
    id

    -- | Block until the result is ready.
    waitResult :: ResultVar a -> MaybeT IO a
    waitResult :: forall a. ResultVar a -> MaybeT IO a
    waitResult (ResultVar a -> a
    f MVar (Maybe a)
    var) = IO (Maybe a) -> MaybeT IO a
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
    MaybeT ((a -> a) -> Maybe a -> Maybe a
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> a
    f (Maybe a -> Maybe a) -> IO (Maybe a) -> IO (Maybe a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> MVar (Maybe a) -> IO (Maybe a)
    forall a. MVar a -> IO a
    readMVar MVar (Maybe a)
    var)

    data BuildResult = BuildResult { BuildResult -> ResultOrigin
    _resultOrigin :: ResultOrigin
                                   , BuildResult -> ResultVar (Maybe HomeModInfo, ModuleNameSet)
    resultVar    :: ResultVar (Maybe HomeModInfo, ModuleNameSet)
                                   }

    -- The origin of this result var, useful for debugging
    data ResultOrigin = NoLoop | Loop ResultLoopOrigin deriving (Int -> ResultOrigin -> FilePath -> FilePath
    [ResultOrigin] -> FilePath -> FilePath
    ResultOrigin -> FilePath
    (Int -> ResultOrigin -> FilePath -> FilePath)
    -> (ResultOrigin -> FilePath)
    -> ([ResultOrigin] -> FilePath -> FilePath)
    -> Show ResultOrigin
    forall a.
    (Int -> a -> FilePath -> FilePath)
    -> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
    $cshowsPrec :: Int -> ResultOrigin -> FilePath -> FilePath
    showsPrec :: Int -> ResultOrigin -> FilePath -> FilePath
    $cshow :: ResultOrigin -> FilePath
    show :: ResultOrigin -> FilePath
    $cshowList :: [ResultOrigin] -> FilePath -> FilePath
    showList :: [ResultOrigin] -> FilePath -> FilePath
    Show)

    data ResultLoopOrigin = Initialise | Rehydrated | Finalised deriving (Int -> ResultLoopOrigin -> FilePath -> FilePath
    [ResultLoopOrigin] -> FilePath -> FilePath
    ResultLoopOrigin -> FilePath
    (Int -> ResultLoopOrigin -> FilePath -> FilePath)
    -> (ResultLoopOrigin -> FilePath)
    -> ([ResultLoopOrigin] -> FilePath -> FilePath)
    -> Show ResultLoopOrigin
    forall a.
    (Int -> a -> FilePath -> FilePath)
    -> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
    $cshowsPrec :: Int -> ResultLoopOrigin -> FilePath -> FilePath
    showsPrec :: Int -> ResultLoopOrigin -> FilePath -> FilePath
    $cshow :: ResultLoopOrigin -> FilePath
    show :: ResultLoopOrigin -> FilePath
    $cshowList :: [ResultLoopOrigin] -> FilePath -> FilePath
    showList :: [ResultLoopOrigin] -> FilePath -> FilePath
    Show)

    mkBuildResult :: ResultOrigin -> ResultVar (Maybe HomeModInfo, ModuleNameSet) -> BuildResult
    mkBuildResult :: ResultOrigin
    -> ResultVar (Maybe HomeModInfo, ModuleNameSet) -> BuildResult
    mkBuildResult = ResultOrigin
    -> ResultVar (Maybe HomeModInfo, ModuleNameSet) -> BuildResult
    BuildResult

    data BuildLoopState = BuildLoopState { BuildLoopState -> Map NodeKey BuildResult
    buildDep :: M.Map NodeKey BuildResult
                                              -- The current way to build a specific TNodeKey, without cycles this just points to
                                              -- the appropriate result of compiling a module  but with
                                              -- cycles there can be additional indirection and can point to the result of typechecking a loop
                                         , BuildLoopState -> Int
    nNODE :: Int
                                         , BuildLoopState -> MVar (UnitEnvGraph HomeUnitEnv)
    hug_var :: MVar HomeUnitGraph
                                         -- A global variable which is incrementally updated with the result
                                         -- of compiling modules.
                                         }

    nodeId :: BuildM Int
    nodeId :: BuildM Int
    nodeId = do
      Int
    n <- (BuildLoopState -> Int) -> BuildM Int
    forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
    gets BuildLoopState -> Int
    nNODE
      (BuildLoopState -> BuildLoopState) -> StateT BuildLoopState IO ()
    forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
    modify (\BuildLoopState
    m -> BuildLoopState
    m { nNODE = n + 1 })
      return Int
    n

    setModulePipeline :: NodeKey -> BuildResult -> BuildM ()
    setModulePipeline :: NodeKey -> BuildResult -> StateT BuildLoopState IO ()
    setModulePipeline NodeKey
    mgn BuildResult
    build_result = do
      (BuildLoopState -> BuildLoopState) -> StateT BuildLoopState IO ()
    forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
    modify (\BuildLoopState
    m -> BuildLoopState
    m { buildDep = M.insert mgn build_result (buildDep m) })

    type BuildMap = M.Map NodeKey BuildResult

    getBuildMap :: BuildM BuildMap
    getBuildMap :: BuildM (Map NodeKey BuildResult)
    getBuildMap = (BuildLoopState -> Map NodeKey BuildResult)
    -> BuildM (Map NodeKey BuildResult)
    forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
    gets BuildLoopState -> Map NodeKey BuildResult
    buildDep

    getDependencies :: [NodeKey] -> BuildMap -> [BuildResult]
    getDependencies :: [NodeKey] -> Map NodeKey BuildResult -> [BuildResult]
    getDependencies [NodeKey]
    direct_deps Map NodeKey BuildResult
    build_map =
      (NodeKey -> BuildResult) -> [NodeKey] -> [BuildResult]
    forall a b. (a -> b) -> [a] -> [b]
    strictMap (FilePath -> Maybe BuildResult -> BuildResult
    forall a. HasCallStack => FilePath -> Maybe a -> a
    expectJust FilePath
    "dep_map" (Maybe BuildResult -> BuildResult)
    -> (NodeKey -> Maybe BuildResult) -> NodeKey -> BuildResult
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (NodeKey -> Map NodeKey BuildResult -> Maybe BuildResult)
    -> Map NodeKey BuildResult -> NodeKey -> Maybe BuildResult
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip NodeKey -> Map NodeKey BuildResult -> Maybe BuildResult
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Map NodeKey BuildResult
    build_map) [NodeKey]
    direct_deps

    type BuildM a = StateT BuildLoopState IO a

    -- | Environment used when compiling a module
    data MakeEnv = MakeEnv { MakeEnv -> HscEnv
    hsc_env :: !HscEnv -- The basic HscEnv which will be augmented for each module
                           , MakeEnv -> AbstractSem
    compile_sem :: !AbstractSem
                           -- Modify the environment for module k, with the supplied logger modification function.
                           -- For -j1, this wrapper doesn't do anything
                           -- For -jn, the wrapper initialised a log queue and then modifies the logger to pipe its output
                           --          into the log queue.
                           , MakeEnv -> forall a. Int -> ((Logger -> Logger) -> IO a) -> IO a
    withLogger :: forall a . Int -> ((Logger -> Logger) -> IO a) -> IO a
                           , MakeEnv -> Maybe Messager
    env_messager :: !(Maybe Messager)
                           , MakeEnv -> GhcMessage -> AnyGhcDiagnostic
    diag_wrapper :: GhcMessage -> AnyGhcDiagnostic
                           }

    type RunMakeM a = ReaderT MakeEnv (MaybeT IO) a

    -- | Given the build plan, creates a graph which indicates where each NodeKey should
    -- get its direct dependencies from. This might not be the corresponding build action
    -- if the module participates in a loop. This step also labels each node with a number for the output.
    -- See Note [Upsweep] for a high-level description.
    interpretBuildPlan :: HomeUnitGraph
                       -> Maybe ModIfaceCache
                       -> M.Map ModNodeKeyWithUid HomeModInfo
                       -> [BuildPlan]
                       -> IO ( Maybe [ModuleGraphNode] -- Is there an unresolved cycle
                             , [MakeAction] -- Actions we need to run in order to build everything
                             , IO [Maybe (Maybe HomeModInfo)]) -- An action to query to get all the built modules at the end.
    interpretBuildPlan :: UnitEnvGraph HomeUnitEnv
    -> Maybe ModIfaceCache
    -> Map ModNodeKeyWithUid HomeModInfo
    -> [BuildPlan]
    -> IO
         (Maybe [ModuleGraphNode], [MakeAction],
          IO [Maybe (Maybe HomeModInfo)])
    interpretBuildPlan UnitEnvGraph HomeUnitEnv
    hug Maybe ModIfaceCache
    mhmi_cache Map ModNodeKeyWithUid HomeModInfo
    old_hpt [BuildPlan]
    plan = do
      MVar (UnitEnvGraph HomeUnitEnv)
    hug_var <- UnitEnvGraph HomeUnitEnv -> IO (MVar (UnitEnvGraph HomeUnitEnv))
    forall a. a -> IO (MVar a)
    newMVar UnitEnvGraph HomeUnitEnv
    hug
      ((Maybe [ModuleGraphNode]
    mcycle, [MakeAction]
    plans), BuildLoopState
    build_map) <- StateT BuildLoopState IO (Maybe [ModuleGraphNode], [MakeAction])
    -> BuildLoopState
    -> IO ((Maybe [ModuleGraphNode], [MakeAction]), BuildLoopState)
    forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
    runStateT ([BuildPlan]
    -> StateT BuildLoopState IO (Maybe [ModuleGraphNode], [MakeAction])
    buildLoop [BuildPlan]
    plan) (Map NodeKey BuildResult
    -> Int -> MVar (UnitEnvGraph HomeUnitEnv) -> BuildLoopState
    BuildLoopState Map NodeKey BuildResult
    forall k a. Map k a
    M.empty Int
    1 MVar (UnitEnvGraph HomeUnitEnv)
    hug_var)
      let wait :: IO [Maybe (Maybe HomeModInfo)]
    wait = Map NodeKey BuildResult -> IO [Maybe (Maybe HomeModInfo)]
    forall {k}. Map k BuildResult -> IO [Maybe (Maybe HomeModInfo)]
    collect_results (BuildLoopState -> Map NodeKey BuildResult
    buildDep BuildLoopState
    build_map)
      (Maybe [ModuleGraphNode], [MakeAction],
     IO [Maybe (Maybe HomeModInfo)])
    -> IO
         (Maybe [ModuleGraphNode], [MakeAction],
          IO [Maybe (Maybe HomeModInfo)])
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    return (Maybe [ModuleGraphNode]
    mcycle, [MakeAction]
    plans, IO [Maybe (Maybe HomeModInfo)]
    wait)

      where
        collect_results :: Map k BuildResult -> IO [Maybe (Maybe HomeModInfo)]
    collect_results Map k BuildResult
    build_map =
          [IO (Maybe (Maybe HomeModInfo))] -> IO [Maybe (Maybe HomeModInfo)]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence ((BuildResult -> IO (Maybe (Maybe HomeModInfo)))
    -> [BuildResult] -> [IO (Maybe (Maybe HomeModInfo))]
    forall a b. (a -> b) -> [a] -> [b]
    map (\BuildResult
    br -> ResultVar (Maybe HomeModInfo) -> IO (Maybe (Maybe HomeModInfo))
    forall {a}. ResultVar a -> IO (Maybe a)
    collect_result ((Maybe HomeModInfo, ModuleNameSet) -> Maybe HomeModInfo
    forall a b. (a, b) -> a
    fst ((Maybe HomeModInfo, ModuleNameSet) -> Maybe HomeModInfo)
    -> ResultVar (Maybe HomeModInfo, ModuleNameSet)
    -> ResultVar (Maybe HomeModInfo)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> BuildResult -> ResultVar (Maybe HomeModInfo, ModuleNameSet)
    resultVar BuildResult
    br)) (Map k BuildResult -> [BuildResult]
    forall k a. Map k a -> [a]
    M.elems Map k BuildResult
    build_map))
          where
            collect_result :: ResultVar a -> IO (Maybe a)
    collect_result ResultVar a
    res_var = MaybeT IO a -> IO (Maybe a)
    forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
    runMaybeT (ResultVar a -> MaybeT IO a
    forall a. ResultVar a -> MaybeT IO a
    waitResult ResultVar a
    res_var)

        n_mods :: Int
    n_mods = [Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ((BuildPlan -> Int) -> [BuildPlan] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map BuildPlan -> Int
    countMods [BuildPlan]
    plan)

        buildLoop :: [BuildPlan]
                  -> BuildM (Maybe [ModuleGraphNode], [MakeAction])
        -- Build the abstract pipeline which we can execute
        -- Building finished
        buildLoop :: [BuildPlan]
    -> StateT BuildLoopState IO (Maybe [ModuleGraphNode], [MakeAction])
    buildLoop []           = (Maybe [ModuleGraphNode], [MakeAction])
    -> StateT BuildLoopState IO (Maybe [ModuleGraphNode], [MakeAction])
    forall a. a -> StateT BuildLoopState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe [ModuleGraphNode]
    forall a. Maybe a
    Nothing, [])
        buildLoop (BuildPlan
    plan:[BuildPlan]
    plans) =
          case BuildPlan
    plan of
            -- If there was no cycle, then typecheckLoop is not necessary
            SingleModule ModuleGraphNode
    m -> do
              MakeAction
    one_plan <- Maybe [NodeKey]
    -> ResultOrigin
    -> ModuleGraphNode
    -> StateT BuildLoopState IO MakeAction
    buildSingleModule Maybe [NodeKey]
    forall a. Maybe a
    Nothing ResultOrigin
    NoLoop ModuleGraphNode
    m
              (Maybe [ModuleGraphNode]
    cycle, [MakeAction]
    all_plans) <- [BuildPlan]
    -> StateT BuildLoopState IO (Maybe [ModuleGraphNode], [MakeAction])
    buildLoop [BuildPlan]
    plans
              return (Maybe [ModuleGraphNode]
    cycle, MakeAction
    one_plan MakeAction -> [MakeAction] -> [MakeAction]
    forall a. a -> [a] -> [a]
    : [MakeAction]
    all_plans)

            -- For a resolved cycle, depend on everything in the loop, then update
            -- the cache to point to this node rather than directly to the module build
            -- nodes
            ResolvedCycle [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    ms -> do
              [MakeAction]
    pipes <- [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    -> StateT BuildLoopState IO [MakeAction]
    buildModuleLoop [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    ms
              (Maybe [ModuleGraphNode]
    cycle, [MakeAction]
    graph) <- [BuildPlan]
    -> StateT BuildLoopState IO (Maybe [ModuleGraphNode], [MakeAction])
    buildLoop [BuildPlan]
    plans
              return (Maybe [ModuleGraphNode]
    cycle, [MakeAction]
    pipes [MakeAction] -> [MakeAction] -> [MakeAction]
    forall a. [a] -> [a] -> [a]
    ++ [MakeAction]
    graph)

            -- Can't continue past this point as the cycle is unresolved.
            UnresolvedCycle [ModuleGraphNode]
    ns -> (Maybe [ModuleGraphNode], [MakeAction])
    -> StateT BuildLoopState IO (Maybe [ModuleGraphNode], [MakeAction])
    forall a. a -> StateT BuildLoopState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([ModuleGraphNode] -> Maybe [ModuleGraphNode]
    forall a. a -> Maybe a
    Just [ModuleGraphNode]
    ns, [])

        buildSingleModule :: Maybe [NodeKey]  -- Modules we need to rehydrate before compiling this module
                          -> ResultOrigin
                          -> ModuleGraphNode          -- The node we are compiling
                          -> BuildM MakeAction
        buildSingleModule :: Maybe [NodeKey]
    -> ResultOrigin
    -> ModuleGraphNode
    -> StateT BuildLoopState IO MakeAction
    buildSingleModule Maybe [NodeKey]
    rehydrate_nodes ResultOrigin
    origin ModuleGraphNode
    mod = do
          Int
    mod_idx <- BuildM Int
    nodeId
          !Map NodeKey BuildResult
    build_map <- BuildM (Map NodeKey BuildResult)
    getBuildMap
          MVar (UnitEnvGraph HomeUnitEnv)
    hug_var <- (BuildLoopState -> MVar (UnitEnvGraph HomeUnitEnv))
    -> StateT BuildLoopState IO (MVar (UnitEnvGraph HomeUnitEnv))
    forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
    gets BuildLoopState -> MVar (UnitEnvGraph HomeUnitEnv)
    hug_var
          -- 1. Get the direct dependencies of this module
          let direct_deps :: [NodeKey]
    direct_deps = Bool -> ModuleGraphNode -> [NodeKey]
    nodeDependencies Bool
    False ModuleGraphNode
    mod
              -- It's really important to force build_deps, or the whole buildMap is retained,
              -- which would retain all the result variables, preventing us from collecting them
              -- after they are no longer used.
              !build_deps :: [BuildResult]
    build_deps = [NodeKey] -> Map NodeKey BuildResult -> [BuildResult]
    getDependencies [NodeKey]
    direct_deps Map NodeKey BuildResult
    build_map
          let !build_action :: RunMakeM (Maybe HomeModInfo, ModuleNameSet)
    build_action =
                case ModuleGraphNode
    mod of
                  InstantiationNode UnitId
    uid InstantiatedUnit
    iu -> do
                    UnitId
    -> RunMakeM (Maybe HomeModInfo, ModuleNameSet)
    -> RunMakeM (Maybe HomeModInfo, ModuleNameSet)
    forall a. UnitId -> RunMakeM a -> RunMakeM a
    withCurrentUnit (ModuleGraphNode -> UnitId
    moduleGraphNodeUnitId ModuleGraphNode
    mod) (RunMakeM (Maybe HomeModInfo, ModuleNameSet)
     -> RunMakeM (Maybe HomeModInfo, ModuleNameSet))
    -> RunMakeM (Maybe HomeModInfo, ModuleNameSet)
    -> RunMakeM (Maybe HomeModInfo, ModuleNameSet)
    forall a b. (a -> b) -> a -> b
    $ do
                      (UnitEnvGraph HomeUnitEnv
    hug, ModuleNameSet
    deps) <- MVar (UnitEnvGraph HomeUnitEnv)
    -> [BuildResult]
    -> ReaderT
         MakeEnv (MaybeT IO) (UnitEnvGraph HomeUnitEnv, ModuleNameSet)
    wait_deps_hug MVar (UnitEnvGraph HomeUnitEnv)
    hug_var [BuildResult]
    build_deps
                      Int
    -> Int
    -> UnitEnvGraph HomeUnitEnv
    -> UnitId
    -> InstantiatedUnit
    -> ReaderT MakeEnv (MaybeT IO) ()
    executeInstantiationNode Int
    mod_idx Int
    n_mods UnitEnvGraph HomeUnitEnv
    hug UnitId
    uid InstantiatedUnit
    iu
                      return (Maybe HomeModInfo
    forall a. Maybe a
    Nothing, ModuleNameSet
    deps)
                  ModuleNode [NodeKey]
    _build_deps ModSummary
    ms ->
                    let !old_hmi :: Maybe HomeModInfo
    old_hmi = ModNodeKeyWithUid
    -> Map ModNodeKeyWithUid HomeModInfo -> Maybe HomeModInfo
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup (ModSummary -> ModNodeKeyWithUid
    msKey ModSummary
    ms) Map ModNodeKeyWithUid HomeModInfo
    old_hpt
                        rehydrate_mods :: Maybe [ModuleName]
    rehydrate_mods = (NodeKey -> Maybe ModuleName) -> [NodeKey] -> [ModuleName]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe NodeKey -> Maybe ModuleName
    nodeKeyModName ([NodeKey] -> [ModuleName])
    -> Maybe [NodeKey] -> Maybe [ModuleName]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe [NodeKey]
    rehydrate_nodes
                    in UnitId
    -> RunMakeM (Maybe HomeModInfo, ModuleNameSet)
    -> RunMakeM (Maybe HomeModInfo, ModuleNameSet)
    forall a. UnitId -> RunMakeM a -> RunMakeM a
    withCurrentUnit (ModuleGraphNode -> UnitId
    moduleGraphNodeUnitId ModuleGraphNode
    mod) (RunMakeM (Maybe HomeModInfo, ModuleNameSet)
     -> RunMakeM (Maybe HomeModInfo, ModuleNameSet))
    -> RunMakeM (Maybe HomeModInfo, ModuleNameSet)
    -> RunMakeM (Maybe HomeModInfo, ModuleNameSet)
    forall a b. (a -> b) -> a -> b
    $ do
                         (UnitEnvGraph HomeUnitEnv
    hug, ModuleNameSet
    deps) <- MVar (UnitEnvGraph HomeUnitEnv)
    -> [BuildResult]
    -> ReaderT
         MakeEnv (MaybeT IO) (UnitEnvGraph HomeUnitEnv, ModuleNameSet)
    wait_deps_hug MVar (UnitEnvGraph HomeUnitEnv)
    hug_var [BuildResult]
    build_deps
                         HomeModInfo
    hmi <- Int
    -> Int
    -> Maybe HomeModInfo
    -> UnitEnvGraph HomeUnitEnv
    -> Maybe [ModuleName]
    -> ModSummary
    -> ReaderT MakeEnv (MaybeT IO) HomeModInfo
    executeCompileNode Int
    mod_idx Int
    n_mods Maybe HomeModInfo
    old_hmi UnitEnvGraph HomeUnitEnv
    hug Maybe [ModuleName]
    rehydrate_mods ModSummary
    ms
                         -- Write the HMI to an external cache (if one exists)
                         -- See Note [Caching HomeModInfo]
                         IO (Maybe ()) -> ReaderT MakeEnv (MaybeT IO) (Maybe ())
    forall a. IO a -> ReaderT MakeEnv (MaybeT IO) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe ()) -> ReaderT MakeEnv (MaybeT IO) (Maybe ()))
    -> IO (Maybe ()) -> ReaderT MakeEnv (MaybeT IO) (Maybe ())
    forall a b. (a -> b) -> a -> b
    $ Maybe ModIfaceCache -> (ModIfaceCache -> IO ()) -> IO (Maybe ())
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM Maybe ModIfaceCache
    mhmi_cache ((ModIfaceCache -> IO ()) -> IO (Maybe ()))
    -> (ModIfaceCache -> IO ()) -> IO (Maybe ())
    forall a b. (a -> b) -> a -> b
    $ \ModIfaceCache
    hmi_cache -> ModIfaceCache -> HomeModInfo -> IO ()
    addHmiToCache ModIfaceCache
    hmi_cache HomeModInfo
    hmi
                         -- This global MVar is incrementally modified in order to avoid having to
                         -- recreate the HPT before compiling each module which leads to a quadratic amount of work.
                         IO () -> ReaderT MakeEnv (MaybeT IO) ()
    forall a. IO a -> ReaderT MakeEnv (MaybeT IO) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> ReaderT MakeEnv (MaybeT IO) ())
    -> IO () -> ReaderT MakeEnv (MaybeT IO) ()
    forall a b. (a -> b) -> a -> b
    $ MVar (UnitEnvGraph HomeUnitEnv)
    -> (UnitEnvGraph HomeUnitEnv -> IO (UnitEnvGraph HomeUnitEnv))
    -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_ MVar (UnitEnvGraph HomeUnitEnv)
    hug_var (UnitEnvGraph HomeUnitEnv -> IO (UnitEnvGraph HomeUnitEnv)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (UnitEnvGraph HomeUnitEnv -> IO (UnitEnvGraph HomeUnitEnv))
    -> (UnitEnvGraph HomeUnitEnv -> UnitEnvGraph HomeUnitEnv)
    -> UnitEnvGraph HomeUnitEnv
    -> IO (UnitEnvGraph HomeUnitEnv)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HomeModInfo -> UnitEnvGraph HomeUnitEnv -> UnitEnvGraph HomeUnitEnv
    addHomeModInfoToHug HomeModInfo
    hmi)
                         return (HomeModInfo -> Maybe HomeModInfo
    forall a. a -> Maybe a
    Just HomeModInfo
    hmi, UnitId -> ModuleName -> ModuleNameSet -> ModuleNameSet
    addToModuleNameSet (ModuleGraphNode -> UnitId
    moduleGraphNodeUnitId ModuleGraphNode
    mod) (ModSummary -> ModuleName
    ms_mod_name ModSummary
    ms) ModuleNameSet
    deps )
                  LinkNode [NodeKey]
    _nks UnitId
    uid -> do
                      UnitId
    -> RunMakeM (Maybe HomeModInfo, ModuleNameSet)
    -> RunMakeM (Maybe HomeModInfo, ModuleNameSet)
    forall a. UnitId -> RunMakeM a -> RunMakeM a
    withCurrentUnit (ModuleGraphNode -> UnitId
    moduleGraphNodeUnitId ModuleGraphNode
    mod) (RunMakeM (Maybe HomeModInfo, ModuleNameSet)
     -> RunMakeM (Maybe HomeModInfo, ModuleNameSet))
    -> RunMakeM (Maybe HomeModInfo, ModuleNameSet)
    -> RunMakeM (Maybe HomeModInfo, ModuleNameSet)
    forall a b. (a -> b) -> a -> b
    $ do
                        (UnitEnvGraph HomeUnitEnv
    hug, ModuleNameSet
    deps) <- MVar (UnitEnvGraph HomeUnitEnv)
    -> [BuildResult]
    -> ReaderT
         MakeEnv (MaybeT IO) (UnitEnvGraph HomeUnitEnv, ModuleNameSet)
    wait_deps_hug MVar (UnitEnvGraph HomeUnitEnv)
    hug_var [BuildResult]
    build_deps
                        UnitEnvGraph HomeUnitEnv
    -> (Int, Int)
    -> UnitId
    -> [NodeKey]
    -> ReaderT MakeEnv (MaybeT IO) ()
    executeLinkNode UnitEnvGraph HomeUnitEnv
    hug (Int
    mod_idx, Int
    n_mods) UnitId
    uid [NodeKey]
    direct_deps
                        return (Maybe HomeModInfo
    forall a. Maybe a
    Nothing, ModuleNameSet
    deps)

          MVar (Maybe (Maybe HomeModInfo, ModuleNameSet))
    res_var <- IO (MVar (Maybe (Maybe HomeModInfo, ModuleNameSet)))
    -> StateT
         BuildLoopState IO (MVar (Maybe (Maybe HomeModInfo, ModuleNameSet)))
    forall a. IO a -> StateT BuildLoopState IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO (MVar (Maybe (Maybe HomeModInfo, ModuleNameSet)))
    forall a. IO (MVar a)
    newEmptyMVar
          let result_var :: ResultVar (Maybe HomeModInfo, ModuleNameSet)
    result_var = MVar (Maybe (Maybe HomeModInfo, ModuleNameSet))
    -> ResultVar (Maybe HomeModInfo, ModuleNameSet)
    forall a. MVar (Maybe a) -> ResultVar a
    mkResultVar MVar (Maybe (Maybe HomeModInfo, ModuleNameSet))
    res_var
          NodeKey -> BuildResult -> StateT BuildLoopState IO ()
    setModulePipeline (ModuleGraphNode -> NodeKey
    mkNodeKey ModuleGraphNode
    mod) (ResultOrigin
    -> ResultVar (Maybe HomeModInfo, ModuleNameSet) -> BuildResult
    mkBuildResult ResultOrigin
    origin ResultVar (Maybe HomeModInfo, ModuleNameSet)
    result_var)
          MakeAction -> StateT BuildLoopState IO MakeAction
    forall a. a -> StateT BuildLoopState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (MakeAction -> StateT BuildLoopState IO MakeAction)
    -> MakeAction -> StateT BuildLoopState IO MakeAction
    forall a b. (a -> b) -> a -> b
    $! (RunMakeM (Maybe HomeModInfo, ModuleNameSet)
    -> MVar (Maybe (Maybe HomeModInfo, ModuleNameSet)) -> MakeAction
    forall a. RunMakeM a -> MVar (Maybe a) -> MakeAction
    MakeAction RunMakeM (Maybe HomeModInfo, ModuleNameSet)
    build_action MVar (Maybe (Maybe HomeModInfo, ModuleNameSet))
    res_var)

        buildOneLoopyModule :: ModuleGraphNodeWithBootFile -> BuildM [MakeAction]
        buildOneLoopyModule :: ModuleGraphNodeWithBootFile
    -> StateT BuildLoopState IO [MakeAction]
    buildOneLoopyModule (ModuleGraphNodeWithBootFile ModuleGraphNode
    mn [NodeKey]
    deps) = do
          MakeAction
    ma <- Maybe [NodeKey]
    -> ResultOrigin
    -> ModuleGraphNode
    -> StateT BuildLoopState IO MakeAction
    buildSingleModule ([NodeKey] -> Maybe [NodeKey]
    forall a. a -> Maybe a
    Just [NodeKey]
    deps) (ResultLoopOrigin -> ResultOrigin
    Loop ResultLoopOrigin
    Initialise) ModuleGraphNode
    mn
          -- Rehydration (1) from Note [Hydrating Modules], "Loops with multiple boot files"
          MakeAction
    rehydrate_action <- ResultLoopOrigin
    -> [GenWithIsBoot NodeKey] -> StateT BuildLoopState IO MakeAction
    rehydrateAction ResultLoopOrigin
    Rehydrated ((NodeKey -> IsBootInterface -> GenWithIsBoot NodeKey
    forall mod. mod -> IsBootInterface -> GenWithIsBoot mod
    GWIB (ModuleGraphNode -> NodeKey
    mkNodeKey ModuleGraphNode
    mn) IsBootInterface
    IsBoot) GenWithIsBoot NodeKey
    -> [GenWithIsBoot NodeKey] -> [GenWithIsBoot NodeKey]
    forall a. a -> [a] -> [a]
    : ((NodeKey -> GenWithIsBoot NodeKey)
    -> [NodeKey] -> [GenWithIsBoot NodeKey]
    forall a b. (a -> b) -> [a] -> [b]
    map (\NodeKey
    d -> NodeKey -> IsBootInterface -> GenWithIsBoot NodeKey
    forall mod. mod -> IsBootInterface -> GenWithIsBoot mod
    GWIB NodeKey
    d IsBootInterface
    NotBoot) [NodeKey]
    deps))
          return $ [MakeAction
    ma, MakeAction
    rehydrate_action]

        buildModuleLoop :: [Either ModuleGraphNode ModuleGraphNodeWithBootFile] -> BuildM [MakeAction]
        buildModuleLoop :: [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    -> StateT BuildLoopState IO [MakeAction]
    buildModuleLoop [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    ms = do
          [MakeAction]
    build_modules <- (Either ModuleGraphNode ModuleGraphNodeWithBootFile
     -> StateT BuildLoopState IO [MakeAction])
    -> [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    -> StateT BuildLoopState IO [MakeAction]
    forall (m :: * -> *) (f :: * -> *) a b.
    (Monad m, Traversable f) =>
    (a -> m [b]) -> f a -> m [b]
    concatMapM ((ModuleGraphNode -> StateT BuildLoopState IO [MakeAction])
    -> (ModuleGraphNodeWithBootFile
        -> StateT BuildLoopState IO [MakeAction])
    -> Either ModuleGraphNode ModuleGraphNodeWithBootFile
    -> StateT BuildLoopState IO [MakeAction]
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either ((MakeAction -> [MakeAction])
    -> StateT BuildLoopState IO MakeAction
    -> StateT BuildLoopState IO [MakeAction]
    forall a b.
    (a -> b)
    -> StateT BuildLoopState IO a -> StateT BuildLoopState IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (MakeAction -> [MakeAction] -> [MakeAction]
    forall a. a -> [a] -> [a]
    :[]) (StateT BuildLoopState IO MakeAction
     -> StateT BuildLoopState IO [MakeAction])
    -> (ModuleGraphNode -> StateT BuildLoopState IO MakeAction)
    -> ModuleGraphNode
    -> StateT BuildLoopState IO [MakeAction]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe [NodeKey]
    -> ResultOrigin
    -> ModuleGraphNode
    -> StateT BuildLoopState IO MakeAction
    buildSingleModule Maybe [NodeKey]
    forall a. Maybe a
    Nothing (ResultLoopOrigin -> ResultOrigin
    Loop ResultLoopOrigin
    Initialise)) ModuleGraphNodeWithBootFile
    -> StateT BuildLoopState IO [MakeAction]
    buildOneLoopyModule) [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    ms
          let extract :: Either ModuleGraphNode ModuleGraphNodeWithBootFile
    -> GenWithIsBoot NodeKey
    extract (Left ModuleGraphNode
    mn) = NodeKey -> IsBootInterface -> GenWithIsBoot NodeKey
    forall mod. mod -> IsBootInterface -> GenWithIsBoot mod
    GWIB (ModuleGraphNode -> NodeKey
    mkNodeKey ModuleGraphNode
    mn) IsBootInterface
    NotBoot
              extract (Right (ModuleGraphNodeWithBootFile ModuleGraphNode
    mn [NodeKey]
    _)) = NodeKey -> IsBootInterface -> GenWithIsBoot NodeKey
    forall mod. mod -> IsBootInterface -> GenWithIsBoot mod
    GWIB (ModuleGraphNode -> NodeKey
    mkNodeKey ModuleGraphNode
    mn) IsBootInterface
    IsBoot
          let loop_mods :: [GenWithIsBoot NodeKey]
    loop_mods = (Either ModuleGraphNode ModuleGraphNodeWithBootFile
     -> GenWithIsBoot NodeKey)
    -> [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    -> [GenWithIsBoot NodeKey]
    forall a b. (a -> b) -> [a] -> [b]
    map Either ModuleGraphNode ModuleGraphNodeWithBootFile
    -> GenWithIsBoot NodeKey
    extract [Either ModuleGraphNode ModuleGraphNodeWithBootFile]
    ms
          -- Rehydration (2) from Note [Hydrating Modules], "Loops with multiple boot files"
          -- Fixes the space leak described in that note.
          MakeAction
    rehydrate_action <- ResultLoopOrigin
    -> [GenWithIsBoot NodeKey] -> StateT BuildLoopState IO MakeAction
    rehydrateAction ResultLoopOrigin
    Finalised [GenWithIsBoot NodeKey]
    loop_mods

          return $ [MakeAction]
    build_modules [MakeAction] -> [MakeAction] -> [MakeAction]
    forall a. [a] -> [a] -> [a]
    ++ [MakeAction
    rehydrate_action]

        -- An action which rehydrates the given keys
        rehydrateAction :: ResultLoopOrigin -> [GenWithIsBoot NodeKey] -> BuildM MakeAction
        rehydrateAction :: ResultLoopOrigin
    -> [GenWithIsBoot NodeKey] -> StateT BuildLoopState IO MakeAction
    rehydrateAction ResultLoopOrigin
    origin [GenWithIsBoot NodeKey]
    deps = do
          MVar (UnitEnvGraph HomeUnitEnv)
    hug_var <- (BuildLoopState -> MVar (UnitEnvGraph HomeUnitEnv))
    -> StateT BuildLoopState IO (MVar (UnitEnvGraph HomeUnitEnv))
    forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
    gets BuildLoopState -> MVar (UnitEnvGraph HomeUnitEnv)
    hug_var
          !Map NodeKey BuildResult
    build_map <- BuildM (Map NodeKey BuildResult)
    getBuildMap
          MVar (Maybe ([HomeModInfo], ModuleNameSet))
    res_var <- IO (MVar (Maybe ([HomeModInfo], ModuleNameSet)))
    -> StateT
         BuildLoopState IO (MVar (Maybe ([HomeModInfo], ModuleNameSet)))
    forall a. IO a -> StateT BuildLoopState IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO (MVar (Maybe ([HomeModInfo], ModuleNameSet)))
    forall a. IO (MVar a)
    newEmptyMVar
          let loop_unit :: UnitId
              !loop_unit :: UnitId
    loop_unit = NodeKey -> UnitId
    nodeKeyUnitId (GenWithIsBoot NodeKey -> NodeKey
    forall mod. GenWithIsBoot mod -> mod
    gwib_mod ([GenWithIsBoot NodeKey] -> GenWithIsBoot NodeKey
    forall a. HasCallStack => [a] -> a
    head [GenWithIsBoot NodeKey]
    deps))
              !build_deps :: [BuildResult]
    build_deps = [NodeKey] -> Map NodeKey BuildResult -> [BuildResult]
    getDependencies ((GenWithIsBoot NodeKey -> NodeKey)
    -> [GenWithIsBoot NodeKey] -> [NodeKey]
    forall a b. (a -> b) -> [a] -> [b]
    map GenWithIsBoot NodeKey -> NodeKey
    forall mod. GenWithIsBoot mod -> mod
    gwib_mod [GenWithIsBoot NodeKey]
    deps) Map NodeKey BuildResult
    build_map
          let loop_action :: RunMakeM ([HomeModInfo], ModuleNameSet)
    loop_action = UnitId
    -> RunMakeM ([HomeModInfo], ModuleNameSet)
    -> RunMakeM ([HomeModInfo], ModuleNameSet)
    forall a. UnitId -> RunMakeM a -> RunMakeM a
    withCurrentUnit UnitId
    loop_unit (RunMakeM ([HomeModInfo], ModuleNameSet)
     -> RunMakeM ([HomeModInfo], ModuleNameSet))
    -> RunMakeM ([HomeModInfo], ModuleNameSet)
    -> RunMakeM ([HomeModInfo], ModuleNameSet)
    forall a b. (a -> b) -> a -> b
    $ do
                (UnitEnvGraph HomeUnitEnv
    hug, ModuleNameSet
    tdeps) <- MVar (UnitEnvGraph HomeUnitEnv)
    -> [BuildResult]
    -> ReaderT
         MakeEnv (MaybeT IO) (UnitEnvGraph HomeUnitEnv, ModuleNameSet)
    wait_deps_hug MVar (UnitEnvGraph HomeUnitEnv)
    hug_var [BuildResult]
    build_deps
                HscEnv
    hsc_env <- (MakeEnv -> HscEnv) -> ReaderT MakeEnv (MaybeT IO) HscEnv
    forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks MakeEnv -> HscEnv
    hsc_env
                let new_hsc :: HscEnv
    new_hsc = UnitEnvGraph HomeUnitEnv -> HscEnv -> HscEnv
    setHUG UnitEnvGraph HomeUnitEnv
    hug HscEnv
    hsc_env
                    mns :: [ModuleName]
                    mns :: [ModuleName]
    mns = (GenWithIsBoot NodeKey -> Maybe ModuleName)
    -> [GenWithIsBoot NodeKey] -> [ModuleName]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (NodeKey -> Maybe ModuleName
    nodeKeyModName (NodeKey -> Maybe ModuleName)
    -> (GenWithIsBoot NodeKey -> NodeKey)
    -> GenWithIsBoot NodeKey
    -> Maybe ModuleName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenWithIsBoot NodeKey -> NodeKey
    forall mod. GenWithIsBoot mod -> mod
    gwib_mod) [GenWithIsBoot NodeKey]
    deps

                [HomeModInfo]
    hmis' <- IO [HomeModInfo] -> ReaderT MakeEnv (MaybeT IO) [HomeModInfo]
    forall a. IO a -> ReaderT MakeEnv (MaybeT IO) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [HomeModInfo] -> ReaderT MakeEnv (MaybeT IO) [HomeModInfo])
    -> IO [HomeModInfo] -> ReaderT MakeEnv (MaybeT IO) [HomeModInfo]
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> [ModuleName] -> IO [HomeModInfo]
    rehydrateAfter HscEnv
    new_hsc [ModuleName]
    mns

                [HomeModInfo]
    -> [GenWithIsBoot NodeKey] -> ReaderT MakeEnv (MaybeT IO) ()
    forall {m :: * -> *}.
    Applicative m =>
    [HomeModInfo] -> [GenWithIsBoot NodeKey] -> m ()
    checkRehydrationInvariant [HomeModInfo]
    hmis' [GenWithIsBoot NodeKey]
    deps

                -- Add hydrated interfaces to global variable
                IO () -> ReaderT MakeEnv (MaybeT IO) ()
    forall a. IO a -> ReaderT MakeEnv (MaybeT IO) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> ReaderT MakeEnv (MaybeT IO) ())
    -> IO () -> ReaderT MakeEnv (MaybeT IO) ()
    forall a b. (a -> b) -> a -> b
    $ MVar (UnitEnvGraph HomeUnitEnv)
    -> (UnitEnvGraph HomeUnitEnv -> IO (UnitEnvGraph HomeUnitEnv))
    -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_ MVar (UnitEnvGraph HomeUnitEnv)
    hug_var (\UnitEnvGraph HomeUnitEnv
    hug -> UnitEnvGraph HomeUnitEnv -> IO (UnitEnvGraph HomeUnitEnv)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (UnitEnvGraph HomeUnitEnv -> IO (UnitEnvGraph HomeUnitEnv))
    -> UnitEnvGraph HomeUnitEnv -> IO (UnitEnvGraph HomeUnitEnv)
    forall a b. (a -> b) -> a -> b
    $ (HomeModInfo
     -> UnitEnvGraph HomeUnitEnv -> UnitEnvGraph HomeUnitEnv)
    -> UnitEnvGraph HomeUnitEnv
    -> [HomeModInfo]
    -> UnitEnvGraph HomeUnitEnv
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr HomeModInfo -> UnitEnvGraph HomeUnitEnv -> UnitEnvGraph HomeUnitEnv
    addHomeModInfoToHug UnitEnvGraph HomeUnitEnv
    hug [HomeModInfo]
    hmis')
                return ([HomeModInfo]
    hmis', ModuleNameSet
    tdeps)

          let fanout :: Int -> ResultVar (Maybe HomeModInfo, ModuleNameSet)
    fanout Int
    i = ([HomeModInfo] -> Maybe HomeModInfo)
    -> ([HomeModInfo], ModuleNameSet)
    -> (Maybe HomeModInfo, ModuleNameSet)
    forall a b c. (a -> b) -> (a, c) -> (b, c)
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first (HomeModInfo -> Maybe HomeModInfo
    forall a. a -> Maybe a
    Just (HomeModInfo -> Maybe HomeModInfo)
    -> ([HomeModInfo] -> HomeModInfo)
    -> [HomeModInfo]
    -> Maybe HomeModInfo
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([HomeModInfo] -> Int -> HomeModInfo
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    i)) (([HomeModInfo], ModuleNameSet)
     -> (Maybe HomeModInfo, ModuleNameSet))
    -> ResultVar ([HomeModInfo], ModuleNameSet)
    -> ResultVar (Maybe HomeModInfo, ModuleNameSet)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> MVar (Maybe ([HomeModInfo], ModuleNameSet))
    -> ResultVar ([HomeModInfo], ModuleNameSet)
    forall a. MVar (Maybe a) -> ResultVar a
    mkResultVar MVar (Maybe ([HomeModInfo], ModuleNameSet))
    res_var
          -- From outside the module loop, anyone must wait for the loop to finish and then
          -- use the result of the rehydrated iface. This makes sure that things not in the
          -- module loop will see the updated interfaces for all the identifiers in the loop.
              boot_key :: NodeKey -> NodeKey
              boot_key :: NodeKey -> NodeKey
    boot_key (NodeKey_Module ModNodeKeyWithUid
    m) = ModNodeKeyWithUid -> NodeKey
    NodeKey_Module (ModNodeKeyWithUid
    m { mnkModuleName = (mnkModuleName m) { gwib_isBoot = IsBoot } } )
              boot_key NodeKey
    k = FilePath -> SDoc -> NodeKey
    forall a. HasCallStack => FilePath -> SDoc -> a
    pprPanic FilePath
    "boot_key" (NodeKey -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr NodeKey
    k)

              update_module_pipeline :: (GenWithIsBoot NodeKey, Int) -> StateT BuildLoopState IO ()
    update_module_pipeline (GenWithIsBoot NodeKey
    m, Int
    i) =
                case GenWithIsBoot NodeKey -> IsBootInterface
    forall mod. GenWithIsBoot mod -> IsBootInterface
    gwib_isBoot GenWithIsBoot NodeKey
    m of
                  IsBootInterface
    NotBoot -> NodeKey -> BuildResult -> StateT BuildLoopState IO ()
    setModulePipeline (GenWithIsBoot NodeKey -> NodeKey
    forall mod. GenWithIsBoot mod -> mod
    gwib_mod GenWithIsBoot NodeKey
    m) (ResultOrigin
    -> ResultVar (Maybe HomeModInfo, ModuleNameSet) -> BuildResult
    mkBuildResult (ResultLoopOrigin -> ResultOrigin
    Loop ResultLoopOrigin
    origin) (Int -> ResultVar (Maybe HomeModInfo, ModuleNameSet)
    fanout Int
    i))
                  IsBootInterface
    IsBoot -> do
                    NodeKey -> BuildResult -> StateT BuildLoopState IO ()
    setModulePipeline (GenWithIsBoot NodeKey -> NodeKey
    forall mod. GenWithIsBoot mod -> mod
    gwib_mod GenWithIsBoot NodeKey
    m) (ResultOrigin
    -> ResultVar (Maybe HomeModInfo, ModuleNameSet) -> BuildResult
    mkBuildResult (ResultLoopOrigin -> ResultOrigin
    Loop ResultLoopOrigin
    origin) (Int -> ResultVar (Maybe HomeModInfo, ModuleNameSet)
    fanout Int
    i))
                    -- SPECIAL: Anything outside the loop needs to see A rather than A.hs-boot
                    NodeKey -> BuildResult -> StateT BuildLoopState IO ()
    setModulePipeline (NodeKey -> NodeKey
    boot_key (GenWithIsBoot NodeKey -> NodeKey
    forall mod. GenWithIsBoot mod -> mod
    gwib_mod GenWithIsBoot NodeKey
    m)) (ResultOrigin
    -> ResultVar (Maybe HomeModInfo, ModuleNameSet) -> BuildResult
    mkBuildResult (ResultLoopOrigin -> ResultOrigin
    Loop ResultLoopOrigin
    origin) (Int -> ResultVar (Maybe HomeModInfo, ModuleNameSet)
    fanout Int
    i))

          let deps_i :: [(GenWithIsBoot NodeKey, Int)]
    deps_i = [GenWithIsBoot NodeKey] -> [Int] -> [(GenWithIsBoot NodeKey, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [GenWithIsBoot NodeKey]
    deps [Int
    0..]
          ((GenWithIsBoot NodeKey, Int) -> StateT BuildLoopState IO ())
    -> [(GenWithIsBoot NodeKey, Int)] -> StateT BuildLoopState IO [()]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (GenWithIsBoot NodeKey, Int) -> StateT BuildLoopState IO ()
    update_module_pipeline [(GenWithIsBoot NodeKey, Int)]
    deps_i

          return $ RunMakeM ([HomeModInfo], ModuleNameSet)
    -> MVar (Maybe ([HomeModInfo], ModuleNameSet)) -> MakeAction
    forall a. RunMakeM a -> MVar (Maybe a) -> MakeAction
    MakeAction RunMakeM ([HomeModInfo], ModuleNameSet)
    loop_action MVar (Maybe ([HomeModInfo], ModuleNameSet))
    res_var

          -- Checks that the interfaces returned from hydration match-up with the names of the
          -- modules which were fed into the function.
        checkRehydrationInvariant :: [HomeModInfo] -> [GenWithIsBoot NodeKey] -> m ()
    checkRehydrationInvariant [HomeModInfo]
    hmis [GenWithIsBoot NodeKey]
    deps =
            let hmi_names :: [ModuleName]
    hmi_names = (HomeModInfo -> ModuleName) -> [HomeModInfo] -> [ModuleName]
    forall a b. (a -> b) -> [a] -> [b]
    map (Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName (Module -> ModuleName)
    -> (HomeModInfo -> Module) -> HomeModInfo -> ModuleName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModIface -> Module
    forall (phase :: ModIfacePhase). ModIface_ phase -> Module
    mi_module (ModIface -> Module)
    -> (HomeModInfo -> ModIface) -> HomeModInfo -> Module
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HomeModInfo -> ModIface
    hm_iface) [HomeModInfo]
    hmis
                start :: [ModuleName]
    start = (GenWithIsBoot NodeKey -> Maybe ModuleName)
    -> [GenWithIsBoot NodeKey] -> [ModuleName]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (NodeKey -> Maybe ModuleName
    nodeKeyModName (NodeKey -> Maybe ModuleName)
    -> (GenWithIsBoot NodeKey -> NodeKey)
    -> GenWithIsBoot NodeKey
    -> Maybe ModuleName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenWithIsBoot NodeKey -> NodeKey
    forall mod. GenWithIsBoot mod -> mod
    gwib_mod) [GenWithIsBoot NodeKey]
    deps
            in Bool -> SDoc -> m ()
    forall (m :: * -> *).
    (HasCallStack, Applicative m) =>
    Bool -> SDoc -> m ()
    massertPpr ([ModuleName]
    hmi_names [ModuleName] -> [ModuleName] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [ModuleName]
    start) (SDoc -> m ()) -> SDoc -> m ()
    forall a b. (a -> b) -> a -> b
    $ ([ModuleName] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [ModuleName]
    hmi_names SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ [ModuleName] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [ModuleName]
    start)

    withCurrentUnit :: UnitId -> RunMakeM a -> RunMakeM a
    withCurrentUnit :: forall a. UnitId -> RunMakeM a -> RunMakeM a
    withCurrentUnit UnitId
    uid = do
      (MakeEnv -> MakeEnv) -> RunMakeM a -> RunMakeM a
    forall r (m :: * -> *) a.
    (r -> r) -> ReaderT r m a -> ReaderT r m a
    local (\MakeEnv
    env -> MakeEnv
    env { hsc_env = hscSetActiveUnitId uid (hsc_env env)})

    upsweep
        :: WorkerLimit -- ^ The number of workers we wish to run in parallel
        -> HscEnv -- ^ The base HscEnv, which is augmented for each module
        -> Maybe ModIfaceCache -- ^ A cache to incrementally write final interface files to
        -> (GhcMessage -> AnyGhcDiagnostic)
        -> Maybe Messager
        -> M.Map ModNodeKeyWithUid HomeModInfo
        -> [BuildPlan]
        -> IO (SuccessFlag, [HomeModInfo])
    upsweep :: WorkerLimit
    -> HscEnv
    -> Maybe ModIfaceCache
    -> (GhcMessage -> AnyGhcDiagnostic)
    -> Maybe Messager
    -> Map ModNodeKeyWithUid HomeModInfo
    -> [BuildPlan]
    -> IO (SuccessFlag, [HomeModInfo])
    upsweep WorkerLimit
    n_jobs HscEnv
    hsc_env Maybe ModIfaceCache
    hmi_cache GhcMessage -> AnyGhcDiagnostic
    diag_wrapper Maybe Messager
    mHscMessage Map ModNodeKeyWithUid HomeModInfo
    old_hpt [BuildPlan]
    build_plan = do
        (Maybe [ModuleGraphNode]
    cycle, [MakeAction]
    pipelines, IO [Maybe (Maybe HomeModInfo)]
    collect_result) <- UnitEnvGraph HomeUnitEnv
    -> Maybe ModIfaceCache
    -> Map ModNodeKeyWithUid HomeModInfo
    -> [BuildPlan]
    -> IO
         (Maybe [ModuleGraphNode], [MakeAction],
          IO [Maybe (Maybe HomeModInfo)])
    interpretBuildPlan (HscEnv -> UnitEnvGraph HomeUnitEnv
    hsc_HUG HscEnv
    hsc_env) Maybe ModIfaceCache
    hmi_cache Map ModNodeKeyWithUid HomeModInfo
    old_hpt [BuildPlan]
    build_plan
        WorkerLimit
    -> HscEnv
    -> (GhcMessage -> AnyGhcDiagnostic)
    -> Maybe Messager
    -> [MakeAction]
    -> IO ()
    runPipelines WorkerLimit
    n_jobs HscEnv
    hsc_env GhcMessage -> AnyGhcDiagnostic
    diag_wrapper Maybe Messager
    mHscMessage [MakeAction]
    pipelines
        [Maybe (Maybe HomeModInfo)]
    res <- IO [Maybe (Maybe HomeModInfo)]
    collect_result

        let completed :: [HomeModInfo]
    completed = [HomeModInfo
    m | Just (Just HomeModInfo
    m) <- [Maybe (Maybe HomeModInfo)]
    res]

        -- Handle any cycle in the original compilation graph and return the result
        -- of the upsweep.
        case Maybe [ModuleGraphNode]
    cycle of
            Just [ModuleGraphNode]
    mss -> do
              let logger :: Logger
    logger = HscEnv -> Logger
    hsc_logger HscEnv
    hsc_env
              IO () -> IO ()
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Logger -> SDoc -> IO ()
    fatalErrorMsg Logger
    logger ([ModuleGraphNode] -> SDoc
    cyclicModuleErr [ModuleGraphNode]
    mss)
              return (SuccessFlag
    Failed, [])
            Maybe [ModuleGraphNode]
    Nothing  -> do
              let success_flag :: SuccessFlag
    success_flag = Bool -> SuccessFlag
    successIf ((Maybe (Maybe HomeModInfo) -> Bool)
    -> [Maybe (Maybe HomeModInfo)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Maybe (Maybe HomeModInfo) -> Bool
    forall a. Maybe a -> Bool
    isJust [Maybe (Maybe HomeModInfo)]
    res)
              (SuccessFlag, [HomeModInfo]) -> IO (SuccessFlag, [HomeModInfo])
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    return (SuccessFlag
    success_flag, [HomeModInfo]
    completed)

    toCache :: [HomeModInfo] -> M.Map (ModNodeKeyWithUid) HomeModInfo
    toCache :: [HomeModInfo] -> Map ModNodeKeyWithUid HomeModInfo
    toCache [HomeModInfo]
    hmis = [(ModNodeKeyWithUid, HomeModInfo)]
    -> Map ModNodeKeyWithUid HomeModInfo
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(ModIface -> ModNodeKeyWithUid
    miKey (ModIface -> ModNodeKeyWithUid) -> ModIface -> ModNodeKeyWithUid
    forall a b. (a -> b) -> a -> b
    $ HomeModInfo -> ModIface
    hm_iface HomeModInfo
    hmi, HomeModInfo
    hmi) | HomeModInfo
    hmi <- [HomeModInfo]
    hmis])

    miKey :: ModIface -> ModNodeKeyWithUid
    miKey :: ModIface -> ModNodeKeyWithUid
    miKey ModIface
    hmi = ModuleNameWithIsBoot -> UnitId -> ModNodeKeyWithUid
    ModNodeKeyWithUid (ModIface -> ModuleNameWithIsBoot
    mi_mnwib ModIface
    hmi) ((GenUnit UnitId -> UnitId
    toUnitId (GenUnit UnitId -> UnitId) -> GenUnit UnitId -> UnitId
    forall a b. (a -> b) -> a -> b
    $ Module -> GenUnit UnitId
    forall unit. GenModule unit -> unit
    moduleUnit (ModIface -> Module
    forall (phase :: ModIfacePhase). ModIface_ phase -> Module
    mi_module ModIface
    hmi)))

    upsweep_inst :: HscEnv
                 -> Maybe Messager
                 -> Int  -- index of module
                 -> Int  -- total number of modules
                 -> UnitId
                 -> InstantiatedUnit
                 -> IO ()
    upsweep_inst :: HscEnv
    -> Maybe Messager
    -> Int
    -> Int
    -> UnitId
    -> InstantiatedUnit
    -> IO ()
    upsweep_inst HscEnv
    hsc_env Maybe Messager
    mHscMessage Int
    mod_index Int
    nmods UnitId
    uid InstantiatedUnit
    iuid = do
            case Maybe Messager
    mHscMessage of
                Just Messager
    hscMessage -> Messager
    hscMessage HscEnv
    hsc_env (Int
    mod_index, Int
    nmods) (CompileReason -> RecompileRequired
    NeedsRecompile CompileReason
    MustCompile) (UnitId -> InstantiatedUnit -> ModuleGraphNode
    InstantiationNode UnitId
    uid InstantiatedUnit
    iuid)
                Maybe Messager
    Nothing -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            HscEnv -> Hsc () -> IO ()
    forall a. HscEnv -> Hsc a -> IO a
    runHsc HscEnv
    hsc_env (Hsc () -> IO ()) -> Hsc () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IO (Messages GhcMessage, Maybe ()) -> Hsc ()
    forall a. IO (Messages GhcMessage, Maybe a) -> Hsc a
    ioMsgMaybe (IO (Messages GhcMessage, Maybe ()) -> Hsc ())
    -> IO (Messages GhcMessage, Maybe ()) -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ IO (Messages TcRnMessage, Maybe ())
    -> IO (Messages GhcMessage, Maybe ())
    forall (m :: * -> *) a.
    Monad m =>
    m (Messages TcRnMessage, a) -> m (Messages GhcMessage, a)
    hoistTcRnMessage (IO (Messages TcRnMessage, Maybe ())
     -> IO (Messages GhcMessage, Maybe ()))
    -> IO (Messages TcRnMessage, Maybe ())
    -> IO (Messages GhcMessage, Maybe ())
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> GenUnit UnitId -> IO (Messages TcRnMessage, Maybe ())
    tcRnCheckUnit HscEnv
    hsc_env (GenUnit UnitId -> IO (Messages TcRnMessage, Maybe ()))
    -> GenUnit UnitId -> IO (Messages TcRnMessage, Maybe ())
    forall a b. (a -> b) -> a -> b
    $ InstantiatedUnit -> GenUnit UnitId
    forall uid. GenInstantiatedUnit uid -> GenUnit uid
    VirtUnit InstantiatedUnit
    iuid
            pure ()

    -- | Compile a single module.  Always produce a Linkable for it if
    -- successful.  If no compilation happened, return the old Linkable.
    upsweep_mod :: HscEnv
                -> Maybe Messager
                -> Maybe HomeModInfo
                -> ModSummary
                -> Int  -- index of module
                -> Int  -- total number of modules
                -> IO HomeModInfo
    upsweep_mod :: HscEnv
    -> Maybe Messager
    -> Maybe HomeModInfo
    -> ModSummary
    -> Int
    -> Int
    -> IO HomeModInfo
    upsweep_mod HscEnv
    hsc_env Maybe Messager
    mHscMessage Maybe HomeModInfo
    old_hmi ModSummary
    summary Int
    mod_index Int
    nmods =  do
      HomeModInfo
    hmi <- Maybe Messager
    -> HscEnv
    -> ModSummary
    -> Int
    -> Int
    -> Maybe ModIface
    -> HomeModLinkable
    -> IO HomeModInfo
    compileOne' Maybe Messager
    mHscMessage HscEnv
    hsc_env ModSummary
    summary
              Int
    mod_index Int
    nmods (HomeModInfo -> ModIface
    hm_iface (HomeModInfo -> ModIface) -> Maybe HomeModInfo -> Maybe ModIface
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe HomeModInfo
    old_hmi) (HomeModLinkable
    -> (HomeModInfo -> HomeModLinkable)
    -> Maybe HomeModInfo
    -> HomeModLinkable
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe HomeModLinkable
    emptyHomeModInfoLinkable HomeModInfo -> HomeModLinkable
    hm_linkable Maybe HomeModInfo
    old_hmi)

      -- MP: This is a bit janky, because before you add the entries you have to extend the HPT with the module
      -- you just compiled. Another option, would be delay adding anything until after upsweep has finished, but I
      -- am unsure if this is sound (wrt running TH splices for example).
      -- This function only does anything if the linkable produced is a BCO, which only happens with the
      -- bytecode backend, no need to guard against the backend type additionally.
      HscEnv -> Maybe Linkable -> IO ()
    addSptEntries ((HomePackageTable -> HomePackageTable) -> HscEnv -> HscEnv
    hscUpdateHPT (\HomePackageTable
    hpt -> HomePackageTable -> ModuleName -> HomeModInfo -> HomePackageTable
    addToHpt HomePackageTable
    hpt (ModSummary -> ModuleName
    ms_mod_name ModSummary
    summary) HomeModInfo
    hmi) HscEnv
    hsc_env)
                    (HomeModInfo -> Maybe Linkable
    homeModInfoByteCode HomeModInfo
    hmi)

      return HomeModInfo
    hmi

    -- | Add the entries from a BCO linkable to the SPT table, see
    -- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable.
    addSptEntries :: HscEnv -> Maybe Linkable -> IO ()
    addSptEntries :: HscEnv -> Maybe Linkable -> IO ()
    addSptEntries HscEnv
    hsc_env Maybe Linkable
    mlinkable =
      HscEnv -> [SptEntry] -> IO ()
    hscAddSptEntries HscEnv
    hsc_env
         [ SptEntry
    spt
         | Just Linkable
    linkable <- [Maybe Linkable
    mlinkable]
         , Unlinked
    unlinked <- Linkable -> [Unlinked]
    linkableUnlinked Linkable
    linkable
         , BCOs CompiledByteCode
    _ [SptEntry]
    spts <- Unlinked -> [Unlinked]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Unlinked
    unlinked
         , SptEntry
    spt <- [SptEntry]
    spts
         ]

    {- Note [-fno-code mode]
    ~~~~~~~~~~~~~~~~~~~~~~~~
    GHC offers the flag -fno-code for the purpose of parsing and typechecking a
    program without generating object files. This is intended to be used by tooling
    and IDEs to provide quick feedback on any parser or type errors as cheaply as
    possible.

    When GHC is invoked with -fno-code no object files or linked output will be
    generated. As many errors and warnings as possible will be generated, as if
    -fno-code had not been passed. The session DynFlags will have
    backend == NoBackend.

    -fwrite-interface
    ~~~~~~~~~~~~~~~~
    Whether interface files are generated in -fno-code mode is controlled by the
    -fwrite-interface flag. The -fwrite-interface flag is a no-op if -fno-code is
    not also passed. Recompilation avoidance requires interface files, so passing
    -fno-code without -fwrite-interface should be avoided. If -fno-code were
    re-implemented today, -fwrite-interface would be discarded and it would be
    considered always on; this behaviour is as it is for backwards compatibility.

    ================================================================
    IN SUMMARY: ALWAYS PASS -fno-code AND -fwrite-interface TOGETHER
    ================================================================

    Template Haskell
    ~~~~~~~~~~~~~~~~
    A module using template haskell may invoke an imported function from inside a
    splice. This will cause the type-checker to attempt to execute that code, which
    would fail if no object files had been generated. See #8025. To rectify this,
    during the downsweep we patch the DynFlags in the ModSummary of any home module
    that is imported by a module that uses template haskell, to generate object
    code.

    The flavour of the generated code depends on whether `-fprefer-byte-code` is enabled
    or not in the module which needs the code generation. If the module requires byte-code then
    dependencies will generate byte-code, otherwise they will generate object files.
    In the case where some modules require byte-code and some object files, both are
    generated by enabling `-fbyte-code-and-object-code`, the test "fat015" tests these
    configurations.

    The object files (and interface files if -fwrite-interface is disabled) produced
    for template haskell are written to temporary files.

    Note that since template haskell can run arbitrary IO actions, -fno-code mode
    is no more secure than running without it.

    Potential TODOS:
    ~~~~~
    * Remove -fwrite-interface and have interface files always written in -fno-code
      mode
    * Both .o and .dyn_o files are generated for template haskell, but we only need
      .dyn_o. Fix it.
    * In make mode, a message like
      Compiling A (A.hs, /tmp/ghc_123.o)
      is shown if downsweep enabled object code generation for A. Perhaps we should
      show "nothing" or "temporary object file" instead. Note that one
      can currently use -keep-tmp-files and inspect the generated file with the
      current behaviour.
    * Offer a -no-codedir command line option, and write what were temporary
      object files there. This would speed up recompilation.
    * Use existing object files (if they are up to date) instead of always
      generating temporary ones.
    -}

    -- Note [When source is considered modified]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -- A number of functions in GHC.Driver accept a SourceModified argument, which
    -- is part of how GHC determines whether recompilation may be avoided (see the
    -- definition of the SourceModified data type for details).
    --
    -- Determining whether or not a source file is considered modified depends not
    -- only on the source file itself, but also on the output files which compiling
    -- that module would produce. This is done because GHC supports a number of
    -- flags which control which output files should be produced, e.g. -fno-code
    -- -fwrite-interface and -fwrite-ide-file; we must check not only whether the
    -- source file has been modified since the last compile, but also whether the
    -- source file has been modified since the last compile which produced all of
    -- the output files which have been requested.
    --
    -- Specifically, a source file is considered unmodified if it is up-to-date
    -- relative to all of the output files which have been requested. Whether or
    -- not an output file is up-to-date depends on what kind of file it is:
    --
    -- * iface (.hi) files are considered up-to-date if (and only if) their
    --   mi_src_hash field matches the hash of the source file,
    --
    -- * all other output files (.o, .dyn_o, .hie, etc) are considered up-to-date
    --   if (and only if) their modification times on the filesystem are greater
    --   than or equal to the modification time of the corresponding .hi file.
    --
    -- Why do we use '>=' rather than '>' for output files other than the .hi file?
    -- If the filesystem has poor resolution for timestamps (e.g. FAT32 has a
    -- resolution of 2 seconds), we may often find that the .hi and .o files have
    -- the same modification time. Using >= is slightly unsafe, but it matches
    -- make's behaviour.
    --
    -- This strategy allows us to do the minimum work necessary in order to ensure
    -- that all the files the user cares about are up-to-date; e.g. we should not
    -- worry about .o files if the user has indicated that they are not interested
    -- in them via -fno-code. See also #9243.
    --
    -- Note that recompilation avoidance is dependent on .hi files being produced,
    -- which does not happen if -fno-write-interface -fno-code is passed. That is,
    -- passing -fno-write-interface -fno-code means that you cannot benefit from
    -- recompilation avoidance. See also Note [-fno-code mode].
    --
    -- The correctness of this strategy depends on an assumption that whenever we
    -- are producing multiple output files, the .hi file is always written first.
    -- If this assumption is violated, we risk recompiling unnecessarily by
    -- incorrectly regarding non-.hi files as outdated.
    --

    -- ---------------------------------------------------------------------------
    --
    -- | Topological sort of the module graph
    topSortModuleGraph
              :: Bool
              -- ^ Drop hi-boot nodes? (see below)
              -> ModuleGraph
              -> Maybe HomeUnitModule
                 -- ^ Root module name.  If @Nothing@, use the full graph.
              -> [SCC ModuleGraphNode]
    -- ^ Calculate SCCs of the module graph, possibly dropping the hi-boot nodes
    -- The resulting list of strongly-connected-components is in topologically
    -- sorted order, starting with the module(s) at the bottom of the
    -- dependency graph (ie compile them first) and ending with the ones at
    -- the top.
    --
    -- Drop hi-boot nodes (first boolean arg)?
    --
    -- - @False@:   treat the hi-boot summaries as nodes of the graph,
    --              so the graph must be acyclic
    --
    -- - @True@:    eliminate the hi-boot nodes, and instead pretend
    --              the a source-import of Foo is an import of Foo
    --              The resulting graph has no hi-boot nodes, but can be cyclic
    topSortModuleGraph :: Bool
    -> ModuleGraph -> Maybe HomeUnitModule -> [SCC ModuleGraphNode]
    topSortModuleGraph Bool
    drop_hs_boot_nodes ModuleGraph
    module_graph Maybe HomeUnitModule
    mb_root_mod =
        -- stronglyConnCompG flips the original order, so if we reverse
        -- the summaries we get a stable topological sort.
      Bool
    -> [ModuleGraphNode]
    -> Maybe HomeUnitModule
    -> [SCC ModuleGraphNode]
    topSortModules Bool
    drop_hs_boot_nodes ([ModuleGraphNode] -> [ModuleGraphNode]
    forall a. [a] -> [a]
    reverse ([ModuleGraphNode] -> [ModuleGraphNode])
    -> [ModuleGraphNode] -> [ModuleGraphNode]
    forall a b. (a -> b) -> a -> b
    $ ModuleGraph -> [ModuleGraphNode]
    mgModSummaries' ModuleGraph
    module_graph) Maybe HomeUnitModule
    mb_root_mod

    topSortModules :: Bool -> [ModuleGraphNode] -> Maybe HomeUnitModule -> [SCC ModuleGraphNode]
    topSortModules :: Bool
    -> [ModuleGraphNode]
    -> Maybe HomeUnitModule
    -> [SCC ModuleGraphNode]
    topSortModules Bool
    drop_hs_boot_nodes [ModuleGraphNode]
    summaries Maybe HomeUnitModule
    mb_root_mod
      = (SCC SummaryNode -> SCC ModuleGraphNode)
    -> [SCC SummaryNode] -> [SCC ModuleGraphNode]
    forall a b. (a -> b) -> [a] -> [b]
    map ((SummaryNode -> ModuleGraphNode)
    -> SCC SummaryNode -> SCC ModuleGraphNode
    forall a b. (a -> b) -> SCC a -> SCC b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap SummaryNode -> ModuleGraphNode
    summaryNodeSummary) ([SCC SummaryNode] -> [SCC ModuleGraphNode])
    -> [SCC SummaryNode] -> [SCC ModuleGraphNode]
    forall a b. (a -> b) -> a -> b
    $ Graph SummaryNode -> [SCC SummaryNode]
    forall node. Graph node -> [SCC node]
    stronglyConnCompG Graph SummaryNode
    initial_graph
      where
        (Graph SummaryNode
    graph, NodeKey -> Maybe SummaryNode
    lookup_node) =
          Bool
    -> [ModuleGraphNode]
    -> (Graph SummaryNode, NodeKey -> Maybe SummaryNode)
    moduleGraphNodes Bool
    drop_hs_boot_nodes [ModuleGraphNode]
    summaries

        initial_graph :: Graph SummaryNode
    initial_graph = case Maybe HomeUnitModule
    mb_root_mod of
            Maybe HomeUnitModule
    Nothing -> Graph SummaryNode
    graph
            Just (Module UnitId
    uid ModuleName
    root_mod) ->
                -- restrict the graph to just those modules reachable from
                -- the specified module.  We do this by building a graph with
                -- the full set of nodes, and determining the reachable set from
                -- the specified node.
                let root :: SummaryNode
    root | Just SummaryNode
    node <- NodeKey -> Maybe SummaryNode
    lookup_node (NodeKey -> Maybe SummaryNode) -> NodeKey -> Maybe SummaryNode
    forall a b. (a -> b) -> a -> b
    $ ModNodeKeyWithUid -> NodeKey
    NodeKey_Module (ModNodeKeyWithUid -> NodeKey) -> ModNodeKeyWithUid -> NodeKey
    forall a b. (a -> b) -> a -> b
    $ ModuleNameWithIsBoot -> UnitId -> ModNodeKeyWithUid
    ModNodeKeyWithUid (ModuleName -> IsBootInterface -> ModuleNameWithIsBoot
    forall mod. mod -> IsBootInterface -> GenWithIsBoot mod
    GWIB ModuleName
    root_mod IsBootInterface
    NotBoot) UnitId
    uid
                         , Graph SummaryNode
    graph Graph SummaryNode -> SummaryNode -> Bool
    forall node. Graph node -> node -> Bool
    `hasVertexG` SummaryNode
    node
                         = SummaryNode
    node
                         | Bool
    otherwise
                         = GhcException -> SummaryNode
    forall a. GhcException -> a
    throwGhcException (FilePath -> GhcException
    ProgramError FilePath
    "module does not exist")
                in [SummaryNode] -> Graph SummaryNode
    forall key payload.
    Uniquable key =>
    [Node key payload] -> Graph (Node key payload)
    graphFromEdgedVerticesUniq (SummaryNode -> [SummaryNode] -> [SummaryNode]
    forall a b. a -> b -> b
    seq SummaryNode
    root (Graph SummaryNode -> SummaryNode -> [SummaryNode]
    forall node. Graph node -> node -> [node]
    reachableG Graph SummaryNode
    graph SummaryNode
    root))

    newtype ModNodeMap a = ModNodeMap { forall a. ModNodeMap a -> Map ModuleNameWithIsBoot a
    unModNodeMap :: Map.Map ModNodeKey a }
      deriving ((forall a b. (a -> b) -> ModNodeMap a -> ModNodeMap b)
    -> (forall a b. a -> ModNodeMap b -> ModNodeMap a)
    -> Functor ModNodeMap
    forall a b. a -> ModNodeMap b -> ModNodeMap a
    forall a b. (a -> b) -> ModNodeMap a -> ModNodeMap b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> ModNodeMap a -> ModNodeMap b
    fmap :: forall a b. (a -> b) -> ModNodeMap a -> ModNodeMap b
    $c<$ :: forall a b. a -> ModNodeMap b -> ModNodeMap a
    <$ :: forall a b. a -> ModNodeMap b -> ModNodeMap a
    Functor, Functor ModNodeMap
    Foldable ModNodeMap
    (Functor ModNodeMap, Foldable ModNodeMap) =>
    (forall (f :: * -> *) a b.
     Applicative f =>
     (a -> f b) -> ModNodeMap a -> f (ModNodeMap b))
    -> (forall (f :: * -> *) a.
        Applicative f =>
        ModNodeMap (f a) -> f (ModNodeMap a))
    -> (forall (m :: * -> *) a b.
        Monad m =>
        (a -> m b) -> ModNodeMap a -> m (ModNodeMap b))
    -> (forall (m :: * -> *) a.
        Monad m =>
        ModNodeMap (m a) -> m (ModNodeMap a))
    -> Traversable ModNodeMap
    forall (t :: * -> *).
    (Functor t, Foldable t) =>
    (forall (f :: * -> *) a b.
     Applicative f =>
     (a -> f b) -> t a -> f (t b))
    -> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
    -> (forall (m :: * -> *) a b.
        Monad m =>
        (a -> m b) -> t a -> m (t b))
    -> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
    -> Traversable t
    forall (m :: * -> *) a.
    Monad m =>
    ModNodeMap (m a) -> m (ModNodeMap a)
    forall (f :: * -> *) a.
    Applicative f =>
    ModNodeMap (f a) -> f (ModNodeMap a)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ModNodeMap a -> m (ModNodeMap b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> ModNodeMap a -> f (ModNodeMap b)
    $ctraverse :: forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> ModNodeMap a -> f (ModNodeMap b)
    traverse :: forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> ModNodeMap a -> f (ModNodeMap b)
    $csequenceA :: forall (f :: * -> *) a.
    Applicative f =>
    ModNodeMap (f a) -> f (ModNodeMap a)
    sequenceA :: forall (f :: * -> *) a.
    Applicative f =>
    ModNodeMap (f a) -> f (ModNodeMap a)
    $cmapM :: forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ModNodeMap a -> m (ModNodeMap b)
    mapM :: forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ModNodeMap a -> m (ModNodeMap b)
    $csequence :: forall (m :: * -> *) a.
    Monad m =>
    ModNodeMap (m a) -> m (ModNodeMap a)
    sequence :: forall (m :: * -> *) a.
    Monad m =>
    ModNodeMap (m a) -> m (ModNodeMap a)
    Traversable, (forall m. Monoid m => ModNodeMap m -> m)
    -> (forall m a. Monoid m => (a -> m) -> ModNodeMap a -> m)
    -> (forall m a. Monoid m => (a -> m) -> ModNodeMap a -> m)
    -> (forall a b. (a -> b -> b) -> b -> ModNodeMap a -> b)
    -> (forall a b. (a -> b -> b) -> b -> ModNodeMap a -> b)
    -> (forall b a. (b -> a -> b) -> b -> ModNodeMap a -> b)
    -> (forall b a. (b -> a -> b) -> b -> ModNodeMap a -> b)
    -> (forall a. (a -> a -> a) -> ModNodeMap a -> a)
    -> (forall a. (a -> a -> a) -> ModNodeMap a -> a)
    -> (forall a. ModNodeMap a -> [a])
    -> (forall a. ModNodeMap a -> Bool)
    -> (forall a. ModNodeMap a -> Int)
    -> (forall a. Eq a => a -> ModNodeMap a -> Bool)
    -> (forall a. Ord a => ModNodeMap a -> a)
    -> (forall a. Ord a => ModNodeMap a -> a)
    -> (forall a. Num a => ModNodeMap a -> a)
    -> (forall a. Num a => ModNodeMap a -> a)
    -> Foldable ModNodeMap
    forall a. Eq a => a -> ModNodeMap a -> Bool
    forall a. Num a => ModNodeMap a -> a
    forall a. Ord a => ModNodeMap a -> a
    forall m. Monoid m => ModNodeMap m -> m
    forall a. ModNodeMap a -> Bool
    forall a. ModNodeMap a -> Int
    forall a. ModNodeMap a -> [a]
    forall a. (a -> a -> a) -> ModNodeMap a -> a
    forall m a. Monoid m => (a -> m) -> ModNodeMap a -> m
    forall b a. (b -> a -> b) -> b -> ModNodeMap a -> b
    forall a b. (a -> b -> b) -> b -> ModNodeMap a -> b
    forall (t :: * -> *).
    (forall m. Monoid m => t m -> m)
    -> (forall m a. Monoid m => (a -> m) -> t a -> m)
    -> (forall m a. Monoid m => (a -> m) -> t a -> m)
    -> (forall a b. (a -> b -> b) -> b -> t a -> b)
    -> (forall a b. (a -> b -> b) -> b -> t a -> b)
    -> (forall b a. (b -> a -> b) -> b -> t a -> b)
    -> (forall b a. (b -> a -> b) -> b -> t a -> b)
    -> (forall a. (a -> a -> a) -> t a -> a)
    -> (forall a. (a -> a -> a) -> t a -> a)
    -> (forall a. t a -> [a])
    -> (forall a. t a -> Bool)
    -> (forall a. t a -> Int)
    -> (forall a. Eq a => a -> t a -> Bool)
    -> (forall a. Ord a => t a -> a)
    -> (forall a. Ord a => t a -> a)
    -> (forall a. Num a => t a -> a)
    -> (forall a. Num a => t a -> a)
    -> Foldable t
    $cfold :: forall m. Monoid m => ModNodeMap m -> m
    fold :: forall m. Monoid m => ModNodeMap m -> m
    $cfoldMap :: forall m a. Monoid m => (a -> m) -> ModNodeMap a -> m
    foldMap :: forall m a. Monoid m => (a -> m) -> ModNodeMap a -> m
    $cfoldMap' :: forall m a. Monoid m => (a -> m) -> ModNodeMap a -> m
    foldMap' :: forall m a. Monoid m => (a -> m) -> ModNodeMap a -> m
    $cfoldr :: forall a b. (a -> b -> b) -> b -> ModNodeMap a -> b
    foldr :: forall a b. (a -> b -> b) -> b -> ModNodeMap a -> b
    $cfoldr' :: forall a b. (a -> b -> b) -> b -> ModNodeMap a -> b
    foldr' :: forall a b. (a -> b -> b) -> b -> ModNodeMap a -> b
    $cfoldl :: forall b a. (b -> a -> b) -> b -> ModNodeMap a -> b
    foldl :: forall b a. (b -> a -> b) -> b -> ModNodeMap a -> b
    $cfoldl' :: forall b a. (b -> a -> b) -> b -> ModNodeMap a -> b
    foldl' :: forall b a. (b -> a -> b) -> b -> ModNodeMap a -> b
    $cfoldr1 :: forall a. (a -> a -> a) -> ModNodeMap a -> a
    foldr1 :: forall a. (a -> a -> a) -> ModNodeMap a -> a
    $cfoldl1 :: forall a. (a -> a -> a) -> ModNodeMap a -> a
    foldl1 :: forall a. (a -> a -> a) -> ModNodeMap a -> a
    $ctoList :: forall a. ModNodeMap a -> [a]
    toList :: forall a. ModNodeMap a -> [a]
    $cnull :: forall a. ModNodeMap a -> Bool
    null :: forall a. ModNodeMap a -> Bool
    $clength :: forall a. ModNodeMap a -> Int
    length :: forall a. ModNodeMap a -> Int
    $celem :: forall a. Eq a => a -> ModNodeMap a -> Bool
    elem :: forall a. Eq a => a -> ModNodeMap a -> Bool
    $cmaximum :: forall a. Ord a => ModNodeMap a -> a
    maximum :: forall a. Ord a => ModNodeMap a -> a
    $cminimum :: forall a. Ord a => ModNodeMap a -> a
    minimum :: forall a. Ord a => ModNodeMap a -> a
    $csum :: forall a. Num a => ModNodeMap a -> a
    sum :: forall a. Num a => ModNodeMap a -> a
    $cproduct :: forall a. Num a => ModNodeMap a -> a
    product :: forall a. Num a => ModNodeMap a -> a
    Foldable)

    emptyModNodeMap :: ModNodeMap a
    emptyModNodeMap :: forall a. ModNodeMap a
    emptyModNodeMap = Map ModuleNameWithIsBoot a -> ModNodeMap a
    forall a. Map ModuleNameWithIsBoot a -> ModNodeMap a
    ModNodeMap Map ModuleNameWithIsBoot a
    forall k a. Map k a
    Map.empty

    modNodeMapInsert :: ModNodeKey -> a -> ModNodeMap a -> ModNodeMap a
    modNodeMapInsert :: forall a. ModuleNameWithIsBoot -> a -> ModNodeMap a -> ModNodeMap a
    modNodeMapInsert ModuleNameWithIsBoot
    k a
    v (ModNodeMap Map ModuleNameWithIsBoot a
    m) = Map ModuleNameWithIsBoot a -> ModNodeMap a
    forall a. Map ModuleNameWithIsBoot a -> ModNodeMap a
    ModNodeMap (ModuleNameWithIsBoot
    -> a -> Map ModuleNameWithIsBoot a -> Map ModuleNameWithIsBoot a
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert ModuleNameWithIsBoot
    k a
    v Map ModuleNameWithIsBoot a
    m)

    modNodeMapElems :: ModNodeMap a -> [a]
    modNodeMapElems :: forall a. ModNodeMap a -> [a]
    modNodeMapElems (ModNodeMap Map ModuleNameWithIsBoot a
    m) = Map ModuleNameWithIsBoot a -> [a]
    forall k a. Map k a -> [a]
    Map.elems Map ModuleNameWithIsBoot a
    m

    modNodeMapLookup :: ModNodeKey -> ModNodeMap a -> Maybe a
    modNodeMapLookup :: forall a. ModuleNameWithIsBoot -> ModNodeMap a -> Maybe a
    modNodeMapLookup ModuleNameWithIsBoot
    k (ModNodeMap Map ModuleNameWithIsBoot a
    m) = ModuleNameWithIsBoot -> Map ModuleNameWithIsBoot a -> Maybe a
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup ModuleNameWithIsBoot
    k Map ModuleNameWithIsBoot a
    m

    modNodeMapSingleton :: ModNodeKey -> a -> ModNodeMap a
    modNodeMapSingleton :: forall a. ModuleNameWithIsBoot -> a -> ModNodeMap a
    modNodeMapSingleton ModuleNameWithIsBoot
    k a
    v = Map ModuleNameWithIsBoot a -> ModNodeMap a
    forall a. Map ModuleNameWithIsBoot a -> ModNodeMap a
    ModNodeMap (ModuleNameWithIsBoot -> a -> Map ModuleNameWithIsBoot a
    forall k a. k -> a -> Map k a
    M.singleton ModuleNameWithIsBoot
    k a
    v)

    modNodeMapUnionWith :: (a -> a -> a) -> ModNodeMap a -> ModNodeMap a -> ModNodeMap a
    modNodeMapUnionWith :: forall a.
    (a -> a -> a) -> ModNodeMap a -> ModNodeMap a -> ModNodeMap a
    modNodeMapUnionWith a -> a -> a
    f (ModNodeMap Map ModuleNameWithIsBoot a
    m) (ModNodeMap Map ModuleNameWithIsBoot a
    n) = Map ModuleNameWithIsBoot a -> ModNodeMap a
    forall a. Map ModuleNameWithIsBoot a -> ModNodeMap a
    ModNodeMap ((a -> a -> a)
    -> Map ModuleNameWithIsBoot a
    -> Map ModuleNameWithIsBoot a
    -> Map ModuleNameWithIsBoot a
    forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
    M.unionWith a -> a -> a
    f Map ModuleNameWithIsBoot a
    m Map ModuleNameWithIsBoot a
    n)

    -- | If there are {-# SOURCE #-} imports between strongly connected
    -- components in the topological sort, then those imports can
    -- definitely be replaced by ordinary non-SOURCE imports: if SOURCE
    -- were necessary, then the edge would be part of a cycle.
    warnUnnecessarySourceImports :: GhcMonad m => [SCC ModSummary] -> m ()
    warnUnnecessarySourceImports :: forall (m :: * -> *). GhcMonad m => [SCC ModSummary] -> m ()
    warnUnnecessarySourceImports [SCC ModSummary]
    sccs = do
      DiagOpts
    diag_opts <- DynFlags -> DiagOpts
    initDiagOpts (DynFlags -> DiagOpts) -> m DynFlags -> m DiagOpts
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> m DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
      Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (WarningFlag -> DiagOpts -> Bool
    diag_wopt WarningFlag
    Opt_WarnUnusedImports DiagOpts
    diag_opts) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
        let check :: [ModSummary] -> [MsgEnvelope GhcMessage]
    check [ModSummary]
    ms =
               let mods_in_this_cycle :: [ModuleName]
    mods_in_this_cycle = (ModSummary -> ModuleName) -> [ModSummary] -> [ModuleName]
    forall a b. (a -> b) -> [a] -> [b]
    map ModSummary -> ModuleName
    ms_mod_name [ModSummary]
    ms in
               [ GenLocated SrcSpan ModuleName -> MsgEnvelope GhcMessage
    warn GenLocated SrcSpan ModuleName
    i | ModSummary
    m <- [ModSummary]
    ms, GenLocated SrcSpan ModuleName
    i <- ModSummary -> [GenLocated SrcSpan ModuleName]
    ms_home_srcimps ModSummary
    m,
                          GenLocated SrcSpan ModuleName -> ModuleName
    forall l e. GenLocated l e -> e
    unLoc GenLocated SrcSpan ModuleName
    i ModuleName -> [ModuleName] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem`  [ModuleName]
    mods_in_this_cycle ]

            warn :: Located ModuleName -> MsgEnvelope GhcMessage
            warn :: GenLocated SrcSpan ModuleName -> MsgEnvelope GhcMessage
    warn (L SrcSpan
    loc ModuleName
    mod) = DriverMessage -> GhcMessage
    GhcDriverMessage (DriverMessage -> GhcMessage)
    -> MsgEnvelope DriverMessage -> MsgEnvelope GhcMessage
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> DiagOpts -> SrcSpan -> DriverMessage -> MsgEnvelope DriverMessage
    forall e. Diagnostic e => DiagOpts -> SrcSpan -> e -> MsgEnvelope e
    mkPlainMsgEnvelope DiagOpts
    diag_opts
                                                      SrcSpan
    loc (ModuleName -> DriverMessage
    DriverUnnecessarySourceImports ModuleName
    mod)
        Messages GhcMessage -> m ()
    forall (m :: * -> *). GhcMonad m => Messages GhcMessage -> m ()
    logDiagnostics (Bag (MsgEnvelope GhcMessage) -> Messages GhcMessage
    forall e. Bag (MsgEnvelope e) -> Messages e
    mkMessages (Bag (MsgEnvelope GhcMessage) -> Messages GhcMessage)
    -> Bag (MsgEnvelope GhcMessage) -> Messages GhcMessage
    forall a b. (a -> b) -> a -> b
    $ [MsgEnvelope GhcMessage] -> Bag (MsgEnvelope GhcMessage)
    forall a. [a] -> Bag a
    listToBag ((SCC ModSummary -> [MsgEnvelope GhcMessage])
    -> [SCC ModSummary] -> [MsgEnvelope GhcMessage]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ([ModSummary] -> [MsgEnvelope GhcMessage]
    check ([ModSummary] -> [MsgEnvelope GhcMessage])
    -> (SCC ModSummary -> [ModSummary])
    -> SCC ModSummary
    -> [MsgEnvelope GhcMessage]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SCC ModSummary -> [ModSummary]
    forall vertex. SCC vertex -> [vertex]
    flattenSCC) [SCC ModSummary]
    sccs))

    -- This caches the answer to the question, if we are in this unit, what does
    -- an import of this module mean.
    type DownsweepCache = M.Map (UnitId, PkgQual, ModuleNameWithIsBoot) [Either DriverMessages ModSummary]

    -----------------------------------------------------------------------------
    --
    -- | Downsweep (dependency analysis)
    --
    -- Chase downwards from the specified root set, returning summaries
    -- for all home modules encountered.  Only follow source-import
    -- links.
    --
    -- We pass in the previous collection of summaries, which is used as a
    -- cache to avoid recalculating a module summary if the source is
    -- unchanged.
    --
    -- The returned list of [ModSummary] nodes has one node for each home-package
    -- module, plus one for any hs-boot files.  The imports of these nodes
    -- are all there, including the imports of non-home-package modules.
    downsweep :: HscEnv
              -> [ModSummary]
              -- ^ Old summaries
              -> [ModuleName]       -- Ignore dependencies on these; treat
                                    -- them as if they were package modules
              -> Bool               -- True <=> allow multiple targets to have
                                    --          the same module name; this is
                                    --          very useful for ghc -M
              -> IO ([DriverMessages], [ModuleGraphNode])
                    -- The non-error elements of the returned list all have distinct
                    -- (Modules, IsBoot) identifiers, unless the Bool is true in
                    -- which case there can be repeats
    downsweep :: HscEnv
    -> [ModSummary]
    -> [ModuleName]
    -> Bool
    -> IO ([DriverMessages], [ModuleGraphNode])
    downsweep HscEnv
    hsc_env [ModSummary]
    old_summaries [ModuleName]
    excl_mods Bool
    allow_dup_roots
       = do
           ([(UnitId, DriverMessages)]
    root_errs, [ModSummary]
    rootSummariesOk) <- (Target -> IO (Either (UnitId, DriverMessages) ModSummary))
    -> [Target] -> IO ([(UnitId, DriverMessages)], [ModSummary])
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m (Either b c)) -> [a] -> m ([b], [c])
    partitionWithM Target -> IO (Either (UnitId, DriverMessages) ModSummary)
    getRootSummary [Target]
    roots -- #17549
           let root_map :: DownsweepCache
    root_map = [ModSummary] -> DownsweepCache
    mkRootMap [ModSummary]
    rootSummariesOk
           DownsweepCache -> IO ()
    checkDuplicates DownsweepCache
    root_map
           (Map NodeKey ModuleGraphNode
    deps, DownsweepCache
    map0) <- [ModSummary]
    -> (Map NodeKey ModuleGraphNode, DownsweepCache)
    -> IO (Map NodeKey ModuleGraphNode, DownsweepCache)
    loopSummaries [ModSummary]
    rootSummariesOk (Map NodeKey ModuleGraphNode
    forall k a. Map k a
    M.empty, DownsweepCache
    root_map)
           let closure_errs :: [DriverMessages]
    closure_errs = UnitEnv -> [DriverMessages]
    checkHomeUnitsClosed (HscEnv -> UnitEnv
    hsc_unit_env HscEnv
    hsc_env)
           let unit_env :: UnitEnv
    unit_env = HscEnv -> UnitEnv
    hsc_unit_env HscEnv
    hsc_env
           let tmpfs :: TmpFs
    tmpfs    = HscEnv -> TmpFs
    hsc_tmpfs    HscEnv
    hsc_env

           let downsweep_errs :: [DriverMessages]
    downsweep_errs = [Either DriverMessages ModSummary] -> [DriverMessages]
    forall a b. [Either a b] -> [a]
    lefts ([Either DriverMessages ModSummary] -> [DriverMessages])
    -> [Either DriverMessages ModSummary] -> [DriverMessages]
    forall a b. (a -> b) -> a -> b
    $ [[Either DriverMessages ModSummary]]
    -> [Either DriverMessages ModSummary]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Either DriverMessages ModSummary]]
     -> [Either DriverMessages ModSummary])
    -> [[Either DriverMessages ModSummary]]
    -> [Either DriverMessages ModSummary]
    forall a b. (a -> b) -> a -> b
    $ DownsweepCache -> [[Either DriverMessages ModSummary]]
    forall k a. Map k a -> [a]
    M.elems DownsweepCache
    map0
               downsweep_nodes :: [ModuleGraphNode]
    downsweep_nodes = Map NodeKey ModuleGraphNode -> [ModuleGraphNode]
    forall k a. Map k a -> [a]
    M.elems Map NodeKey ModuleGraphNode
    deps

               ([DriverMessages]
    other_errs, [ModuleGraphNode]
    unit_nodes) = [Either DriverMessages ModuleGraphNode]
    -> ([DriverMessages], [ModuleGraphNode])
    forall a b. [Either a b] -> ([a], [b])
    partitionEithers ([Either DriverMessages ModuleGraphNode]
     -> ([DriverMessages], [ModuleGraphNode]))
    -> [Either DriverMessages ModuleGraphNode]
    -> ([DriverMessages], [ModuleGraphNode])
    forall a b. (a -> b) -> a -> b
    $ ([Either DriverMessages ModuleGraphNode]
     -> UnitId
     -> HomeUnitEnv
     -> [Either DriverMessages ModuleGraphNode])
    -> [Either DriverMessages ModuleGraphNode]
    -> UnitEnvGraph HomeUnitEnv
    -> [Either DriverMessages ModuleGraphNode]
    forall b a. (b -> UnitId -> a -> b) -> b -> UnitEnvGraph a -> b
    unitEnv_foldWithKey (\[Either DriverMessages ModuleGraphNode]
    nodes UnitId
    uid HomeUnitEnv
    hue -> [Either DriverMessages ModuleGraphNode]
    nodes [Either DriverMessages ModuleGraphNode]
    -> [Either DriverMessages ModuleGraphNode]
    -> [Either DriverMessages ModuleGraphNode]
    forall a. [a] -> [a] -> [a]
    ++ [ModuleGraphNode]
    -> UnitId -> HomeUnitEnv -> [Either DriverMessages ModuleGraphNode]
    unitModuleNodes [ModuleGraphNode]
    downsweep_nodes UnitId
    uid HomeUnitEnv
    hue) [] (HscEnv -> UnitEnvGraph HomeUnitEnv
    hsc_HUG HscEnv
    hsc_env)
               all_nodes :: [ModuleGraphNode]
    all_nodes = [ModuleGraphNode]
    downsweep_nodes [ModuleGraphNode] -> [ModuleGraphNode] -> [ModuleGraphNode]
    forall a. [a] -> [a] -> [a]
    ++ [ModuleGraphNode]
    unit_nodes
               all_errs :: [DriverMessages]
    all_errs  = [DriverMessages]
    all_root_errs [DriverMessages] -> [DriverMessages] -> [DriverMessages]
    forall a. [a] -> [a] -> [a]
    ++  [DriverMessages]
    downsweep_errs [DriverMessages] -> [DriverMessages] -> [DriverMessages]
    forall a. [a] -> [a] -> [a]
    ++ [DriverMessages]
    other_errs
               all_root_errs :: [DriverMessages]
    all_root_errs =  [DriverMessages]
    closure_errs [DriverMessages] -> [DriverMessages] -> [DriverMessages]
    forall a. [a] -> [a] -> [a]
    ++ ((UnitId, DriverMessages) -> DriverMessages)
    -> [(UnitId, DriverMessages)] -> [DriverMessages]
    forall a b. (a -> b) -> [a] -> [b]
    map (UnitId, DriverMessages) -> DriverMessages
    forall a b. (a, b) -> b
    snd [(UnitId, DriverMessages)]
    root_errs

           -- if we have been passed -fno-code, we enable code generation
           -- for dependencies of modules that have -XTemplateHaskell,
           -- otherwise those modules will fail to compile.
           -- See Note [-fno-code mode] #8025
           [ModuleGraphNode]
    th_enabled_nodes <- Logger
    -> TmpFs -> UnitEnv -> [ModuleGraphNode] -> IO [ModuleGraphNode]
    enableCodeGenForTH Logger
    logger TmpFs
    tmpfs UnitEnv
    unit_env [ModuleGraphNode]
    all_nodes
           if [DriverMessages] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [DriverMessages]
    all_root_errs
             then ([DriverMessages], [ModuleGraphNode])
    -> IO ([DriverMessages], [ModuleGraphNode])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([DriverMessages]
    all_errs, [ModuleGraphNode]
    th_enabled_nodes)
             else ([DriverMessages], [ModuleGraphNode])
    -> IO ([DriverMessages], [ModuleGraphNode])
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (([DriverMessages], [ModuleGraphNode])
     -> IO ([DriverMessages], [ModuleGraphNode]))
    -> ([DriverMessages], [ModuleGraphNode])
    -> IO ([DriverMessages], [ModuleGraphNode])
    forall a b. (a -> b) -> a -> b
    $ ([DriverMessages]
    all_root_errs, [])
         where
            -- Dependencies arising on a unit (backpack and module linking deps)
            unitModuleNodes :: [ModuleGraphNode] -> UnitId -> HomeUnitEnv -> [Either (Messages DriverMessage) ModuleGraphNode]
            unitModuleNodes :: [ModuleGraphNode]
    -> UnitId -> HomeUnitEnv -> [Either DriverMessages ModuleGraphNode]
    unitModuleNodes [ModuleGraphNode]
    summaries UnitId
    uid HomeUnitEnv
    hue =
              let instantiation_nodes :: [ModuleGraphNode]
    instantiation_nodes = UnitId -> UnitState -> [ModuleGraphNode]
    instantiationNodes UnitId
    uid (HomeUnitEnv -> UnitState
    homeUnitEnv_units HomeUnitEnv
    hue)
              in (ModuleGraphNode -> Either DriverMessages ModuleGraphNode)
    -> [ModuleGraphNode] -> [Either DriverMessages ModuleGraphNode]
    forall a b. (a -> b) -> [a] -> [b]
    map ModuleGraphNode -> Either DriverMessages ModuleGraphNode
    forall a b. b -> Either a b
    Right [ModuleGraphNode]
    instantiation_nodes
                  [Either DriverMessages ModuleGraphNode]
    -> [Either DriverMessages ModuleGraphNode]
    -> [Either DriverMessages ModuleGraphNode]
    forall a. [a] -> [a] -> [a]
    ++ Maybe (Either DriverMessages ModuleGraphNode)
    -> [Either DriverMessages ModuleGraphNode]
    forall a. Maybe a -> [a]
    maybeToList ([ModuleGraphNode]
    -> UnitId
    -> HomeUnitEnv
    -> Maybe (Either DriverMessages ModuleGraphNode)
    linkNodes ([ModuleGraphNode]
    instantiation_nodes [ModuleGraphNode] -> [ModuleGraphNode] -> [ModuleGraphNode]
    forall a. [a] -> [a] -> [a]
    ++ [ModuleGraphNode]
    summaries) UnitId
    uid HomeUnitEnv
    hue)

            calcDeps :: ModSummary
    -> [(UnitId, PkgQual,
         GenWithIsBoot (GenLocated SrcSpan ModuleName))]
    calcDeps ModSummary
    ms =
              -- Add a dependency on the HsBoot file if it exists
              -- This gets passed to the loopImports function which just ignores it if it
              -- can't be found.
              [(ModSummary -> UnitId
    ms_unitid ModSummary
    ms, PkgQual
    NoPkgQual, GenLocated SrcSpan ModuleName
    -> IsBootInterface -> GenWithIsBoot (GenLocated SrcSpan ModuleName)
    forall mod. mod -> IsBootInterface -> GenWithIsBoot mod
    GWIB (ModuleName -> GenLocated SrcSpan ModuleName
    forall e. e -> Located e
    noLoc (ModuleName -> GenLocated SrcSpan ModuleName)
    -> ModuleName -> GenLocated SrcSpan ModuleName
    forall a b. (a -> b) -> a -> b
    $ ModSummary -> ModuleName
    ms_mod_name ModSummary
    ms) IsBootInterface
    IsBoot) | IsBootInterface
    NotBoot <- [ModSummary -> IsBootInterface
    isBootSummary ModSummary
    ms] ] [(UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))]
    -> [(UnitId, PkgQual,
         GenWithIsBoot (GenLocated SrcSpan ModuleName))]
    -> [(UnitId, PkgQual,
         GenWithIsBoot (GenLocated SrcSpan ModuleName))]
    forall a. [a] -> [a] -> [a]
    ++
              [(ModSummary -> UnitId
    ms_unitid ModSummary
    ms, PkgQual
    b, GenWithIsBoot (GenLocated SrcSpan ModuleName)
    c) | (PkgQual
    b, GenWithIsBoot (GenLocated SrcSpan ModuleName)
    c) <- ModSummary
    -> [(PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))]
    msDeps ModSummary
    ms ]

            logger :: Logger
    logger = HscEnv -> Logger
    hsc_logger HscEnv
    hsc_env
            roots :: [Target]
    roots  = HscEnv -> [Target]
    hsc_targets HscEnv
    hsc_env

            -- A cache from file paths to the already summarised modules. The same file
            -- can be used in multiple units so the map is also keyed by which unit the
            -- file was used in.
            -- Reuse these if we can because the most expensive part of downsweep is
            -- reading the headers.
            old_summary_map :: M.Map (UnitId, FilePath) ModSummary
            old_summary_map :: Map (UnitId, FilePath) ModSummary
    old_summary_map = [((UnitId, FilePath), ModSummary)]
    -> Map (UnitId, FilePath) ModSummary
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [((ModSummary -> UnitId
    ms_unitid ModSummary
    ms, ModSummary -> FilePath
    msHsFilePath ModSummary
    ms), ModSummary
    ms) | ModSummary
    ms <- [ModSummary]
    old_summaries]

            getRootSummary :: Target -> IO (Either (UnitId, DriverMessages) ModSummary)
            getRootSummary :: Target -> IO (Either (UnitId, DriverMessages) ModSummary)
    getRootSummary Target { targetId :: Target -> TargetId
    targetId = TargetFile FilePath
    file Maybe Phase
    mb_phase
                                  , targetContents :: Target -> Maybe (InputFileBuffer, UTCTime)
    targetContents = Maybe (InputFileBuffer, UTCTime)
    maybe_buf
                                  , targetUnitId :: Target -> UnitId
    targetUnitId = UnitId
    uid
                                  }
               = do let offset_file :: FilePath
    offset_file = DynFlags -> FilePath -> FilePath
    augmentByWorkingDirectory DynFlags
    dflags FilePath
    file
                    Bool
    exists <- IO Bool -> IO Bool
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> IO Bool) -> IO Bool -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO Bool
    doesFileExist FilePath
    offset_file
                    if Bool
    exists Bool -> Bool -> Bool
    || Maybe (InputFileBuffer, UTCTime) -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe (InputFileBuffer, UTCTime)
    maybe_buf
                        then (DriverMessages -> (UnitId, DriverMessages))
    -> Either DriverMessages ModSummary
    -> Either (UnitId, DriverMessages) ModSummary
    forall a b c. (a -> b) -> Either a c -> Either b c
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first (UnitId
    uid,) (Either DriverMessages ModSummary
     -> Either (UnitId, DriverMessages) ModSummary)
    -> IO (Either DriverMessages ModSummary)
    -> IO (Either (UnitId, DriverMessages) ModSummary)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                            HscEnv
    -> HomeUnit
    -> Map (UnitId, FilePath) ModSummary
    -> FilePath
    -> Maybe Phase
    -> Maybe (InputFileBuffer, UTCTime)
    -> IO (Either DriverMessages ModSummary)
    summariseFile HscEnv
    hsc_env HomeUnit
    home_unit Map (UnitId, FilePath) ModSummary
    old_summary_map FilePath
    offset_file Maybe Phase
    mb_phase
                                           Maybe (InputFileBuffer, UTCTime)
    maybe_buf
                        else Either (UnitId, DriverMessages) ModSummary
    -> IO (Either (UnitId, DriverMessages) ModSummary)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either (UnitId, DriverMessages) ModSummary
     -> IO (Either (UnitId, DriverMessages) ModSummary))
    -> Either (UnitId, DriverMessages) ModSummary
    -> IO (Either (UnitId, DriverMessages) ModSummary)
    forall a b. (a -> b) -> a -> b
    $ (UnitId, DriverMessages)
    -> Either (UnitId, DriverMessages) ModSummary
    forall a b. a -> Either a b
    Left ((UnitId, DriverMessages)
     -> Either (UnitId, DriverMessages) ModSummary)
    -> (UnitId, DriverMessages)
    -> Either (UnitId, DriverMessages) ModSummary
    forall a b. (a -> b) -> a -> b
    $ (UnitId
    uid,) (DriverMessages -> (UnitId, DriverMessages))
    -> DriverMessages -> (UnitId, DriverMessages)
    forall a b. (a -> b) -> a -> b
    $ MsgEnvelope DriverMessage -> DriverMessages
    forall e. MsgEnvelope e -> Messages e
    singleMessage
                                    (MsgEnvelope DriverMessage -> DriverMessages)
    -> MsgEnvelope DriverMessage -> DriverMessages
    forall a b. (a -> b) -> a -> b
    $ SrcSpan -> DriverMessage -> MsgEnvelope DriverMessage
    forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
    mkPlainErrorMsgEnvelope SrcSpan
    noSrcSpan (FilePath -> DriverMessage
    DriverFileNotFound FilePath
    offset_file)
                where
                  dflags :: DynFlags
    dflags = HomeUnitEnv -> DynFlags
    homeUnitEnv_dflags (HasDebugCallStack => UnitId -> UnitEnv -> HomeUnitEnv
    UnitId -> UnitEnv -> HomeUnitEnv
    ue_findHomeUnitEnv UnitId
    uid (HscEnv -> UnitEnv
    hsc_unit_env HscEnv
    hsc_env))
                  home_unit :: HomeUnit
    home_unit = UnitId -> UnitEnv -> HomeUnit
    ue_unitHomeUnit UnitId
    uid (HscEnv -> UnitEnv
    hsc_unit_env HscEnv
    hsc_env)
            getRootSummary Target { targetId :: Target -> TargetId
    targetId = TargetModule ModuleName
    modl
                                  , targetContents :: Target -> Maybe (InputFileBuffer, UTCTime)
    targetContents = Maybe (InputFileBuffer, UTCTime)
    maybe_buf
                                  , targetUnitId :: Target -> UnitId
    targetUnitId = UnitId
    uid
                                  }
               = do SummariseResult
    maybe_summary <- HscEnv
    -> HomeUnit
    -> Map (UnitId, FilePath) ModSummary
    -> IsBootInterface
    -> GenLocated SrcSpan ModuleName
    -> PkgQual
    -> Maybe (InputFileBuffer, UTCTime)
    -> [ModuleName]
    -> IO SummariseResult
    summariseModule HscEnv
    hsc_env HomeUnit
    home_unit Map (UnitId, FilePath) ModSummary
    old_summary_map IsBootInterface
    NotBoot
                                               (SrcSpan -> ModuleName -> GenLocated SrcSpan ModuleName
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    rootLoc ModuleName
    modl) (UnitId -> PkgQual
    ThisPkg (HomeUnit -> UnitId
    forall u. GenHomeUnit u -> UnitId
    homeUnitId HomeUnit
    home_unit))
                                               Maybe (InputFileBuffer, UTCTime)
    maybe_buf [ModuleName]
    excl_mods
                    case SummariseResult
    maybe_summary of
                       FoundHome ModSummary
    s  -> Either (UnitId, DriverMessages) ModSummary
    -> IO (Either (UnitId, DriverMessages) ModSummary)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ModSummary -> Either (UnitId, DriverMessages) ModSummary
    forall a b. b -> Either a b
    Right ModSummary
    s)
                       FoundHomeWithError (UnitId, DriverMessages)
    err -> Either (UnitId, DriverMessages) ModSummary
    -> IO (Either (UnitId, DriverMessages) ModSummary)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((UnitId, DriverMessages)
    -> Either (UnitId, DriverMessages) ModSummary
    forall a b. a -> Either a b
    Left (UnitId, DriverMessages)
    err)
                       SummariseResult
    _ -> Either (UnitId, DriverMessages) ModSummary
    -> IO (Either (UnitId, DriverMessages) ModSummary)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either (UnitId, DriverMessages) ModSummary
     -> IO (Either (UnitId, DriverMessages) ModSummary))
    -> Either (UnitId, DriverMessages) ModSummary
    -> IO (Either (UnitId, DriverMessages) ModSummary)
    forall a b. (a -> b) -> a -> b
    $ (UnitId, DriverMessages)
    -> Either (UnitId, DriverMessages) ModSummary
    forall a b. a -> Either a b
    Left ((UnitId, DriverMessages)
     -> Either (UnitId, DriverMessages) ModSummary)
    -> (UnitId, DriverMessages)
    -> Either (UnitId, DriverMessages) ModSummary
    forall a b. (a -> b) -> a -> b
    $ (UnitId
    uid, ModuleName -> DriverMessages
    moduleNotFoundErr ModuleName
    modl)
                where
                  home_unit :: HomeUnit
    home_unit = UnitId -> UnitEnv -> HomeUnit
    ue_unitHomeUnit UnitId
    uid (HscEnv -> UnitEnv
    hsc_unit_env HscEnv
    hsc_env)
            rootLoc :: SrcSpan
    rootLoc = FastString -> SrcSpan
    mkGeneralSrcSpan (FilePath -> FastString
    fsLit FilePath
    "<command line>")

            -- In a root module, the filename is allowed to diverge from the module
            -- name, so we have to check that there aren't multiple root files
            -- defining the same module (otherwise the duplicates will be silently
            -- ignored, leading to confusing behaviour).
            checkDuplicates
              :: DownsweepCache
              -> IO ()
            checkDuplicates :: DownsweepCache -> IO ()
    checkDuplicates DownsweepCache
    root_map
               | Bool
    allow_dup_roots = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
               | [[ModSummary]] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [[ModSummary]]
    dup_roots  = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
               | Bool
    otherwise       = IO () -> IO ()
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [ModSummary] -> IO ()
    multiRootsErr ([[ModSummary]] -> [ModSummary]
    forall a. HasCallStack => [a] -> a
    head [[ModSummary]]
    dup_roots)
               where
                 dup_roots :: [[ModSummary]]        -- Each at least of length 2
                 dup_roots :: [[ModSummary]]
    dup_roots = ([ModSummary] -> Bool) -> [[ModSummary]] -> [[ModSummary]]
    forall a. (a -> Bool) -> [a] -> [a]
    filterOut [ModSummary] -> Bool
    forall a. [a] -> Bool
    isSingleton ([[ModSummary]] -> [[ModSummary]])
    -> [[ModSummary]] -> [[ModSummary]]
    forall a b. (a -> b) -> a -> b
    $ ([Either DriverMessages ModSummary] -> [ModSummary])
    -> [[Either DriverMessages ModSummary]] -> [[ModSummary]]
    forall a b. (a -> b) -> [a] -> [b]
    map [Either DriverMessages ModSummary] -> [ModSummary]
    forall a b. [Either a b] -> [b]
    rights (DownsweepCache -> [[Either DriverMessages ModSummary]]
    forall k a. Map k a -> [a]
    M.elems DownsweepCache
    root_map)

            -- This loops over all the mod summaries in the dependency graph, accumulates the actual dependencies for each module/unit
            loopSummaries :: [ModSummary]
                  -> (M.Map NodeKey ModuleGraphNode,
                        DownsweepCache)
                  -> IO ((M.Map NodeKey ModuleGraphNode), DownsweepCache)
            loopSummaries :: [ModSummary]
    -> (Map NodeKey ModuleGraphNode, DownsweepCache)
    -> IO (Map NodeKey ModuleGraphNode, DownsweepCache)
    loopSummaries [] (Map NodeKey ModuleGraphNode, DownsweepCache)
    done = (Map NodeKey ModuleGraphNode, DownsweepCache)
    -> IO (Map NodeKey ModuleGraphNode, DownsweepCache)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Map NodeKey ModuleGraphNode, DownsweepCache)
    done
            loopSummaries (ModSummary
    ms:[ModSummary]
    next) (Map NodeKey ModuleGraphNode
    done, DownsweepCache
    summarised)
              | Just {} <- NodeKey -> Map NodeKey ModuleGraphNode -> Maybe ModuleGraphNode
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup NodeKey
    k Map NodeKey ModuleGraphNode
    done
              = [ModSummary]
    -> (Map NodeKey ModuleGraphNode, DownsweepCache)
    -> IO (Map NodeKey ModuleGraphNode, DownsweepCache)
    loopSummaries [ModSummary]
    next (Map NodeKey ModuleGraphNode
    done, DownsweepCache
    summarised)
              -- Didn't work out what the imports mean yet, now do that.
              | Bool
    otherwise = do
                 ([NodeKey]
    final_deps, Map NodeKey ModuleGraphNode
    done', DownsweepCache
    summarised') <- [(UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))]
    -> Map NodeKey ModuleGraphNode
    -> DownsweepCache
    -> IO ([NodeKey], Map NodeKey ModuleGraphNode, DownsweepCache)
    loopImports (ModSummary
    -> [(UnitId, PkgQual,
         GenWithIsBoot (GenLocated SrcSpan ModuleName))]
    calcDeps ModSummary
    ms) Map NodeKey ModuleGraphNode
    done DownsweepCache
    summarised
                 -- This has the effect of finding a .hs file if we are looking at the .hs-boot file.
                 ([NodeKey]
    _, Map NodeKey ModuleGraphNode
    done'', DownsweepCache
    summarised'') <- [(UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))]
    -> Map NodeKey ModuleGraphNode
    -> DownsweepCache
    -> IO ([NodeKey], Map NodeKey ModuleGraphNode, DownsweepCache)
    loopImports (Maybe
      (UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))
    -> [(UnitId, PkgQual,
         GenWithIsBoot (GenLocated SrcSpan ModuleName))]
    forall a. Maybe a -> [a]
    maybeToList Maybe
      (UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))
    hs_file_for_boot) Map NodeKey ModuleGraphNode
    done' DownsweepCache
    summarised'
                 [ModSummary]
    -> (Map NodeKey ModuleGraphNode, DownsweepCache)
    -> IO (Map NodeKey ModuleGraphNode, DownsweepCache)
    loopSummaries [ModSummary]
    next (NodeKey
    -> ModuleGraphNode
    -> Map NodeKey ModuleGraphNode
    -> Map NodeKey ModuleGraphNode
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert NodeKey
    k ([NodeKey] -> ModSummary -> ModuleGraphNode
    ModuleNode [NodeKey]
    final_deps ModSummary
    ms) Map NodeKey ModuleGraphNode
    done'', DownsweepCache
    summarised'')
              where
                k :: NodeKey
    k = ModNodeKeyWithUid -> NodeKey
    NodeKey_Module (ModSummary -> ModNodeKeyWithUid
    msKey ModSummary
    ms)

                hs_file_for_boot :: Maybe
      (UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))
    hs_file_for_boot
                  | HscSource
    HsBootFile <- ModSummary -> HscSource
    ms_hsc_src ModSummary
    ms
                  = (UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))
    -> Maybe
         (UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))
    forall a. a -> Maybe a
    Just ((UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))
     -> Maybe
          (UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName)))
    -> (UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))
    -> Maybe
         (UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))
    forall a b. (a -> b) -> a -> b
    $ ((ModSummary -> UnitId
    ms_unitid ModSummary
    ms), PkgQual
    NoPkgQual, (GenLocated SrcSpan ModuleName
    -> IsBootInterface -> GenWithIsBoot (GenLocated SrcSpan ModuleName)
    forall mod. mod -> IsBootInterface -> GenWithIsBoot mod
    GWIB (ModuleName -> GenLocated SrcSpan ModuleName
    forall e. e -> Located e
    noLoc (ModuleName -> GenLocated SrcSpan ModuleName)
    -> ModuleName -> GenLocated SrcSpan ModuleName
    forall a b. (a -> b) -> a -> b
    $ ModSummary -> ModuleName
    ms_mod_name ModSummary
    ms) IsBootInterface
    NotBoot))
                  | Bool
    otherwise
                  = Maybe
      (UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))
    forall a. Maybe a
    Nothing

            -- This loops over each import in each summary. It is mutually recursive with loopSummaries if we discover
            -- a new module by doing this.
            loopImports :: [(UnitId, PkgQual, GenWithIsBoot (Located ModuleName))]
                            -- Work list: process these modules
                 -> M.Map NodeKey ModuleGraphNode
                 -> DownsweepCache
                            -- Visited set; the range is a list because
                            -- the roots can have the same module names
                            -- if allow_dup_roots is True
                 -> IO ([NodeKey],
                      M.Map NodeKey ModuleGraphNode, DownsweepCache)
                            -- The result is the completed NodeMap
            loopImports :: [(UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))]
    -> Map NodeKey ModuleGraphNode
    -> DownsweepCache
    -> IO ([NodeKey], Map NodeKey ModuleGraphNode, DownsweepCache)
    loopImports [] Map NodeKey ModuleGraphNode
    done DownsweepCache
    summarised = ([NodeKey], Map NodeKey ModuleGraphNode, DownsweepCache)
    -> IO ([NodeKey], Map NodeKey ModuleGraphNode, DownsweepCache)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], Map NodeKey ModuleGraphNode
    done, DownsweepCache
    summarised)
            loopImports ((UnitId
    home_uid,PkgQual
    mb_pkg, GenWithIsBoot (GenLocated SrcSpan ModuleName)
    gwib) : [(UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))]
    ss) Map NodeKey ModuleGraphNode
    done DownsweepCache
    summarised
              | Just [Either DriverMessages ModSummary]
    summs <- (UnitId, PkgQual, ModuleNameWithIsBoot)
    -> DownsweepCache -> Maybe [Either DriverMessages ModSummary]
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup (UnitId, PkgQual, ModuleNameWithIsBoot)
    cache_key DownsweepCache
    summarised
              = case [Either DriverMessages ModSummary]
    summs of
                  [Right ModSummary
    ms] -> do
                    let nk :: NodeKey
    nk = ModNodeKeyWithUid -> NodeKey
    NodeKey_Module (ModSummary -> ModNodeKeyWithUid
    msKey ModSummary
    ms)
                    ([NodeKey]
    rest, Map NodeKey ModuleGraphNode
    summarised', DownsweepCache
    done') <- [(UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))]
    -> Map NodeKey ModuleGraphNode
    -> DownsweepCache
    -> IO ([NodeKey], Map NodeKey ModuleGraphNode, DownsweepCache)
    loopImports [(UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))]
    ss Map NodeKey ModuleGraphNode
    done DownsweepCache
    summarised
                    ([NodeKey], Map NodeKey ModuleGraphNode, DownsweepCache)
    -> IO ([NodeKey], Map NodeKey ModuleGraphNode, DownsweepCache)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (NodeKey
    nkNodeKey -> [NodeKey] -> [NodeKey]
    forall a. a -> [a] -> [a]
    : [NodeKey]
    rest, Map NodeKey ModuleGraphNode
    summarised', DownsweepCache
    done')
                  [Left DriverMessages
    _err] ->
                    [(UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))]
    -> Map NodeKey ModuleGraphNode
    -> DownsweepCache
    -> IO ([NodeKey], Map NodeKey ModuleGraphNode, DownsweepCache)
    loopImports [(UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))]
    ss Map NodeKey ModuleGraphNode
    done DownsweepCache
    summarised
                  [Either DriverMessages ModSummary]
    _errs ->  do
                    [(UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))]
    -> Map NodeKey ModuleGraphNode
    -> DownsweepCache
    -> IO ([NodeKey], Map NodeKey ModuleGraphNode, DownsweepCache)
    loopImports [(UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))]
    ss Map NodeKey ModuleGraphNode
    done DownsweepCache
    summarised
              | Bool
    otherwise
              = do
                   SummariseResult
    mb_s <- HscEnv
    -> HomeUnit
    -> Map (UnitId, FilePath) ModSummary
    -> IsBootInterface
    -> GenLocated SrcSpan ModuleName
    -> PkgQual
    -> Maybe (InputFileBuffer, UTCTime)
    -> [ModuleName]
    -> IO SummariseResult
    summariseModule HscEnv
    hsc_env HomeUnit
    home_unit Map (UnitId, FilePath) ModSummary
    old_summary_map
                                           IsBootInterface
    is_boot GenLocated SrcSpan ModuleName
    wanted_mod PkgQual
    mb_pkg
                                           Maybe (InputFileBuffer, UTCTime)
    forall a. Maybe a
    Nothing [ModuleName]
    excl_mods
                   case SummariseResult
    mb_s of
                       SummariseResult
    NotThere -> [(UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))]
    -> Map NodeKey ModuleGraphNode
    -> DownsweepCache
    -> IO ([NodeKey], Map NodeKey ModuleGraphNode, DownsweepCache)
    loopImports [(UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))]
    ss Map NodeKey ModuleGraphNode
    done DownsweepCache
    summarised
                       External UnitId
    _ -> do
                        ([NodeKey]
    other_deps, Map NodeKey ModuleGraphNode
    done', DownsweepCache
    summarised') <- [(UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))]
    -> Map NodeKey ModuleGraphNode
    -> DownsweepCache
    -> IO ([NodeKey], Map NodeKey ModuleGraphNode, DownsweepCache)
    loopImports [(UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))]
    ss Map NodeKey ModuleGraphNode
    done DownsweepCache
    summarised
                        ([NodeKey], Map NodeKey ModuleGraphNode, DownsweepCache)
    -> IO ([NodeKey], Map NodeKey ModuleGraphNode, DownsweepCache)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([NodeKey]
    other_deps, Map NodeKey ModuleGraphNode
    done', DownsweepCache
    summarised')
                       FoundInstantiation InstantiatedUnit
    iud -> do
                        ([NodeKey]
    other_deps, Map NodeKey ModuleGraphNode
    done', DownsweepCache
    summarised') <- [(UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))]
    -> Map NodeKey ModuleGraphNode
    -> DownsweepCache
    -> IO ([NodeKey], Map NodeKey ModuleGraphNode, DownsweepCache)
    loopImports [(UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))]
    ss Map NodeKey ModuleGraphNode
    done DownsweepCache
    summarised
                        ([NodeKey], Map NodeKey ModuleGraphNode, DownsweepCache)
    -> IO ([NodeKey], Map NodeKey ModuleGraphNode, DownsweepCache)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (InstantiatedUnit -> NodeKey
    NodeKey_Unit InstantiatedUnit
    iud NodeKey -> [NodeKey] -> [NodeKey]
    forall a. a -> [a] -> [a]
    : [NodeKey]
    other_deps, Map NodeKey ModuleGraphNode
    done', DownsweepCache
    summarised')
                       FoundHomeWithError (UnitId
    _uid, DriverMessages
    e) ->  [(UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))]
    -> Map NodeKey ModuleGraphNode
    -> DownsweepCache
    -> IO ([NodeKey], Map NodeKey ModuleGraphNode, DownsweepCache)
    loopImports [(UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))]
    ss Map NodeKey ModuleGraphNode
    done ((UnitId, PkgQual, ModuleNameWithIsBoot)
    -> [Either DriverMessages ModSummary]
    -> DownsweepCache
    -> DownsweepCache
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert (UnitId, PkgQual, ModuleNameWithIsBoot)
    cache_key [(DriverMessages -> Either DriverMessages ModSummary
    forall a b. a -> Either a b
    Left DriverMessages
    e)] DownsweepCache
    summarised)
                       FoundHome ModSummary
    s -> do
                         (Map NodeKey ModuleGraphNode
    done', DownsweepCache
    summarised') <-
                           [ModSummary]
    -> (Map NodeKey ModuleGraphNode, DownsweepCache)
    -> IO (Map NodeKey ModuleGraphNode, DownsweepCache)
    loopSummaries [ModSummary
    s] (Map NodeKey ModuleGraphNode
    done, (UnitId, PkgQual, ModuleNameWithIsBoot)
    -> [Either DriverMessages ModSummary]
    -> DownsweepCache
    -> DownsweepCache
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert (UnitId, PkgQual, ModuleNameWithIsBoot)
    cache_key [ModSummary -> Either DriverMessages ModSummary
    forall a b. b -> Either a b
    Right ModSummary
    s] DownsweepCache
    summarised)
                         ([NodeKey]
    other_deps, Map NodeKey ModuleGraphNode
    final_done, DownsweepCache
    final_summarised) <- [(UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))]
    -> Map NodeKey ModuleGraphNode
    -> DownsweepCache
    -> IO ([NodeKey], Map NodeKey ModuleGraphNode, DownsweepCache)
    loopImports [(UnitId, PkgQual, GenWithIsBoot (GenLocated SrcSpan ModuleName))]
    ss Map NodeKey ModuleGraphNode
    done' DownsweepCache
    summarised'

                         -- MP: This assumes that we can only instantiate non home units, which is probably fair enough for now.
                         ([NodeKey], Map NodeKey ModuleGraphNode, DownsweepCache)
    -> IO ([NodeKey], Map NodeKey ModuleGraphNode, DownsweepCache)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ModNodeKeyWithUid -> NodeKey
    NodeKey_Module (ModSummary -> ModNodeKeyWithUid
    msKey ModSummary
    s) NodeKey -> [NodeKey] -> [NodeKey]
    forall a. a -> [a] -> [a]
    : [NodeKey]
    other_deps, Map NodeKey ModuleGraphNode
    final_done, DownsweepCache
    final_summarised)
              where
                cache_key :: (UnitId, PkgQual, ModuleNameWithIsBoot)
    cache_key = (UnitId
    home_uid, PkgQual
    mb_pkg, GenLocated SrcSpan ModuleName -> ModuleName
    forall l e. GenLocated l e -> e
    unLoc (GenLocated SrcSpan ModuleName -> ModuleName)
    -> GenWithIsBoot (GenLocated SrcSpan ModuleName)
    -> ModuleNameWithIsBoot
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> GenWithIsBoot (GenLocated SrcSpan ModuleName)
    gwib)
                home_unit :: HomeUnit
    home_unit = UnitId -> UnitEnv -> HomeUnit
    ue_unitHomeUnit UnitId
    home_uid (HscEnv -> UnitEnv
    hsc_unit_env HscEnv
    hsc_env)
                GWIB { gwib_mod :: forall mod. GenWithIsBoot mod -> mod
    gwib_mod = L SrcSpan
    loc ModuleName
    mod, gwib_isBoot :: forall mod. GenWithIsBoot mod -> IsBootInterface
    gwib_isBoot = IsBootInterface
    is_boot } = GenWithIsBoot (GenLocated SrcSpan ModuleName)
    gwib
                wanted_mod :: GenLocated SrcSpan ModuleName
    wanted_mod = SrcSpan -> ModuleName -> GenLocated SrcSpan ModuleName
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc ModuleName
    mod

    -- | This function checks then important property that if both p and q are home units
    -- then any dependency of p, which transitively depends on q is also a home unit.
    --
    -- See Note [Multiple Home Units], section 'Closure Property'.
    checkHomeUnitsClosed ::  UnitEnv -> [DriverMessages]
    checkHomeUnitsClosed :: UnitEnv -> [DriverMessages]
    checkHomeUnitsClosed UnitEnv
    ue
        | Set UnitId -> Bool
    forall a. Set a -> Bool
    Set.null Set UnitId
    bad_unit_ids = []
        | Bool
    otherwise = [MsgEnvelope DriverMessage -> DriverMessages
    forall e. MsgEnvelope e -> Messages e
    singleMessage (MsgEnvelope DriverMessage -> DriverMessages)
    -> MsgEnvelope DriverMessage -> DriverMessages
    forall a b. (a -> b) -> a -> b
    $ SrcSpan -> DriverMessage -> MsgEnvelope DriverMessage
    forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
    mkPlainErrorMsgEnvelope SrcSpan
    rootLoc (DriverMessage -> MsgEnvelope DriverMessage)
    -> DriverMessage -> MsgEnvelope DriverMessage
    forall a b. (a -> b) -> a -> b
    $ [UnitId] -> DriverMessage
    DriverHomePackagesNotClosed (Set UnitId -> [UnitId]
    forall a. Set a -> [a]
    Set.toList Set UnitId
    bad_unit_ids)]
      where
        home_id_set :: Set UnitId
    home_id_set = UnitEnvGraph HomeUnitEnv -> Set UnitId
    forall v. UnitEnvGraph v -> Set UnitId
    unitEnv_keys (UnitEnvGraph HomeUnitEnv -> Set UnitId)
    -> UnitEnvGraph HomeUnitEnv -> Set UnitId
    forall a b. (a -> b) -> a -> b
    $ UnitEnv -> UnitEnvGraph HomeUnitEnv
    ue_home_unit_graph UnitEnv
    ue
        bad_unit_ids :: Set UnitId
    bad_unit_ids = Set UnitId
    upwards_closure Set UnitId -> Set UnitId -> Set UnitId
    forall a. Ord a => Set a -> Set a -> Set a
    Set.\\ Set UnitId
    home_id_set
        rootLoc :: SrcSpan
    rootLoc = FastString -> SrcSpan
    mkGeneralSrcSpan (FilePath -> FastString
    fsLit FilePath
    "<command line>")

        graph :: Graph (Node UnitId UnitId)
        graph :: Graph (Node UnitId UnitId)
    graph = [Node UnitId UnitId] -> Graph (Node UnitId UnitId)
    forall key payload.
    Uniquable key =>
    [Node key payload] -> Graph (Node key payload)
    graphFromEdgedVerticesUniq [Node UnitId UnitId]
    graphNodes

        -- downwards closure of graph
        downwards_closure :: Graph (Node UnitId UnitId)
    downwards_closure
          = [Node UnitId UnitId] -> Graph (Node UnitId UnitId)
    forall key payload.
    Uniquable key =>
    [Node key payload] -> Graph (Node key payload)
    graphFromEdgedVerticesUniq [ UnitId -> UnitId -> [UnitId] -> Node UnitId UnitId
    forall key payload. payload -> key -> [key] -> Node key payload
    DigraphNode UnitId
    uid UnitId
    uid (Set UnitId -> [UnitId]
    forall a. Set a -> [a]
    Set.toList Set UnitId
    deps)
                                       | (UnitId
    uid, Set UnitId
    deps) <- Map UnitId (Set UnitId) -> [(UnitId, Set UnitId)]
    forall k a. Map k a -> [(k, a)]
    M.toList (Graph (Node UnitId UnitId)
    -> (Node UnitId UnitId -> UnitId) -> Map UnitId (Set UnitId)
    forall key node.
    Ord key =>
    Graph node -> (node -> key) -> Map key (Set key)
    allReachable Graph (Node UnitId UnitId)
    graph Node UnitId UnitId -> UnitId
    forall key payload. Node key payload -> key
    node_key)]

        inverse_closure :: Graph (Node UnitId UnitId)
    inverse_closure = Graph (Node UnitId UnitId) -> Graph (Node UnitId UnitId)
    forall node. Graph node -> Graph node
    transposeG Graph (Node UnitId UnitId)
    downwards_closure

        upwards_closure :: Set UnitId
    upwards_closure = [UnitId] -> Set UnitId
    forall a. Ord a => [a] -> Set a
    Set.fromList ([UnitId] -> Set UnitId) -> [UnitId] -> Set UnitId
    forall a b. (a -> b) -> a -> b
    $ (Node UnitId UnitId -> UnitId) -> [Node UnitId UnitId] -> [UnitId]
    forall a b. (a -> b) -> [a] -> [b]
    map Node UnitId UnitId -> UnitId
    forall key payload. Node key payload -> key
    node_key ([Node UnitId UnitId] -> [UnitId])
    -> [Node UnitId UnitId] -> [UnitId]
    forall a b. (a -> b) -> a -> b
    $ Graph (Node UnitId UnitId)
    -> [Node UnitId UnitId] -> [Node UnitId UnitId]
    forall node. Graph node -> [node] -> [node]
    reachablesG Graph (Node UnitId UnitId)
    inverse_closure [UnitId -> UnitId -> [UnitId] -> Node UnitId UnitId
    forall key payload. payload -> key -> [key] -> Node key payload
    DigraphNode UnitId
    uid UnitId
    uid [] | UnitId
    uid <- Set UnitId -> [UnitId]
    forall a. Set a -> [a]
    Set.toList Set UnitId
    home_id_set]

        all_unit_direct_deps :: UniqMap UnitId (Set.Set UnitId)
        all_unit_direct_deps :: UniqMap UnitId (Set UnitId)
    all_unit_direct_deps
          = (UniqMap UnitId (Set UnitId)
     -> UnitId -> HomeUnitEnv -> UniqMap UnitId (Set UnitId))
    -> UniqMap UnitId (Set UnitId)
    -> UnitEnvGraph HomeUnitEnv
    -> UniqMap UnitId (Set UnitId)
    forall b a. (b -> UnitId -> a -> b) -> b -> UnitEnvGraph a -> b
    unitEnv_foldWithKey UniqMap UnitId (Set UnitId)
    -> UnitId -> HomeUnitEnv -> UniqMap UnitId (Set UnitId)
    go UniqMap UnitId (Set UnitId)
    forall k a. UniqMap k a
    emptyUniqMap (UnitEnvGraph HomeUnitEnv -> UniqMap UnitId (Set UnitId))
    -> UnitEnvGraph HomeUnitEnv -> UniqMap UnitId (Set UnitId)
    forall a b. (a -> b) -> a -> b
    $ UnitEnv -> UnitEnvGraph HomeUnitEnv
    ue_home_unit_graph UnitEnv
    ue
          where
            go :: UniqMap UnitId (Set UnitId)
    -> UnitId -> HomeUnitEnv -> UniqMap UnitId (Set UnitId)
    go UniqMap UnitId (Set UnitId)
    rest UnitId
    this HomeUnitEnv
    this_uis =
               (Set UnitId -> Set UnitId -> Set UnitId)
    -> UniqMap UnitId (Set UnitId)
    -> UniqMap UnitId (Set UnitId)
    -> UniqMap UnitId (Set UnitId)
    forall a k.
    (a -> a -> a) -> UniqMap k a -> UniqMap k a -> UniqMap k a
    plusUniqMap_C Set UnitId -> Set UnitId -> Set UnitId
    forall a. Ord a => Set a -> Set a -> Set a
    Set.union
                 ((Set UnitId -> Set UnitId -> Set UnitId)
    -> UniqMap UnitId (Set UnitId)
    -> UnitId
    -> Set UnitId
    -> UniqMap UnitId (Set UnitId)
    forall k a.
    Uniquable k =>
    (a -> a -> a) -> UniqMap k a -> k -> a -> UniqMap k a
    addToUniqMap_C Set UnitId -> Set UnitId -> Set UnitId
    forall a. Ord a => Set a -> Set a -> Set a
    Set.union UniqMap UnitId (Set UnitId)
    external_depends UnitId
    this ([UnitId] -> Set UnitId
    forall a. Ord a => [a] -> Set a
    Set.fromList ([UnitId] -> Set UnitId) -> [UnitId] -> Set UnitId
    forall a b. (a -> b) -> a -> b
    $ [UnitId]
    this_deps))
                 UniqMap UnitId (Set UnitId)
    rest
               where
                 external_depends :: UniqMap UnitId (Set UnitId)
    external_depends = (UnitInfo -> Set UnitId)
    -> UniqMap UnitId UnitInfo -> UniqMap UnitId (Set UnitId)
    forall a b k. (a -> b) -> UniqMap k a -> UniqMap k b
    mapUniqMap ([UnitId] -> Set UnitId
    forall a. Ord a => [a] -> Set a
    Set.fromList ([UnitId] -> Set UnitId)
    -> (UnitInfo -> [UnitId]) -> UnitInfo -> Set UnitId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . UnitInfo -> [UnitId]
    forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> [uid]
    unitDepends) (UnitState -> UniqMap UnitId UnitInfo
    unitInfoMap UnitState
    this_units)
                 this_units :: UnitState
    this_units = HomeUnitEnv -> UnitState
    homeUnitEnv_units HomeUnitEnv
    this_uis
                 this_deps :: [UnitId]
    this_deps = [ GenUnit UnitId -> UnitId
    toUnitId GenUnit UnitId
    unit | (GenUnit UnitId
    unit,Just PackageArg
    _) <- UnitState -> [(GenUnit UnitId, Maybe PackageArg)]
    explicitUnits UnitState
    this_units]

        graphNodes :: [Node UnitId UnitId]
        graphNodes :: [Node UnitId UnitId]
    graphNodes = Set UnitId -> Set UnitId -> [Node UnitId UnitId]
    go Set UnitId
    forall a. Set a
    Set.empty Set UnitId
    home_id_set
          where
            go :: Set UnitId -> Set UnitId -> [Node UnitId UnitId]
    go Set UnitId
    done Set UnitId
    todo
              = case Set UnitId -> Maybe (UnitId, Set UnitId)
    forall a. Set a -> Maybe (a, Set a)
    Set.minView Set UnitId
    todo of
                  Maybe (UnitId, Set UnitId)
    Nothing -> []
                  Just (UnitId
    uid, Set UnitId
    todo')
                    | UnitId -> Set UnitId -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member UnitId
    uid Set UnitId
    done -> Set UnitId -> Set UnitId -> [Node UnitId UnitId]
    go Set UnitId
    done Set UnitId
    todo'
                    | Bool
    otherwise -> case UniqMap UnitId (Set UnitId) -> UnitId -> Maybe (Set UnitId)
    forall k a. Uniquable k => UniqMap k a -> k -> Maybe a
    lookupUniqMap UniqMap UnitId (Set UnitId)
    all_unit_direct_deps UnitId
    uid of
                        Maybe (Set UnitId)
    Nothing -> FilePath -> SDoc -> [Node UnitId UnitId]
    forall a. HasCallStack => FilePath -> SDoc -> a
    pprPanic FilePath
    "uid not found" ((UnitId, UniqMap UnitId (Set UnitId)) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (UnitId
    uid, UniqMap UnitId (Set UnitId)
    all_unit_direct_deps))
                        Just Set UnitId
    depends ->
                          let todo'' :: Set UnitId
    todo'' = (Set UnitId
    depends Set UnitId -> Set UnitId -> Set UnitId
    forall a. Ord a => Set a -> Set a -> Set a
    Set.\\ Set UnitId
    done) Set UnitId -> Set UnitId -> Set UnitId
    forall a. Ord a => Set a -> Set a -> Set a
    `Set.union` Set UnitId
    todo'
                          in UnitId -> UnitId -> [UnitId] -> Node UnitId UnitId
    forall key payload. payload -> key -> [key] -> Node key payload
    DigraphNode UnitId
    uid UnitId
    uid (Set UnitId -> [UnitId]
    forall a. Set a -> [a]
    Set.toList Set UnitId
    depends) Node UnitId UnitId -> [Node UnitId UnitId] -> [Node UnitId UnitId]
    forall a. a -> [a] -> [a]
    : Set UnitId -> Set UnitId -> [Node UnitId UnitId]
    go (UnitId -> Set UnitId -> Set UnitId
    forall a. Ord a => a -> Set a -> Set a
    Set.insert UnitId
    uid Set UnitId
    done) Set UnitId
    todo''

    -- | Update the every ModSummary that is depended on
    -- by a module that needs template haskell. We enable codegen to
    -- the specified target, disable optimization and change the .hi
    -- and .o file locations to be temporary files.
    -- See Note [-fno-code mode]
    enableCodeGenForTH
      :: Logger
      -> TmpFs
      -> UnitEnv
      -> [ModuleGraphNode]
      -> IO [ModuleGraphNode]
    enableCodeGenForTH :: Logger
    -> TmpFs -> UnitEnv -> [ModuleGraphNode] -> IO [ModuleGraphNode]
    enableCodeGenForTH Logger
    logger TmpFs
    tmpfs UnitEnv
    unit_env =
      Logger
    -> TmpFs
    -> TempFileLifetime
    -> TempFileLifetime
    -> UnitEnv
    -> [ModuleGraphNode]
    -> IO [ModuleGraphNode]
    enableCodeGenWhen Logger
    logger TmpFs
    tmpfs TempFileLifetime
    TFL_CurrentModule TempFileLifetime
    TFL_GhcSession UnitEnv
    unit_env

    data CodeGenEnable = EnableByteCode | EnableObject | EnableByteCodeAndObject deriving (CodeGenEnable -> CodeGenEnable -> Bool
    (CodeGenEnable -> CodeGenEnable -> Bool)
    -> (CodeGenEnable -> CodeGenEnable -> Bool) -> Eq CodeGenEnable
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: CodeGenEnable -> CodeGenEnable -> Bool
    == :: CodeGenEnable -> CodeGenEnable -> Bool
    $c/= :: CodeGenEnable -> CodeGenEnable -> Bool
    /= :: CodeGenEnable -> CodeGenEnable -> Bool
    Eq, Int -> CodeGenEnable -> FilePath -> FilePath
    [CodeGenEnable] -> FilePath -> FilePath
    CodeGenEnable -> FilePath
    (Int -> CodeGenEnable -> FilePath -> FilePath)
    -> (CodeGenEnable -> FilePath)
    -> ([CodeGenEnable] -> FilePath -> FilePath)
    -> Show CodeGenEnable
    forall a.
    (Int -> a -> FilePath -> FilePath)
    -> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
    $cshowsPrec :: Int -> CodeGenEnable -> FilePath -> FilePath
    showsPrec :: Int -> CodeGenEnable -> FilePath -> FilePath
    $cshow :: CodeGenEnable -> FilePath
    show :: CodeGenEnable -> FilePath
    $cshowList :: [CodeGenEnable] -> FilePath -> FilePath
    showList :: [CodeGenEnable] -> FilePath -> FilePath
    Show, Eq CodeGenEnable
    Eq CodeGenEnable =>
    (CodeGenEnable -> CodeGenEnable -> Ordering)
    -> (CodeGenEnable -> CodeGenEnable -> Bool)
    -> (CodeGenEnable -> CodeGenEnable -> Bool)
    -> (CodeGenEnable -> CodeGenEnable -> Bool)
    -> (CodeGenEnable -> CodeGenEnable -> Bool)
    -> (CodeGenEnable -> CodeGenEnable -> CodeGenEnable)
    -> (CodeGenEnable -> CodeGenEnable -> CodeGenEnable)
    -> Ord CodeGenEnable
    CodeGenEnable -> CodeGenEnable -> Bool
    CodeGenEnable -> CodeGenEnable -> Ordering
    CodeGenEnable -> CodeGenEnable -> CodeGenEnable
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: CodeGenEnable -> CodeGenEnable -> Ordering
    compare :: CodeGenEnable -> CodeGenEnable -> Ordering
    $c< :: CodeGenEnable -> CodeGenEnable -> Bool
    < :: CodeGenEnable -> CodeGenEnable -> Bool
    $c<= :: CodeGenEnable -> CodeGenEnable -> Bool
    <= :: CodeGenEnable -> CodeGenEnable -> Bool
    $c> :: CodeGenEnable -> CodeGenEnable -> Bool
    > :: CodeGenEnable -> CodeGenEnable -> Bool
    $c>= :: CodeGenEnable -> CodeGenEnable -> Bool
    >= :: CodeGenEnable -> CodeGenEnable -> Bool
    $cmax :: CodeGenEnable -> CodeGenEnable -> CodeGenEnable
    max :: CodeGenEnable -> CodeGenEnable -> CodeGenEnable
    $cmin :: CodeGenEnable -> CodeGenEnable -> CodeGenEnable
    min :: CodeGenEnable -> CodeGenEnable -> CodeGenEnable
    Ord)

    instance Outputable CodeGenEnable where
      ppr :: CodeGenEnable -> SDoc
    ppr = FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text (FilePath -> SDoc)
    -> (CodeGenEnable -> FilePath) -> CodeGenEnable -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CodeGenEnable -> FilePath
    forall a. Show a => a -> FilePath
    show

    -- | Helper used to implement 'enableCodeGenForTH'.
    -- In particular, this enables
    -- unoptimized code generation for all modules that meet some
    -- condition (first parameter), or are dependencies of those
    -- modules. The second parameter is a condition to check before
    -- marking modules for code generation.
    enableCodeGenWhen
      :: Logger
      -> TmpFs
      -> TempFileLifetime
      -> TempFileLifetime
      -> UnitEnv
      -> [ModuleGraphNode]
      -> IO [ModuleGraphNode]
    enableCodeGenWhen :: Logger
    -> TmpFs
    -> TempFileLifetime
    -> TempFileLifetime
    -> UnitEnv
    -> [ModuleGraphNode]
    -> IO [ModuleGraphNode]
    enableCodeGenWhen Logger
    logger TmpFs
    tmpfs TempFileLifetime
    staticLife TempFileLifetime
    dynLife UnitEnv
    unit_env [ModuleGraphNode]
    mod_graph =
      (ModuleGraphNode -> IO ModuleGraphNode)
    -> [ModuleGraphNode] -> IO [ModuleGraphNode]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ModuleGraphNode -> IO ModuleGraphNode
    enable_code_gen [ModuleGraphNode]
    mod_graph
      where
        defaultBackendOf :: ModSummary -> Backend
    defaultBackendOf ModSummary
    ms = Platform -> Backend
    platformDefaultBackend (DynFlags -> Platform
    targetPlatform (DynFlags -> Platform) -> DynFlags -> Platform
    forall a b. (a -> b) -> a -> b
    $ HasDebugCallStack => UnitId -> UnitEnv -> DynFlags
    UnitId -> UnitEnv -> DynFlags
    ue_unitFlags (ModSummary -> UnitId
    ms_unitid ModSummary
    ms) UnitEnv
    unit_env)
        enable_code_gen :: ModuleGraphNode -> IO ModuleGraphNode
        enable_code_gen :: ModuleGraphNode -> IO ModuleGraphNode
    enable_code_gen n :: ModuleGraphNode
    n@(ModuleNode [NodeKey]
    deps ModSummary
    ms)
          | ModSummary
            { ms_location :: ModSummary -> ModLocation
    ms_location = ModLocation
    ms_location
            , ms_hsc_src :: ModSummary -> HscSource
    ms_hsc_src = HscSource
    HsSrcFile
            , ms_hspp_opts :: ModSummary -> DynFlags
    ms_hspp_opts = DynFlags
    dflags
            } <- ModSummary
    ms
          , Just CodeGenEnable
    enable_spec <- ModuleGraphNode -> NodeKey
    mkNodeKey ModuleGraphNode
    n NodeKey -> Map NodeKey CodeGenEnable -> Maybe CodeGenEnable
    forall k a. Ord k => k -> Map k a -> Maybe a
    `Map.lookup` Map NodeKey CodeGenEnable
    needs_codegen_map =
          if | ModSummary -> Bool
    nocode_enable ModSummary
    ms -> do
                   let new_temp_file :: FilePath -> FilePath -> IO (FilePath, FilePath)
    new_temp_file FilePath
    suf FilePath
    dynsuf = do
                         FilePath
    tn <- Logger
    -> TmpFs -> TempDir -> TempFileLifetime -> FilePath -> IO FilePath
    newTempName Logger
    logger TmpFs
    tmpfs (DynFlags -> TempDir
    tmpDir DynFlags
    dflags) TempFileLifetime
    staticLife FilePath
    suf
                         let dyn_tn :: FilePath
    dyn_tn = FilePath
    tn FilePath -> FilePath -> FilePath
    -<.> FilePath
    dynsuf
                         TmpFs -> TempFileLifetime -> [FilePath] -> IO ()
    addFilesToClean TmpFs
    tmpfs TempFileLifetime
    dynLife [FilePath
    dyn_tn]
                         return (FilePath
    tn, FilePath
    dyn_tn)
                     -- We don't want to create .o or .hi files unless we have been asked
                     -- to by the user. But we need them, so we patch their locations in
                     -- the ModSummary with temporary files.
                     --
                   ((FilePath
    hi_file, FilePath
    dyn_hi_file), (FilePath
    o_file, FilePath
    dyn_o_file)) <-
                     -- If ``-fwrite-interface` is specified, then the .o and .hi files
                     -- are written into `-odir` and `-hidir` respectively.  #16670
                     if GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_WriteInterface DynFlags
    dflags
                       then ((FilePath, FilePath), (FilePath, FilePath))
    -> IO ((FilePath, FilePath), (FilePath, FilePath))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((ModLocation -> FilePath
    ml_hi_file ModLocation
    ms_location, ModLocation -> FilePath
    ml_dyn_hi_file ModLocation
    ms_location)
                                   , (ModLocation -> FilePath
    ml_obj_file ModLocation
    ms_location, ModLocation -> FilePath
    ml_dyn_obj_file ModLocation
    ms_location))
                       else (,) ((FilePath, FilePath)
     -> (FilePath, FilePath)
     -> ((FilePath, FilePath), (FilePath, FilePath)))
    -> IO (FilePath, FilePath)
    -> IO
         ((FilePath, FilePath)
          -> ((FilePath, FilePath), (FilePath, FilePath)))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (FilePath -> FilePath -> IO (FilePath, FilePath)
    new_temp_file (DynFlags -> FilePath
    hiSuf_ DynFlags
    dflags) (DynFlags -> FilePath
    dynHiSuf_ DynFlags
    dflags))
                                IO
      ((FilePath, FilePath)
       -> ((FilePath, FilePath), (FilePath, FilePath)))
    -> IO (FilePath, FilePath)
    -> IO ((FilePath, FilePath), (FilePath, FilePath))
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (FilePath -> FilePath -> IO (FilePath, FilePath)
    new_temp_file (DynFlags -> FilePath
    objectSuf_ DynFlags
    dflags) (DynFlags -> FilePath
    dynObjectSuf_ DynFlags
    dflags))
                   let new_dflags :: DynFlags
    new_dflags = case CodeGenEnable
    enable_spec of
                                      CodeGenEnable
    EnableByteCode -> DynFlags
    dflags { backend = interpreterBackend }
                                      CodeGenEnable
    EnableObject   -> DynFlags
    dflags { backend = defaultBackendOf ms }
                                      CodeGenEnable
    EnableByteCodeAndObject -> (DynFlags -> GeneralFlag -> DynFlags
    gopt_set DynFlags
    dflags GeneralFlag
    Opt_ByteCodeAndObjectCode) { backend = defaultBackendOf ms}
                   let ms' :: ModSummary
    ms' = ModSummary
    ms
                         { ms_location =
                             ms_location { ml_hi_file = hi_file
                                         , ml_obj_file = o_file
                                         , ml_dyn_hi_file = dyn_hi_file
                                         , ml_dyn_obj_file = dyn_o_file }
                         , ms_hspp_opts = updOptLevel 0 $ new_dflags
                         }
                   -- Recursive call to catch the other cases
                   ModuleGraphNode -> IO ModuleGraphNode
    enable_code_gen ([NodeKey] -> ModSummary -> ModuleGraphNode
    ModuleNode [NodeKey]
    deps ModSummary
    ms')

             -- If -fprefer-byte-code then satisfy dependency by enabling bytecode (if normal object not enough)
             -- we only get to this case if the default backend is already generating object files, but we need dynamic
             -- objects
             | CodeGenEnable -> ModSummary -> Bool
    bytecode_and_enable CodeGenEnable
    enable_spec ModSummary
    ms -> do
                   let ms' :: ModSummary
    ms' = ModSummary
    ms
                         { ms_hspp_opts = gopt_set (ms_hspp_opts ms) Opt_ByteCodeAndObjectCode
                         }
                   -- Recursive call to catch the other cases
                   ModuleGraphNode -> IO ModuleGraphNode
    enable_code_gen ([NodeKey] -> ModSummary -> ModuleGraphNode
    ModuleNode [NodeKey]
    deps ModSummary
    ms')
             | CodeGenEnable -> ModSummary -> Bool
    dynamic_too_enable CodeGenEnable
    enable_spec ModSummary
    ms -> do
                   let ms' :: ModSummary
    ms' = ModSummary
    ms
                         { ms_hspp_opts = gopt_set (ms_hspp_opts ms) Opt_BuildDynamicToo
                         }
                   -- Recursive call to catch the other cases
                   ModuleGraphNode -> IO ModuleGraphNode
    enable_code_gen ([NodeKey] -> ModSummary -> ModuleGraphNode
    ModuleNode [NodeKey]
    deps ModSummary
    ms')
             | ModSummary -> Bool
    ext_interp_enable ModSummary
    ms -> do
                   let ms' :: ModSummary
    ms' = ModSummary
    ms
                         { ms_hspp_opts = gopt_set (ms_hspp_opts ms) Opt_ExternalInterpreter
                         }
                   -- Recursive call to catch the other cases
                   ModuleGraphNode -> IO ModuleGraphNode
    enable_code_gen ([NodeKey] -> ModSummary -> ModuleGraphNode
    ModuleNode [NodeKey]
    deps ModSummary
    ms')

             | Bool
    otherwise -> ModuleGraphNode -> IO ModuleGraphNode
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ModuleGraphNode
    n

        enable_code_gen ModuleGraphNode
    ms = ModuleGraphNode -> IO ModuleGraphNode
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ModuleGraphNode
    ms

        nocode_enable :: ModSummary -> Bool
    nocode_enable ms :: ModSummary
    ms@(ModSummary { ms_hspp_opts :: ModSummary -> DynFlags
    ms_hspp_opts = DynFlags
    dflags }) =
          Bool -> Bool
    not (Backend -> Bool
    backendGeneratesCode (DynFlags -> Backend
    backend DynFlags
    dflags)) Bool -> Bool -> Bool
    &&
          -- Don't enable codegen for TH on indefinite packages; we
          -- can't compile anything anyway! See #16219.
          HomeUnit -> Bool
    forall u. GenHomeUnit u -> Bool
    isHomeUnitDefinite (UnitId -> UnitEnv -> HomeUnit
    ue_unitHomeUnit (ModSummary -> UnitId
    ms_unitid ModSummary
    ms) UnitEnv
    unit_env)

        bytecode_and_enable :: CodeGenEnable -> ModSummary -> Bool
    bytecode_and_enable CodeGenEnable
    enable_spec ModSummary
    ms =
          -- In the situation where we **would** need to enable dynamic-too
          -- IF we had decided we needed objects
          CodeGenEnable -> ModSummary -> Bool
    dynamic_too_enable CodeGenEnable
    EnableObject ModSummary
    ms
            -- but we prefer to use bytecode rather than objects
            Bool -> Bool -> Bool
    && Bool
    prefer_bytecode
            -- and we haven't already turned it on
            Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    generate_both
          where
            lcl_dflags :: DynFlags
    lcl_dflags   = ModSummary -> DynFlags
    ms_hspp_opts ModSummary
    ms
            prefer_bytecode :: Bool
    prefer_bytecode = case CodeGenEnable
    enable_spec of
                                CodeGenEnable
    EnableByteCodeAndObject -> Bool
    True
                                CodeGenEnable
    EnableByteCode -> Bool
    True
                                CodeGenEnable
    EnableObject -> Bool
    False

            generate_both :: Bool
    generate_both   = GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_ByteCodeAndObjectCode DynFlags
    lcl_dflags

        -- #8180 - when using TemplateHaskell, switch on -dynamic-too so
        -- the linker can correctly load the object files.  This isn't necessary
        -- when using -fexternal-interpreter.
        dynamic_too_enable :: CodeGenEnable -> ModSummary -> Bool
    dynamic_too_enable CodeGenEnable
    enable_spec ModSummary
    ms
          = Bool
    hostIsDynamic Bool -> Bool -> Bool
    && Bool
    internalInterpreter Bool -> Bool -> Bool
    &&
                Bool -> Bool
    not Bool
    isDynWay Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    isProfWay Bool -> Bool -> Bool
    &&  Bool -> Bool
    not Bool
    dyn_too_enabled
                  Bool -> Bool -> Bool
    && Bool
    enable_object
          where
           lcl_dflags :: DynFlags
    lcl_dflags   = ModSummary -> DynFlags
    ms_hspp_opts ModSummary
    ms
           internalInterpreter :: Bool
    internalInterpreter = Bool -> Bool
    not (GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_ExternalInterpreter DynFlags
    lcl_dflags)
           dyn_too_enabled :: Bool
    dyn_too_enabled = GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_BuildDynamicToo DynFlags
    lcl_dflags
           isDynWay :: Bool
    isDynWay    = Ways -> Way -> Bool
    hasWay (DynFlags -> Ways
    ways DynFlags
    lcl_dflags) Way
    WayDyn
           isProfWay :: Bool
    isProfWay   = Ways -> Way -> Bool
    hasWay (DynFlags -> Ways
    ways DynFlags
    lcl_dflags) Way
    WayProf
           enable_object :: Bool
    enable_object = case CodeGenEnable
    enable_spec of
                                CodeGenEnable
    EnableByteCode -> Bool
    False
                                CodeGenEnable
    EnableByteCodeAndObject -> Bool
    True
                                CodeGenEnable
    EnableObject -> Bool
    True

        -- #16331 - when no "internal interpreter" is available but we
        -- need to process some TemplateHaskell or QuasiQuotes, we automatically
        -- turn on -fexternal-interpreter.
        ext_interp_enable :: ModSummary -> Bool
    ext_interp_enable ModSummary
    ms = Bool -> Bool
    not Bool
    ghciSupported Bool -> Bool -> Bool
    && Bool
    internalInterpreter
          where
           lcl_dflags :: DynFlags
    lcl_dflags   = ModSummary -> DynFlags
    ms_hspp_opts ModSummary
    ms
           internalInterpreter :: Bool
    internalInterpreter = Bool -> Bool
    not (GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_ExternalInterpreter DynFlags
    lcl_dflags)

        (Graph SummaryNode
    mg, NodeKey -> Maybe SummaryNode
    lookup_node) = Bool
    -> [ModuleGraphNode]
    -> (Graph SummaryNode, NodeKey -> Maybe SummaryNode)
    moduleGraphNodes Bool
    False [ModuleGraphNode]
    mod_graph

        mk_needed_set :: [NodeKey] -> Set NodeKey
    mk_needed_set [NodeKey]
    roots = [NodeKey] -> Set NodeKey
    forall a. Ord a => [a] -> Set a
    Set.fromList ([NodeKey] -> Set NodeKey) -> [NodeKey] -> Set NodeKey
    forall a b. (a -> b) -> a -> b
    $ (SummaryNode -> NodeKey) -> [SummaryNode] -> [NodeKey]
    forall a b. (a -> b) -> [a] -> [b]
    map (ModuleGraphNode -> NodeKey
    mkNodeKey (ModuleGraphNode -> NodeKey)
    -> (SummaryNode -> ModuleGraphNode) -> SummaryNode -> NodeKey
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SummaryNode -> ModuleGraphNode
    forall key payload. Node key payload -> payload
    node_payload) ([SummaryNode] -> [NodeKey]) -> [SummaryNode] -> [NodeKey]
    forall a b. (a -> b) -> a -> b
    $ Graph SummaryNode -> [SummaryNode] -> [SummaryNode]
    forall node. Graph node -> [node] -> [node]
    reachablesG Graph SummaryNode
    mg ((NodeKey -> SummaryNode) -> [NodeKey] -> [SummaryNode]
    forall a b. (a -> b) -> [a] -> [b]
    map (FilePath -> Maybe SummaryNode -> SummaryNode
    forall a. HasCallStack => FilePath -> Maybe a -> a
    expectJust FilePath
    "needs_th" (Maybe SummaryNode -> SummaryNode)
    -> (NodeKey -> Maybe SummaryNode) -> NodeKey -> SummaryNode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NodeKey -> Maybe SummaryNode
    lookup_node) [NodeKey]
    roots)

        needs_obj_set, needs_bc_set :: Set.Set NodeKey
        needs_obj_set :: Set NodeKey
    needs_obj_set = [NodeKey] -> Set NodeKey
    mk_needed_set [NodeKey]
    need_obj_set

        needs_bc_set :: Set NodeKey
    needs_bc_set = [NodeKey] -> Set NodeKey
    mk_needed_set [NodeKey]
    need_bc_set

        -- A map which tells us how to enable code generation for a NodeKey
        needs_codegen_map :: Map.Map NodeKey CodeGenEnable
        needs_codegen_map :: Map NodeKey CodeGenEnable
    needs_codegen_map =
          -- Another option here would be to just produce object code, rather than both object and
          -- byte code
          (CodeGenEnable -> CodeGenEnable -> CodeGenEnable)
    -> Map NodeKey CodeGenEnable
    -> Map NodeKey CodeGenEnable
    -> Map NodeKey CodeGenEnable
    forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
    Map.unionWith (\CodeGenEnable
    _ CodeGenEnable
    _ -> CodeGenEnable
    EnableByteCodeAndObject)
            ([(NodeKey, CodeGenEnable)] -> Map NodeKey CodeGenEnable
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(NodeKey, CodeGenEnable)] -> Map NodeKey CodeGenEnable)
    -> [(NodeKey, CodeGenEnable)] -> Map NodeKey CodeGenEnable
    forall a b. (a -> b) -> a -> b
    $ [(NodeKey
    m, CodeGenEnable
    EnableObject) | NodeKey
    m <- Set NodeKey -> [NodeKey]
    forall a. Set a -> [a]
    Set.toList Set NodeKey
    needs_obj_set])
            ([(NodeKey, CodeGenEnable)] -> Map NodeKey CodeGenEnable
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(NodeKey, CodeGenEnable)] -> Map NodeKey CodeGenEnable)
    -> [(NodeKey, CodeGenEnable)] -> Map NodeKey CodeGenEnable
    forall a b. (a -> b) -> a -> b
    $ [(NodeKey
    m, CodeGenEnable
    EnableByteCode) | NodeKey
    m <- Set NodeKey -> [NodeKey]
    forall a. Set a -> [a]
    Set.toList Set NodeKey
    needs_bc_set])

        -- The direct dependencies of modules which require object code
        need_obj_set :: [NodeKey]
    need_obj_set =
          [[NodeKey]] -> [NodeKey]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
            -- Note we don't need object code for a module if it uses TemplateHaskell itself. Only
            -- it's dependencies.
            [ [NodeKey]
    deps
            | (ModuleNode [NodeKey]
    deps ModSummary
    ms) <- [ModuleGraphNode]
    mod_graph
            , ModSummary -> Bool
    isTemplateHaskellOrQQNonBoot ModSummary
    ms
            , Bool -> Bool
    not (GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_UseBytecodeRatherThanObjects (ModSummary -> DynFlags
    ms_hspp_opts ModSummary
    ms))
            ]

        -- The direct dependencies of modules which require byte code
        need_bc_set :: [NodeKey]
    need_bc_set =
          [[NodeKey]] -> [NodeKey]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
            [ [NodeKey]
    deps
            | (ModuleNode [NodeKey]
    deps ModSummary
    ms) <- [ModuleGraphNode]
    mod_graph
            , ModSummary -> Bool
    isTemplateHaskellOrQQNonBoot ModSummary
    ms
            , GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_UseBytecodeRatherThanObjects (ModSummary -> DynFlags
    ms_hspp_opts ModSummary
    ms)
            ]

    -- | Populate the Downsweep cache with the root modules.
    mkRootMap
      :: [ModSummary]
      -> DownsweepCache
    mkRootMap :: [ModSummary] -> DownsweepCache
    mkRootMap [ModSummary]
    summaries = ([Either DriverMessages ModSummary]
     -> [Either DriverMessages ModSummary]
     -> [Either DriverMessages ModSummary])
    -> [((UnitId, PkgQual, ModuleNameWithIsBoot),
         [Either DriverMessages ModSummary])]
    -> DownsweepCache
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    Map.fromListWith (([Either DriverMessages ModSummary]
     -> [Either DriverMessages ModSummary]
     -> [Either DriverMessages ModSummary])
    -> [Either DriverMessages ModSummary]
    -> [Either DriverMessages ModSummary]
    -> [Either DriverMessages ModSummary]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip [Either DriverMessages ModSummary]
    -> [Either DriverMessages ModSummary]
    -> [Either DriverMessages ModSummary]
    forall a. [a] -> [a] -> [a]
    (++))
      [ ((ModSummary -> UnitId
    ms_unitid ModSummary
    s, PkgQual
    NoPkgQual, ModSummary -> ModuleNameWithIsBoot
    ms_mnwib ModSummary
    s), [ModSummary -> Either DriverMessages ModSummary
    forall a b. b -> Either a b
    Right ModSummary
    s]) | ModSummary
    s <- [ModSummary]
    summaries ]

    -----------------------------------------------------------------------------
    -- Summarising modules

    -- We have two types of summarisation:
    --
    --    * Summarise a file.  This is used for the root module(s) passed to
    --      cmLoadModules.  The file is read, and used to determine the root
    --      module name.  The module name may differ from the filename.
    --
    --    * Summarise a module.  We are given a module name, and must provide
    --      a summary.  The finder is used to locate the file in which the module
    --      resides.

    summariseFile
            :: HscEnv
            -> HomeUnit
            -> M.Map (UnitId, FilePath) ModSummary    -- old summaries
            -> FilePath                     -- source file name
            -> Maybe Phase                  -- start phase
            -> Maybe (StringBuffer,UTCTime)
            -> IO (Either DriverMessages ModSummary)

    summariseFile :: HscEnv
    -> HomeUnit
    -> Map (UnitId, FilePath) ModSummary
    -> FilePath
    -> Maybe Phase
    -> Maybe (InputFileBuffer, UTCTime)
    -> IO (Either DriverMessages ModSummary)
    summariseFile HscEnv
    hsc_env' HomeUnit
    home_unit Map (UnitId, FilePath) ModSummary
    old_summaries FilePath
    src_fn Maybe Phase
    mb_phase Maybe (InputFileBuffer, UTCTime)
    maybe_buf
            -- we can use a cached summary if one is available and the
            -- source file hasn't changed,
       | Just ModSummary
    old_summary <- (UnitId, FilePath)
    -> Map (UnitId, FilePath) ModSummary -> Maybe ModSummary
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup (HomeUnit -> UnitId
    forall u. GenHomeUnit u -> UnitId
    homeUnitId HomeUnit
    home_unit, FilePath
    src_fn) Map (UnitId, FilePath) ModSummary
    old_summaries
       = do
            let location :: ModLocation
    location = ModSummary -> ModLocation
    ms_location (ModSummary -> ModLocation) -> ModSummary -> ModLocation
    forall a b. (a -> b) -> a -> b
    $ ModSummary
    old_summary

            Fingerprint
    src_hash <- IO Fingerprint
    get_src_hash
                    -- The file exists; we checked in getRootSummary above.
                    -- If it gets removed subsequently, then this
                    -- getFileHash may fail, but that's the right
                    -- behaviour.

                    -- return the cached summary if the source didn't change
            HscEnv
    -> (Fingerprint -> IO (Either DriverMessages ModSummary))
    -> ModSummary
    -> ModLocation
    -> Fingerprint
    -> IO (Either DriverMessages ModSummary)
    forall e.
    HscEnv
    -> (Fingerprint -> IO (Either e ModSummary))
    -> ModSummary
    -> ModLocation
    -> Fingerprint
    -> IO (Either e ModSummary)
    checkSummaryHash
                HscEnv
    hsc_env (FilePath -> Fingerprint -> IO (Either DriverMessages ModSummary)
    new_summary FilePath
    src_fn)
                ModSummary
    old_summary ModLocation
    location Fingerprint
    src_hash

       | Bool
    otherwise
       = do Fingerprint
    src_hash <- IO Fingerprint
    get_src_hash
            FilePath -> Fingerprint -> IO (Either DriverMessages ModSummary)
    new_summary FilePath
    src_fn Fingerprint
    src_hash
      where
        -- change the main active unit so all operations happen relative to the given unit
        hsc_env :: HscEnv
    hsc_env = HasDebugCallStack => HomeUnit -> HscEnv -> HscEnv
    HomeUnit -> HscEnv -> HscEnv
    hscSetActiveHomeUnit HomeUnit
    home_unit HscEnv
    hsc_env'
        -- src_fn does not necessarily exist on the filesystem, so we need to
        -- check what kind of target we are dealing with
        get_src_hash :: IO Fingerprint
    get_src_hash = case Maybe (InputFileBuffer, UTCTime)
    maybe_buf of
                          Just (InputFileBuffer
    buf,UTCTime
    _) -> Fingerprint -> IO Fingerprint
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Fingerprint -> IO Fingerprint) -> Fingerprint -> IO Fingerprint
    forall a b. (a -> b) -> a -> b
    $ InputFileBuffer -> Fingerprint
    fingerprintStringBuffer InputFileBuffer
    buf
                          Maybe (InputFileBuffer, UTCTime)
    Nothing -> IO Fingerprint -> IO Fingerprint
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Fingerprint -> IO Fingerprint)
    -> IO Fingerprint -> IO Fingerprint
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO Fingerprint
    getFileHash FilePath
    src_fn

        new_summary :: FilePath -> Fingerprint -> IO (Either DriverMessages ModSummary)
    new_summary FilePath
    src_fn Fingerprint
    src_hash = ExceptT DriverMessages IO ModSummary
    -> IO (Either DriverMessages ModSummary)
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT DriverMessages IO ModSummary
     -> IO (Either DriverMessages ModSummary))
    -> ExceptT DriverMessages IO ModSummary
    -> IO (Either DriverMessages ModSummary)
    forall a b. (a -> b) -> a -> b
    $ do
            preimps :: PreprocessedImports
    preimps@PreprocessedImports {Bool
    FilePath
    [(PkgQual, GenLocated SrcSpan ModuleName)]
    ModuleName
    InputFileBuffer
    SrcSpan
    DynFlags
    pi_local_dflags :: DynFlags
    pi_srcimps :: [(PkgQual, GenLocated SrcSpan ModuleName)]
    pi_theimps :: [(PkgQual, GenLocated SrcSpan ModuleName)]
    pi_ghc_prim_import :: Bool
    pi_hspp_fn :: FilePath
    pi_hspp_buf :: InputFileBuffer
    pi_mod_name_loc :: SrcSpan
    pi_mod_name :: ModuleName
    pi_mod_name :: PreprocessedImports -> ModuleName
    pi_mod_name_loc :: PreprocessedImports -> SrcSpan
    pi_hspp_buf :: PreprocessedImports -> InputFileBuffer
    pi_hspp_fn :: PreprocessedImports -> FilePath
    pi_ghc_prim_import :: PreprocessedImports -> Bool
    pi_theimps :: PreprocessedImports -> [(PkgQual, GenLocated SrcSpan ModuleName)]
    pi_srcimps :: PreprocessedImports -> [(PkgQual, GenLocated SrcSpan ModuleName)]
    pi_local_dflags :: PreprocessedImports -> DynFlags
    ..}
                <- HscEnv
    -> FilePath
    -> Maybe Phase
    -> Maybe (InputFileBuffer, UTCTime)
    -> ExceptT DriverMessages IO PreprocessedImports
    getPreprocessedImports HscEnv
    hsc_env FilePath
    src_fn Maybe Phase
    mb_phase Maybe (InputFileBuffer, UTCTime)
    maybe_buf

            let fopts :: FinderOpts
    fopts = DynFlags -> FinderOpts
    initFinderOpts (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env)

            -- Make a ModLocation for this file
            let location :: ModLocation
    location = FinderOpts -> ModuleName -> FilePath -> ModLocation
    mkHomeModLocation FinderOpts
    fopts ModuleName
    pi_mod_name FilePath
    src_fn

            -- Tell the Finder cache where it is, so that subsequent calls
            -- to findModule will find it, even if it's not on any search path
            Module
    mod <- IO Module -> ExceptT DriverMessages IO Module
    forall a. IO a -> ExceptT DriverMessages IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Module -> ExceptT DriverMessages IO Module)
    -> IO Module -> ExceptT DriverMessages IO Module
    forall a b. (a -> b) -> a -> b
    $ do
              let home_unit :: HomeUnit
    home_unit = HscEnv -> HomeUnit
    hsc_home_unit HscEnv
    hsc_env
              let fc :: FinderCache
    fc        = HscEnv -> FinderCache
    hsc_FC HscEnv
    hsc_env
              FinderCache -> HomeUnit -> ModuleName -> ModLocation -> IO Module
    addHomeModuleToFinder FinderCache
    fc HomeUnit
    home_unit ModuleName
    pi_mod_name ModLocation
    location

            IO ModSummary -> ExceptT DriverMessages IO ModSummary
    forall a. IO a -> ExceptT DriverMessages IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ModSummary -> ExceptT DriverMessages IO ModSummary)
    -> IO ModSummary -> ExceptT DriverMessages IO ModSummary
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> MakeNewModSummary -> IO ModSummary
    makeNewModSummary HscEnv
    hsc_env (MakeNewModSummary -> IO ModSummary)
    -> MakeNewModSummary -> IO ModSummary
    forall a b. (a -> b) -> a -> b
    $ MakeNewModSummary
                { nms_src_fn :: FilePath
    nms_src_fn = FilePath
    src_fn
                , nms_src_hash :: Fingerprint
    nms_src_hash = Fingerprint
    src_hash
                , nms_is_boot :: IsBootInterface
    nms_is_boot = IsBootInterface
    NotBoot
                , nms_hsc_src :: HscSource
    nms_hsc_src =
                    if FilePath -> Bool
    isHaskellSigFilename FilePath
    src_fn
                       then HscSource
    HsigFile
                       else HscSource
    HsSrcFile
                , nms_location :: ModLocation
    nms_location = ModLocation
    location
                , nms_mod :: Module
    nms_mod = Module
    mod
                , nms_preimps :: PreprocessedImports
    nms_preimps = PreprocessedImports
    preimps
                }

    checkSummaryHash
        :: HscEnv
        -> (Fingerprint -> IO (Either e ModSummary))
        -> ModSummary -> ModLocation -> Fingerprint
        -> IO (Either e ModSummary)
    checkSummaryHash :: forall e.
    HscEnv
    -> (Fingerprint -> IO (Either e ModSummary))
    -> ModSummary
    -> ModLocation
    -> Fingerprint
    -> IO (Either e ModSummary)
    checkSummaryHash
      HscEnv
    hsc_env Fingerprint -> IO (Either e ModSummary)
    new_summary
      ModSummary
    old_summary
      ModLocation
    location Fingerprint
    src_hash
      | ModSummary -> Fingerprint
    ms_hs_hash ModSummary
    old_summary Fingerprint -> Fingerprint -> Bool
    forall a. Eq a => a -> a -> Bool
    == Fingerprint
    src_hash Bool -> Bool -> Bool
    &&
          Bool -> Bool
    not (GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_ForceRecomp (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env)) = do
               -- update the object-file timestamp
               Maybe UTCTime
    obj_timestamp <- FilePath -> IO (Maybe UTCTime)
    modificationTimeIfExists (ModLocation -> FilePath
    ml_obj_file ModLocation
    location)

               -- We have to repopulate the Finder's cache for file targets
               -- because the file might not even be on the regular search path
               -- and it was likely flushed in depanal. This is not technically
               -- needed when we're called from sumariseModule but it shouldn't
               -- hurt.
               -- Also, only add to finder cache for non-boot modules as the finder cache
               -- makes sure to add a boot suffix for boot files.
               ()
    _ <- do
                  let fc :: FinderCache
    fc        = HscEnv -> FinderCache
    hsc_FC HscEnv
    hsc_env
                  case ModSummary -> HscSource
    ms_hsc_src ModSummary
    old_summary of
                    HscSource
    HsSrcFile -> FinderCache -> Module -> ModLocation -> IO ()
    addModuleToFinder FinderCache
    fc (ModSummary -> Module
    ms_mod ModSummary
    old_summary) ModLocation
    location
                    HscSource
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

               Maybe UTCTime
    hi_timestamp <- FilePath -> IO (Maybe UTCTime)
    modificationTimeIfExists (ModLocation -> FilePath
    ml_hi_file ModLocation
    location)
               Maybe UTCTime
    hie_timestamp <- FilePath -> IO (Maybe UTCTime)
    modificationTimeIfExists (ModLocation -> FilePath
    ml_hie_file ModLocation
    location)

               return $ ModSummary -> Either e ModSummary
    forall a b. b -> Either a b
    Right
                 ( ModSummary
    old_summary
                         { ms_obj_date = obj_timestamp
                         , ms_iface_date = hi_timestamp
                         , ms_hie_date = hie_timestamp
                         }
                 )

       | Bool
    otherwise =
               -- source changed: re-summarise.
               Fingerprint -> IO (Either e ModSummary)
    new_summary Fingerprint
    src_hash

    data SummariseResult =
            FoundInstantiation InstantiatedUnit
          | FoundHomeWithError (UnitId, DriverMessages)
          | FoundHome ModSummary
          | External UnitId
          | NotThere

    -- Summarise a module, and pick up source and timestamp.
    summariseModule
              :: HscEnv
              -> HomeUnit
              -> M.Map (UnitId, FilePath) ModSummary
              -- ^ Map of old summaries
              -> IsBootInterface    -- True <=> a {-# SOURCE #-} import
              -> Located ModuleName -- Imported module to be summarised
              -> PkgQual
              -> Maybe (StringBuffer, UTCTime)
              -> [ModuleName]               -- Modules to exclude
              -> IO SummariseResult

    summariseModule :: HscEnv
    -> HomeUnit
    -> Map (UnitId, FilePath) ModSummary
    -> IsBootInterface
    -> GenLocated SrcSpan ModuleName
    -> PkgQual
    -> Maybe (InputFileBuffer, UTCTime)
    -> [ModuleName]
    -> IO SummariseResult
    summariseModule HscEnv
    hsc_env' HomeUnit
    home_unit Map (UnitId, FilePath) ModSummary
    old_summary_map IsBootInterface
    is_boot (L SrcSpan
    _ ModuleName
    wanted_mod) PkgQual
    mb_pkg
                    Maybe (InputFileBuffer, UTCTime)
    maybe_buf [ModuleName]
    excl_mods
      | ModuleName
    wanted_mod ModuleName -> [ModuleName] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [ModuleName]
    excl_mods
      = SummariseResult -> IO SummariseResult
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return SummariseResult
    NotThere
      | Bool
    otherwise  = IO SummariseResult
    find_it
      where
        -- Temporarily change the currently active home unit so all operations
        -- happen relative to it
        hsc_env :: HscEnv
    hsc_env   = HasDebugCallStack => HomeUnit -> HscEnv -> HscEnv
    HomeUnit -> HscEnv -> HscEnv
    hscSetActiveHomeUnit HomeUnit
    home_unit HscEnv
    hsc_env'
        dflags :: DynFlags
    dflags    = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env

        find_it :: IO SummariseResult

        find_it :: IO SummariseResult
    find_it = do
            FindResult
    found <- HscEnv -> ModuleName -> PkgQual -> IO FindResult
    findImportedModule HscEnv
    hsc_env ModuleName
    wanted_mod PkgQual
    mb_pkg
            case FindResult
    found of
                 Found ModLocation
    location Module
    mod
                    | Maybe FilePath -> Bool
    forall a. Maybe a -> Bool
    isJust (ModLocation -> Maybe FilePath
    ml_hs_file ModLocation
    location) ->
                            -- Home package
                             ModLocation -> Module -> IO SummariseResult
    just_found ModLocation
    location Module
    mod
                    | VirtUnit InstantiatedUnit
    iud <- Module -> GenUnit UnitId
    forall unit. GenModule unit -> unit
    moduleUnit Module
    mod
                    , Bool -> Bool
    not (HomeUnit -> Module -> Bool
    isHomeModule HomeUnit
    home_unit Module
    mod)
                      -> SummariseResult -> IO SummariseResult
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SummariseResult -> IO SummariseResult)
    -> SummariseResult -> IO SummariseResult
    forall a b. (a -> b) -> a -> b
    $ InstantiatedUnit -> SummariseResult
    FoundInstantiation InstantiatedUnit
    iud
                    | Bool
    otherwise -> SummariseResult -> IO SummariseResult
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SummariseResult -> IO SummariseResult)
    -> SummariseResult -> IO SummariseResult
    forall a b. (a -> b) -> a -> b
    $ UnitId -> SummariseResult
    External (Module -> UnitId
    moduleUnitId Module
    mod)
                 FindResult
    _ -> SummariseResult -> IO SummariseResult
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return SummariseResult
    NotThere
                            -- Not found
                            -- (If it is TRULY not found at all, we'll
                            -- error when we actually try to compile)

        just_found :: ModLocation -> Module -> IO SummariseResult
    just_found ModLocation
    location Module
    mod = do
                    -- Adjust location to point to the hs-boot source file,
                    -- hi file, object file, when is_boot says so
            let location' :: ModLocation
    location' = case IsBootInterface
    is_boot of
                  IsBootInterface
    IsBoot -> ModLocation -> ModLocation
    addBootSuffixLocn ModLocation
    location
                  IsBootInterface
    NotBoot -> ModLocation
    location
                src_fn :: FilePath
    src_fn = FilePath -> Maybe FilePath -> FilePath
    forall a. HasCallStack => FilePath -> Maybe a -> a
    expectJust FilePath
    "summarise2" (ModLocation -> Maybe FilePath
    ml_hs_file ModLocation
    location')

                    -- Check that it exists
                    -- It might have been deleted since the Finder last found it
            Maybe Fingerprint
    maybe_h <- FilePath -> IO (Maybe Fingerprint)
    fileHashIfExists FilePath
    src_fn
            case Maybe Fingerprint
    maybe_h of
              -- This situation can also happen if we have found the .hs file but the
              -- .hs-boot file doesn't exist.
              Maybe Fingerprint
    Nothing -> SummariseResult -> IO SummariseResult
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return SummariseResult
    NotThere
              Just Fingerprint
    h  -> do
                Either DriverMessages ModSummary
    fresult <- ModLocation
    -> Module
    -> FilePath
    -> Fingerprint
    -> IO (Either DriverMessages ModSummary)
    new_summary_cache_check ModLocation
    location' Module
    mod FilePath
    src_fn Fingerprint
    h
                return $ case Either DriverMessages ModSummary
    fresult of
                  Left DriverMessages
    err -> (UnitId, DriverMessages) -> SummariseResult
    FoundHomeWithError (Module -> UnitId
    moduleUnitId Module
    mod, DriverMessages
    err)
                  Right ModSummary
    ms -> ModSummary -> SummariseResult
    FoundHome ModSummary
    ms

        new_summary_cache_check :: ModLocation
    -> Module
    -> FilePath
    -> Fingerprint
    -> IO (Either DriverMessages ModSummary)
    new_summary_cache_check ModLocation
    loc Module
    mod FilePath
    src_fn Fingerprint
    h
          | Just ModSummary
    old_summary <- (UnitId, FilePath)
    -> Map (UnitId, FilePath) ModSummary -> Maybe ModSummary
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup ((GenUnit UnitId -> UnitId
    toUnitId (Module -> GenUnit UnitId
    forall unit. GenModule unit -> unit
    moduleUnit Module
    mod), FilePath
    src_fn)) Map (UnitId, FilePath) ModSummary
    old_summary_map =

             -- check the hash on the source file, and
             -- return the cached summary if it hasn't changed.  If the
             -- file has changed then need to resummarise.
            case Maybe (InputFileBuffer, UTCTime)
    maybe_buf of
               Just (InputFileBuffer
    buf,UTCTime
    _) ->
                   HscEnv
    -> (Fingerprint -> IO (Either DriverMessages ModSummary))
    -> ModSummary
    -> ModLocation
    -> Fingerprint
    -> IO (Either DriverMessages ModSummary)
    forall e.
    HscEnv
    -> (Fingerprint -> IO (Either e ModSummary))
    -> ModSummary
    -> ModLocation
    -> Fingerprint
    -> IO (Either e ModSummary)
    checkSummaryHash HscEnv
    hsc_env (ModLocation
    -> Module
    -> FilePath
    -> Fingerprint
    -> IO (Either DriverMessages ModSummary)
    new_summary ModLocation
    loc Module
    mod FilePath
    src_fn) ModSummary
    old_summary ModLocation
    loc (InputFileBuffer -> Fingerprint
    fingerprintStringBuffer InputFileBuffer
    buf)
               Maybe (InputFileBuffer, UTCTime)
    Nothing    ->
                   HscEnv
    -> (Fingerprint -> IO (Either DriverMessages ModSummary))
    -> ModSummary
    -> ModLocation
    -> Fingerprint
    -> IO (Either DriverMessages ModSummary)
    forall e.
    HscEnv
    -> (Fingerprint -> IO (Either e ModSummary))
    -> ModSummary
    -> ModLocation
    -> Fingerprint
    -> IO (Either e ModSummary)
    checkSummaryHash HscEnv
    hsc_env (ModLocation
    -> Module
    -> FilePath
    -> Fingerprint
    -> IO (Either DriverMessages ModSummary)
    new_summary ModLocation
    loc Module
    mod FilePath
    src_fn) ModSummary
    old_summary ModLocation
    loc Fingerprint
    h
          | Bool
    otherwise = ModLocation
    -> Module
    -> FilePath
    -> Fingerprint
    -> IO (Either DriverMessages ModSummary)
    new_summary ModLocation
    loc Module
    mod FilePath
    src_fn Fingerprint
    h

        new_summary :: ModLocation
                      -> Module
                      -> FilePath
                      -> Fingerprint
                      -> IO (Either DriverMessages ModSummary)
        new_summary :: ModLocation
    -> Module
    -> FilePath
    -> Fingerprint
    -> IO (Either DriverMessages ModSummary)
    new_summary ModLocation
    location Module
    mod FilePath
    src_fn Fingerprint
    src_hash
          = ExceptT DriverMessages IO ModSummary
    -> IO (Either DriverMessages ModSummary)
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT DriverMessages IO ModSummary
     -> IO (Either DriverMessages ModSummary))
    -> ExceptT DriverMessages IO ModSummary
    -> IO (Either DriverMessages ModSummary)
    forall a b. (a -> b) -> a -> b
    $ do
            preimps :: PreprocessedImports
    preimps@PreprocessedImports {Bool
    FilePath
    [(PkgQual, GenLocated SrcSpan ModuleName)]
    ModuleName
    InputFileBuffer
    SrcSpan
    DynFlags
    pi_mod_name :: PreprocessedImports -> ModuleName
    pi_mod_name_loc :: PreprocessedImports -> SrcSpan
    pi_hspp_buf :: PreprocessedImports -> InputFileBuffer
    pi_hspp_fn :: PreprocessedImports -> FilePath
    pi_ghc_prim_import :: PreprocessedImports -> Bool
    pi_theimps :: PreprocessedImports -> [(PkgQual, GenLocated SrcSpan ModuleName)]
    pi_srcimps :: PreprocessedImports -> [(PkgQual, GenLocated SrcSpan ModuleName)]
    pi_local_dflags :: PreprocessedImports -> DynFlags
    pi_local_dflags :: DynFlags
    pi_srcimps :: [(PkgQual, GenLocated SrcSpan ModuleName)]
    pi_theimps :: [(PkgQual, GenLocated SrcSpan ModuleName)]
    pi_ghc_prim_import :: Bool
    pi_hspp_fn :: FilePath
    pi_hspp_buf :: InputFileBuffer
    pi_mod_name_loc :: SrcSpan
    pi_mod_name :: ModuleName
    ..}
                -- Remember to set the active unit here, otherwise the wrong include paths are passed to CPP
                -- See multiHomeUnits_cpp2 test
                <- HscEnv
    -> FilePath
    -> Maybe Phase
    -> Maybe (InputFileBuffer, UTCTime)
    -> ExceptT DriverMessages IO PreprocessedImports
    getPreprocessedImports (HasDebugCallStack => UnitId -> HscEnv -> HscEnv
    UnitId -> HscEnv -> HscEnv
    hscSetActiveUnitId (Module -> UnitId
    moduleUnitId Module
    mod) HscEnv
    hsc_env) FilePath
    src_fn Maybe Phase
    forall a. Maybe a
    Nothing Maybe (InputFileBuffer, UTCTime)
    maybe_buf

            -- NB: Despite the fact that is_boot is a top-level parameter, we
            -- don't actually know coming into this function what the HscSource
            -- of the module in question is.  This is because we may be processing
            -- this module because another module in the graph imported it: in this
            -- case, we know if it's a boot or not because of the {-# SOURCE #-}
            -- annotation, but we don't know if it's a signature or a regular
            -- module until we actually look it up on the filesystem.
            let hsc_src :: HscSource
    hsc_src
                  | IsBootInterface
    is_boot IsBootInterface -> IsBootInterface -> Bool
    forall a. Eq a => a -> a -> Bool
    == IsBootInterface
    IsBoot           = HscSource
    HsBootFile
                  | FilePath -> Bool
    isHaskellSigFilename FilePath
    src_fn = HscSource
    HsigFile
                  | Bool
    otherwise                   = HscSource
    HsSrcFile

            Bool
    -> ExceptT DriverMessages IO () -> ExceptT DriverMessages IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ModuleName
    pi_mod_name ModuleName -> ModuleName -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ModuleName
    wanted_mod) (ExceptT DriverMessages IO () -> ExceptT DriverMessages IO ())
    -> ExceptT DriverMessages IO () -> ExceptT DriverMessages IO ()
    forall a b. (a -> b) -> a -> b
    $
                    DriverMessages -> ExceptT DriverMessages IO ()
    forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
    throwE (DriverMessages -> ExceptT DriverMessages IO ())
    -> DriverMessages -> ExceptT DriverMessages IO ()
    forall a b. (a -> b) -> a -> b
    $ MsgEnvelope DriverMessage -> DriverMessages
    forall e. MsgEnvelope e -> Messages e
    singleMessage (MsgEnvelope DriverMessage -> DriverMessages)
    -> MsgEnvelope DriverMessage -> DriverMessages
    forall a b. (a -> b) -> a -> b
    $ SrcSpan -> DriverMessage -> MsgEnvelope DriverMessage
    forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
    mkPlainErrorMsgEnvelope SrcSpan
    pi_mod_name_loc
                           (DriverMessage -> MsgEnvelope DriverMessage)
    -> DriverMessage -> MsgEnvelope DriverMessage
    forall a b. (a -> b) -> a -> b
    $ ModuleName -> ModuleName -> DriverMessage
    DriverFileModuleNameMismatch ModuleName
    pi_mod_name ModuleName
    wanted_mod

            let instantiations :: GenInstantiations UnitId
    instantiations = HomeUnit -> GenInstantiations UnitId
    forall u. GenHomeUnit u -> GenInstantiations u
    homeUnitInstantiations HomeUnit
    home_unit
            Bool
    -> ExceptT DriverMessages IO () -> ExceptT DriverMessages IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (HscSource
    hsc_src HscSource -> HscSource -> Bool
    forall a. Eq a => a -> a -> Bool
    == HscSource
    HsigFile Bool -> Bool -> Bool
    && Maybe Module -> Bool
    forall a. Maybe a -> Bool
    isNothing (ModuleName -> GenInstantiations UnitId -> Maybe Module
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup ModuleName
    pi_mod_name GenInstantiations UnitId
    instantiations)) (ExceptT DriverMessages IO () -> ExceptT DriverMessages IO ())
    -> ExceptT DriverMessages IO () -> ExceptT DriverMessages IO ()
    forall a b. (a -> b) -> a -> b
    $
                DriverMessages -> ExceptT DriverMessages IO ()
    forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
    throwE (DriverMessages -> ExceptT DriverMessages IO ())
    -> DriverMessages -> ExceptT DriverMessages IO ()
    forall a b. (a -> b) -> a -> b
    $ MsgEnvelope DriverMessage -> DriverMessages
    forall e. MsgEnvelope e -> Messages e
    singleMessage (MsgEnvelope DriverMessage -> DriverMessages)
    -> MsgEnvelope DriverMessage -> DriverMessages
    forall a b. (a -> b) -> a -> b
    $ SrcSpan -> DriverMessage -> MsgEnvelope DriverMessage
    forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
    mkPlainErrorMsgEnvelope SrcSpan
    pi_mod_name_loc
                       (DriverMessage -> MsgEnvelope DriverMessage)
    -> DriverMessage -> MsgEnvelope DriverMessage
    forall a b. (a -> b) -> a -> b
    $ ModuleName
    -> BuildingCabalPackage
    -> GenInstantiations UnitId
    -> DriverMessage
    DriverUnexpectedSignature ModuleName
    pi_mod_name (DynFlags -> BuildingCabalPackage
    checkBuildingCabalPackage DynFlags
    dflags) GenInstantiations UnitId
    instantiations

            IO ModSummary -> ExceptT DriverMessages IO ModSummary
    forall a. IO a -> ExceptT DriverMessages IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ModSummary -> ExceptT DriverMessages IO ModSummary)
    -> IO ModSummary -> ExceptT DriverMessages IO ModSummary
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> MakeNewModSummary -> IO ModSummary
    makeNewModSummary HscEnv
    hsc_env (MakeNewModSummary -> IO ModSummary)
    -> MakeNewModSummary -> IO ModSummary
    forall a b. (a -> b) -> a -> b
    $ MakeNewModSummary
                { nms_src_fn :: FilePath
    nms_src_fn = FilePath
    src_fn
                , nms_src_hash :: Fingerprint
    nms_src_hash = Fingerprint
    src_hash
                , nms_is_boot :: IsBootInterface
    nms_is_boot = IsBootInterface
    is_boot
                , nms_hsc_src :: HscSource
    nms_hsc_src = HscSource
    hsc_src
                , nms_location :: ModLocation
    nms_location = ModLocation
    location
                , nms_mod :: Module
    nms_mod = Module
    mod
                , nms_preimps :: PreprocessedImports
    nms_preimps = PreprocessedImports
    preimps
                }

    -- | Convenience named arguments for 'makeNewModSummary' only used to make
    -- code more readable, not exported.
    data MakeNewModSummary
      = MakeNewModSummary
          { MakeNewModSummary -> FilePath
    nms_src_fn :: FilePath
          , MakeNewModSummary -> Fingerprint
    nms_src_hash :: Fingerprint
          , MakeNewModSummary -> IsBootInterface
    nms_is_boot :: IsBootInterface
          , MakeNewModSummary -> HscSource
    nms_hsc_src :: HscSource
          , MakeNewModSummary -> ModLocation
    nms_location :: ModLocation
          , MakeNewModSummary -> Module
    nms_mod :: Module
          , MakeNewModSummary -> PreprocessedImports
    nms_preimps :: PreprocessedImports
          }

    makeNewModSummary :: HscEnv -> MakeNewModSummary -> IO ModSummary
    makeNewModSummary :: HscEnv -> MakeNewModSummary -> IO ModSummary
    makeNewModSummary HscEnv
    hsc_env MakeNewModSummary{FilePath
    Fingerprint
    IsBootInterface
    Module
    ModLocation
    HscSource
    PreprocessedImports
    nms_src_fn :: MakeNewModSummary -> FilePath
    nms_src_hash :: MakeNewModSummary -> Fingerprint
    nms_is_boot :: MakeNewModSummary -> IsBootInterface
    nms_hsc_src :: MakeNewModSummary -> HscSource
    nms_location :: MakeNewModSummary -> ModLocation
    nms_mod :: MakeNewModSummary -> Module
    nms_preimps :: MakeNewModSummary -> PreprocessedImports
    nms_src_fn :: FilePath
    nms_src_hash :: Fingerprint
    nms_is_boot :: IsBootInterface
    nms_hsc_src :: HscSource
    nms_location :: ModLocation
    nms_mod :: Module
    nms_preimps :: PreprocessedImports
    ..} = do
      let PreprocessedImports{Bool
    FilePath
    [(PkgQual, GenLocated SrcSpan ModuleName)]
    ModuleName
    InputFileBuffer
    SrcSpan
    DynFlags
    pi_mod_name :: PreprocessedImports -> ModuleName
    pi_mod_name_loc :: PreprocessedImports -> SrcSpan
    pi_hspp_buf :: PreprocessedImports -> InputFileBuffer
    pi_hspp_fn :: PreprocessedImports -> FilePath
    pi_ghc_prim_import :: PreprocessedImports -> Bool
    pi_theimps :: PreprocessedImports -> [(PkgQual, GenLocated SrcSpan ModuleName)]
    pi_srcimps :: PreprocessedImports -> [(PkgQual, GenLocated SrcSpan ModuleName)]
    pi_local_dflags :: PreprocessedImports -> DynFlags
    pi_local_dflags :: DynFlags
    pi_srcimps :: [(PkgQual, GenLocated SrcSpan ModuleName)]
    pi_theimps :: [(PkgQual, GenLocated SrcSpan ModuleName)]
    pi_ghc_prim_import :: Bool
    pi_hspp_fn :: FilePath
    pi_hspp_buf :: InputFileBuffer
    pi_mod_name_loc :: SrcSpan
    pi_mod_name :: ModuleName
    ..} = PreprocessedImports
    nms_preimps
      Maybe UTCTime
    obj_timestamp <- FilePath -> IO (Maybe UTCTime)
    modificationTimeIfExists (ModLocation -> FilePath
    ml_obj_file ModLocation
    nms_location)
      Maybe UTCTime
    dyn_obj_timestamp <- FilePath -> IO (Maybe UTCTime)
    modificationTimeIfExists (ModLocation -> FilePath
    ml_dyn_obj_file ModLocation
    nms_location)
      Maybe UTCTime
    hi_timestamp <- FilePath -> IO (Maybe UTCTime)
    modificationTimeIfExists (ModLocation -> FilePath
    ml_hi_file ModLocation
    nms_location)
      Maybe UTCTime
    hie_timestamp <- FilePath -> IO (Maybe UTCTime)
    modificationTimeIfExists (ModLocation -> FilePath
    ml_hie_file ModLocation
    nms_location)

      [ModuleName]
    extra_sig_imports <- HscEnv -> HscSource -> ModuleName -> IO [ModuleName]
    findExtraSigImports HscEnv
    hsc_env HscSource
    nms_hsc_src ModuleName
    pi_mod_name
      ([ModuleName]
    implicit_sigs, [InstantiatedUnit]
    _inst_deps) <- HscEnv
    -> [(PkgQual, GenLocated SrcSpan ModuleName)]
    -> IO ([ModuleName], [InstantiatedUnit])
    implicitRequirementsShallow (HasDebugCallStack => UnitId -> HscEnv -> HscEnv
    UnitId -> HscEnv -> HscEnv
    hscSetActiveUnitId (Module -> UnitId
    moduleUnitId Module
    nms_mod) HscEnv
    hsc_env) [(PkgQual, GenLocated SrcSpan ModuleName)]
    pi_theimps

      return $
            ModSummary
            { ms_mod :: Module
    ms_mod = Module
    nms_mod
            , ms_hsc_src :: HscSource
    ms_hsc_src = HscSource
    nms_hsc_src
            , ms_location :: ModLocation
    ms_location = ModLocation
    nms_location
            , ms_hspp_file :: FilePath
    ms_hspp_file = FilePath
    pi_hspp_fn
            , ms_hspp_opts :: DynFlags
    ms_hspp_opts = DynFlags
    pi_local_dflags
            , ms_hspp_buf :: Maybe InputFileBuffer
    ms_hspp_buf  = InputFileBuffer -> Maybe InputFileBuffer
    forall a. a -> Maybe a
    Just InputFileBuffer
    pi_hspp_buf
            , ms_parsed_mod :: Maybe HsParsedModule
    ms_parsed_mod = Maybe HsParsedModule
    forall a. Maybe a
    Nothing
            , ms_srcimps :: [(PkgQual, GenLocated SrcSpan ModuleName)]
    ms_srcimps = [(PkgQual, GenLocated SrcSpan ModuleName)]
    pi_srcimps
            , ms_ghc_prim_import :: Bool
    ms_ghc_prim_import = Bool
    pi_ghc_prim_import
            , ms_textual_imps :: [(PkgQual, GenLocated SrcSpan ModuleName)]
    ms_textual_imps =
                ((,) PkgQual
    NoPkgQual (GenLocated SrcSpan ModuleName
     -> (PkgQual, GenLocated SrcSpan ModuleName))
    -> (ModuleName -> GenLocated SrcSpan ModuleName)
    -> ModuleName
    -> (PkgQual, GenLocated SrcSpan ModuleName)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModuleName -> GenLocated SrcSpan ModuleName
    forall e. e -> Located e
    noLoc (ModuleName -> (PkgQual, GenLocated SrcSpan ModuleName))
    -> [ModuleName] -> [(PkgQual, GenLocated SrcSpan ModuleName)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [ModuleName]
    extra_sig_imports) [(PkgQual, GenLocated SrcSpan ModuleName)]
    -> [(PkgQual, GenLocated SrcSpan ModuleName)]
    -> [(PkgQual, GenLocated SrcSpan ModuleName)]
    forall a. [a] -> [a] -> [a]
    ++
                ((,) PkgQual
    NoPkgQual (GenLocated SrcSpan ModuleName
     -> (PkgQual, GenLocated SrcSpan ModuleName))
    -> (ModuleName -> GenLocated SrcSpan ModuleName)
    -> ModuleName
    -> (PkgQual, GenLocated SrcSpan ModuleName)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModuleName -> GenLocated SrcSpan ModuleName
    forall e. e -> Located e
    noLoc (ModuleName -> (PkgQual, GenLocated SrcSpan ModuleName))
    -> [ModuleName] -> [(PkgQual, GenLocated SrcSpan ModuleName)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [ModuleName]
    implicit_sigs) [(PkgQual, GenLocated SrcSpan ModuleName)]
    -> [(PkgQual, GenLocated SrcSpan ModuleName)]
    -> [(PkgQual, GenLocated SrcSpan ModuleName)]
    forall a. [a] -> [a] -> [a]
    ++
                [(PkgQual, GenLocated SrcSpan ModuleName)]
    pi_theimps
            , ms_hs_hash :: Fingerprint
    ms_hs_hash = Fingerprint
    nms_src_hash
            , ms_iface_date :: Maybe UTCTime
    ms_iface_date = Maybe UTCTime
    hi_timestamp
            , ms_hie_date :: Maybe UTCTime
    ms_hie_date = Maybe UTCTime
    hie_timestamp
            , ms_obj_date :: Maybe UTCTime
    ms_obj_date = Maybe UTCTime
    obj_timestamp
            , ms_dyn_obj_date :: Maybe UTCTime
    ms_dyn_obj_date = Maybe UTCTime
    dyn_obj_timestamp
            }

    data PreprocessedImports
      = PreprocessedImports
          { PreprocessedImports -> DynFlags
    pi_local_dflags :: DynFlags
          , PreprocessedImports -> [(PkgQual, GenLocated SrcSpan ModuleName)]
    pi_srcimps  :: [(PkgQual, Located ModuleName)]
          , PreprocessedImports -> [(PkgQual, GenLocated SrcSpan ModuleName)]
    pi_theimps  :: [(PkgQual, Located ModuleName)]
          , PreprocessedImports -> Bool
    pi_ghc_prim_import :: Bool
          , PreprocessedImports -> FilePath
    pi_hspp_fn  :: FilePath
          , PreprocessedImports -> InputFileBuffer
    pi_hspp_buf :: StringBuffer
          , PreprocessedImports -> SrcSpan
    pi_mod_name_loc :: SrcSpan
          , PreprocessedImports -> ModuleName
    pi_mod_name :: ModuleName
          }

    -- Preprocess the source file and get its imports
    -- The pi_local_dflags contains the OPTIONS pragmas
    getPreprocessedImports
        :: HscEnv
        -> FilePath
        -> Maybe Phase
        -> Maybe (StringBuffer, UTCTime)
        -- ^ optional source code buffer and modification time
        -> ExceptT DriverMessages IO PreprocessedImports
    getPreprocessedImports :: HscEnv
    -> FilePath
    -> Maybe Phase
    -> Maybe (InputFileBuffer, UTCTime)
    -> ExceptT DriverMessages IO PreprocessedImports
    getPreprocessedImports HscEnv
    hsc_env FilePath
    src_fn Maybe Phase
    mb_phase Maybe (InputFileBuffer, UTCTime)
    maybe_buf = do
      (DynFlags
    pi_local_dflags, FilePath
    pi_hspp_fn)
          <- IO (Either DriverMessages (DynFlags, FilePath))
    -> ExceptT DriverMessages IO (DynFlags, FilePath)
    forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
    ExceptT (IO (Either DriverMessages (DynFlags, FilePath))
     -> ExceptT DriverMessages IO (DynFlags, FilePath))
    -> IO (Either DriverMessages (DynFlags, FilePath))
    -> ExceptT DriverMessages IO (DynFlags, FilePath)
    forall a b. (a -> b) -> a -> b
    $ HscEnv
    -> FilePath
    -> Maybe InputFileBuffer
    -> Maybe Phase
    -> IO (Either DriverMessages (DynFlags, FilePath))
    preprocess HscEnv
    hsc_env FilePath
    src_fn ((InputFileBuffer, UTCTime) -> InputFileBuffer
    forall a b. (a, b) -> a
    fst ((InputFileBuffer, UTCTime) -> InputFileBuffer)
    -> Maybe (InputFileBuffer, UTCTime) -> Maybe InputFileBuffer
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe (InputFileBuffer, UTCTime)
    maybe_buf) Maybe Phase
    mb_phase
      InputFileBuffer
    pi_hspp_buf <- IO InputFileBuffer -> ExceptT DriverMessages IO InputFileBuffer
    forall a. IO a -> ExceptT DriverMessages IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO InputFileBuffer -> ExceptT DriverMessages IO InputFileBuffer)
    -> IO InputFileBuffer -> ExceptT DriverMessages IO InputFileBuffer
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO InputFileBuffer
    hGetStringBuffer FilePath
    pi_hspp_fn
      ([(RawPkgQual, GenLocated SrcSpan ModuleName)]
    pi_srcimps', [(RawPkgQual, GenLocated SrcSpan ModuleName)]
    pi_theimps', Bool
    pi_ghc_prim_import, L SrcSpan
    pi_mod_name_loc ModuleName
    pi_mod_name)
          <- IO
      (Either
         DriverMessages
         ([(RawPkgQual, GenLocated SrcSpan ModuleName)],
          [(RawPkgQual, GenLocated SrcSpan ModuleName)], Bool,
          GenLocated SrcSpan ModuleName))
    -> ExceptT
         DriverMessages
         IO
         ([(RawPkgQual, GenLocated SrcSpan ModuleName)],
          [(RawPkgQual, GenLocated SrcSpan ModuleName)], Bool,
          GenLocated SrcSpan ModuleName)
    forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
    ExceptT (IO
       (Either
          DriverMessages
          ([(RawPkgQual, GenLocated SrcSpan ModuleName)],
           [(RawPkgQual, GenLocated SrcSpan ModuleName)], Bool,
           GenLocated SrcSpan ModuleName))
     -> ExceptT
          DriverMessages
          IO
          ([(RawPkgQual, GenLocated SrcSpan ModuleName)],
           [(RawPkgQual, GenLocated SrcSpan ModuleName)], Bool,
           GenLocated SrcSpan ModuleName))
    -> IO
         (Either
            DriverMessages
            ([(RawPkgQual, GenLocated SrcSpan ModuleName)],
             [(RawPkgQual, GenLocated SrcSpan ModuleName)], Bool,
             GenLocated SrcSpan ModuleName))
    -> ExceptT
         DriverMessages
         IO
         ([(RawPkgQual, GenLocated SrcSpan ModuleName)],
          [(RawPkgQual, GenLocated SrcSpan ModuleName)], Bool,
          GenLocated SrcSpan ModuleName)
    forall a b. (a -> b) -> a -> b
    $ do
              let imp_prelude :: Bool
    imp_prelude = Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.ImplicitPrelude DynFlags
    pi_local_dflags
                  popts :: ParserOpts
    popts = DynFlags -> ParserOpts
    initParserOpts DynFlags
    pi_local_dflags
              Either
      (Messages PsMessage)
      ([(RawPkgQual, GenLocated SrcSpan ModuleName)],
       [(RawPkgQual, GenLocated SrcSpan ModuleName)], Bool,
       GenLocated SrcSpan ModuleName)
    mimps <- ParserOpts
    -> Bool
    -> InputFileBuffer
    -> FilePath
    -> FilePath
    -> IO
         (Either
            (Messages PsMessage)
            ([(RawPkgQual, GenLocated SrcSpan ModuleName)],
             [(RawPkgQual, GenLocated SrcSpan ModuleName)], Bool,
             GenLocated SrcSpan ModuleName))
    getImports ParserOpts
    popts Bool
    imp_prelude InputFileBuffer
    pi_hspp_buf FilePath
    pi_hspp_fn FilePath
    src_fn
              return ((Messages PsMessage -> DriverMessages)
    -> Either
         (Messages PsMessage)
         ([(RawPkgQual, GenLocated SrcSpan ModuleName)],
          [(RawPkgQual, GenLocated SrcSpan ModuleName)], Bool,
          GenLocated SrcSpan ModuleName)
    -> Either
         DriverMessages
         ([(RawPkgQual, GenLocated SrcSpan ModuleName)],
          [(RawPkgQual, GenLocated SrcSpan ModuleName)], Bool,
          GenLocated SrcSpan ModuleName)
    forall a b c. (a -> b) -> Either a c -> Either b c
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first (Bag (MsgEnvelope DriverMessage) -> DriverMessages
    forall e. Bag (MsgEnvelope e) -> Messages e
    mkMessages (Bag (MsgEnvelope DriverMessage) -> DriverMessages)
    -> (Messages PsMessage -> Bag (MsgEnvelope DriverMessage))
    -> Messages PsMessage
    -> DriverMessages
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (MsgEnvelope PsMessage -> MsgEnvelope DriverMessage)
    -> Bag (MsgEnvelope PsMessage) -> Bag (MsgEnvelope DriverMessage)
    forall a b. (a -> b) -> Bag a -> Bag b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap MsgEnvelope PsMessage -> MsgEnvelope DriverMessage
    mkDriverPsHeaderMessage (Bag (MsgEnvelope PsMessage) -> Bag (MsgEnvelope DriverMessage))
    -> (Messages PsMessage -> Bag (MsgEnvelope PsMessage))
    -> Messages PsMessage
    -> Bag (MsgEnvelope DriverMessage)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Messages PsMessage -> Bag (MsgEnvelope PsMessage)
    forall e. Messages e -> Bag (MsgEnvelope e)
    getMessages) Either
      (Messages PsMessage)
      ([(RawPkgQual, GenLocated SrcSpan ModuleName)],
       [(RawPkgQual, GenLocated SrcSpan ModuleName)], Bool,
       GenLocated SrcSpan ModuleName)
    mimps)
      let rn_pkg_qual :: ModuleName -> RawPkgQual -> PkgQual
    rn_pkg_qual = UnitEnv -> ModuleName -> RawPkgQual -> PkgQual
    renameRawPkgQual (HscEnv -> UnitEnv
    hsc_unit_env HscEnv
    hsc_env)
      let rn_imps :: [(RawPkgQual, GenLocated SrcSpan ModuleName)]
    -> [(PkgQual, GenLocated SrcSpan ModuleName)]
    rn_imps = ((RawPkgQual, GenLocated SrcSpan ModuleName)
     -> (PkgQual, GenLocated SrcSpan ModuleName))
    -> [(RawPkgQual, GenLocated SrcSpan ModuleName)]
    -> [(PkgQual, GenLocated SrcSpan ModuleName)]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\(RawPkgQual
    pk, lmn :: GenLocated SrcSpan ModuleName
    lmn@(L SrcSpan
    _ ModuleName
    mn)) -> (ModuleName -> RawPkgQual -> PkgQual
    rn_pkg_qual ModuleName
    mn RawPkgQual
    pk, GenLocated SrcSpan ModuleName
    lmn))
      let pi_srcimps :: [(PkgQual, GenLocated SrcSpan ModuleName)]
    pi_srcimps = [(RawPkgQual, GenLocated SrcSpan ModuleName)]
    -> [(PkgQual, GenLocated SrcSpan ModuleName)]
    rn_imps [(RawPkgQual, GenLocated SrcSpan ModuleName)]
    pi_srcimps'
      let pi_theimps :: [(PkgQual, GenLocated SrcSpan ModuleName)]
    pi_theimps = [(RawPkgQual, GenLocated SrcSpan ModuleName)]
    -> [(PkgQual, GenLocated SrcSpan ModuleName)]
    rn_imps [(RawPkgQual, GenLocated SrcSpan ModuleName)]
    pi_theimps'
      PreprocessedImports
    -> ExceptT DriverMessages IO PreprocessedImports
    forall a. a -> ExceptT DriverMessages IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    return PreprocessedImports {Bool
    FilePath
    [(PkgQual, GenLocated SrcSpan ModuleName)]
    ModuleName
    InputFileBuffer
    SrcSpan
    DynFlags
    pi_mod_name :: ModuleName
    pi_mod_name_loc :: SrcSpan
    pi_hspp_buf :: InputFileBuffer
    pi_hspp_fn :: FilePath
    pi_ghc_prim_import :: Bool
    pi_theimps :: [(PkgQual, GenLocated SrcSpan ModuleName)]
    pi_srcimps :: [(PkgQual, GenLocated SrcSpan ModuleName)]
    pi_local_dflags :: DynFlags
    pi_local_dflags :: DynFlags
    pi_hspp_fn :: FilePath
    pi_hspp_buf :: InputFileBuffer
    pi_ghc_prim_import :: Bool
    pi_mod_name_loc :: SrcSpan
    pi_mod_name :: ModuleName
    pi_srcimps :: [(PkgQual, GenLocated SrcSpan ModuleName)]
    pi_theimps :: [(PkgQual, GenLocated SrcSpan ModuleName)]
    ..}

    -----------------------------------------------------------------------------
    --                      Error messages
    -----------------------------------------------------------------------------

    -- Defer and group warning, error and fatal messages so they will not get lost
    -- in the regular output.
    withDeferredDiagnostics :: GhcMonad m => m a -> m a
    withDeferredDiagnostics :: forall (m :: * -> *) a. GhcMonad m => m a -> m a
    withDeferredDiagnostics m a
    f = do
      DynFlags
    dflags <- m DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
      if Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_DeferDiagnostics DynFlags
    dflags
      then m a
    f
      else do
        IORef [IO ()]
    warnings <- IO (IORef [IO ()]) -> m (IORef [IO ()])
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (IORef [IO ()]) -> m (IORef [IO ()]))
    -> IO (IORef [IO ()]) -> m (IORef [IO ()])
    forall a b. (a -> b) -> a -> b
    $ [IO ()] -> IO (IORef [IO ()])
    forall a. a -> IO (IORef a)
    newIORef []
        IORef [IO ()]
    errors <- IO (IORef [IO ()]) -> m (IORef [IO ()])
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (IORef [IO ()]) -> m (IORef [IO ()]))
    -> IO (IORef [IO ()]) -> m (IORef [IO ()])
    forall a b. (a -> b) -> a -> b
    $ [IO ()] -> IO (IORef [IO ()])
    forall a. a -> IO (IORef a)
    newIORef []
        IORef [IO ()]
    fatals <- IO (IORef [IO ()]) -> m (IORef [IO ()])
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (IORef [IO ()]) -> m (IORef [IO ()]))
    -> IO (IORef [IO ()]) -> m (IORef [IO ()])
    forall a b. (a -> b) -> a -> b
    $ [IO ()] -> IO (IORef [IO ()])
    forall a. a -> IO (IORef a)
    newIORef []
        Logger
    logger <- m Logger
    forall (m :: * -> *). HasLogger m => m Logger
    getLogger

        let deferDiagnostics :: LogFlags -> MessageClass -> SrcSpan -> SDoc -> IO ()
    deferDiagnostics LogFlags
    _dflags !MessageClass
    msgClass !SrcSpan
    srcSpan !SDoc
    msg = do
              let action :: IO ()
    action = Logger -> MessageClass -> SrcSpan -> SDoc -> IO ()
    logMsg Logger
    logger MessageClass
    msgClass SrcSpan
    srcSpan SDoc
    msg
              case MessageClass
    msgClass of
                MCDiagnostic Severity
    SevWarning ResolvedDiagnosticReason
    _reason Maybe DiagnosticCode
    _code
                  -> IORef [IO ()] -> ([IO ()] -> ([IO ()], ())) -> IO ()
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' IORef [IO ()]
    warnings (([IO ()] -> ([IO ()], ())) -> IO ())
    -> ([IO ()] -> ([IO ()], ())) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(![IO ()]
    i) -> (IO ()
    actionIO () -> [IO ()] -> [IO ()]
    forall a. a -> [a] -> [a]
    : [IO ()]
    i, ())
                MCDiagnostic Severity
    SevError ResolvedDiagnosticReason
    _reason Maybe DiagnosticCode
    _code
                  -> IORef [IO ()] -> ([IO ()] -> ([IO ()], ())) -> IO ()
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' IORef [IO ()]
    errors   (([IO ()] -> ([IO ()], ())) -> IO ())
    -> ([IO ()] -> ([IO ()], ())) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(![IO ()]
    i) -> (IO ()
    actionIO () -> [IO ()] -> [IO ()]
    forall a. a -> [a] -> [a]
    : [IO ()]
    i, ())
                MessageClass
    MCFatal
                  -> IORef [IO ()] -> ([IO ()] -> ([IO ()], ())) -> IO ()
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' IORef [IO ()]
    fatals   (([IO ()] -> ([IO ()], ())) -> IO ())
    -> ([IO ()] -> ([IO ()], ())) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(![IO ()]
    i) -> (IO ()
    actionIO () -> [IO ()] -> [IO ()]
    forall a. a -> [a] -> [a]
    : [IO ()]
    i, ())
                MessageClass
    _ -> IO ()
    action

            printDeferredDiagnostics :: m ()
    printDeferredDiagnostics = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $
              [IORef [IO ()]] -> (IORef [IO ()] -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [IORef [IO ()]
    warnings, IORef [IO ()]
    errors, IORef [IO ()]
    fatals] ((IORef [IO ()] -> IO ()) -> IO ())
    -> (IORef [IO ()] -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \IORef [IO ()]
    ref -> do
                -- This IORef can leak when the dflags leaks, so let us always
                -- reset the content. The lazy variant is used here as we want to force
                -- this error if the IORef is ever accessed again, rather than now.
                -- See #20981 for an issue which discusses this general issue.
                let landmine :: [a]
    landmine = if Bool
    debugIsOn then FilePath -> [a]
    forall a. HasCallStack => FilePath -> a
    panic FilePath
    "withDeferredDiagnostics: use after free" else []
                [IO ()]
    actions <- IORef [IO ()] -> ([IO ()] -> ([IO ()], [IO ()])) -> IO [IO ()]
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef IORef [IO ()]
    ref (([IO ()] -> ([IO ()], [IO ()])) -> IO [IO ()])
    -> ([IO ()] -> ([IO ()], [IO ()])) -> IO [IO ()]
    forall a b. (a -> b) -> a -> b
    $ \[IO ()]
    i -> ([IO ()]
    forall a. [a]
    landmine, [IO ()]
    i)
                [IO ()] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    t (m a) -> m ()
    sequence_ ([IO ()] -> IO ()) -> [IO ()] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [IO ()] -> [IO ()]
    forall a. [a] -> [a]
    reverse [IO ()]
    actions

        m () -> (() -> m ()) -> (() -> m a) -> m a
    forall (m :: * -> *) a c b.
    (HasCallStack, MonadMask m) =>
    m a -> (a -> m c) -> (a -> m b) -> m b
    MC.bracket
          (((LogFlags -> MessageClass -> SrcSpan -> SDoc -> IO ())
     -> LogFlags -> MessageClass -> SrcSpan -> SDoc -> IO ())
    -> m ()
    forall (m :: * -> *).
    GhcMonad m =>
    ((LogFlags -> MessageClass -> SrcSpan -> SDoc -> IO ())
     -> LogFlags -> MessageClass -> SrcSpan -> SDoc -> IO ())
    -> m ()
    pushLogHookM ((LogFlags -> MessageClass -> SrcSpan -> SDoc -> IO ())
    -> (LogFlags -> MessageClass -> SrcSpan -> SDoc -> IO ())
    -> LogFlags
    -> MessageClass
    -> SrcSpan
    -> SDoc
    -> IO ()
    forall a b. a -> b -> a
    const LogFlags -> MessageClass -> SrcSpan -> SDoc -> IO ()
    deferDiagnostics))
          (\()
    _ -> m ()
    forall (m :: * -> *). GhcMonad m => m ()
    popLogHookM m () -> m () -> m ()
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> m ()
    printDeferredDiagnostics)
          (\()
    _ -> m a
    f)

    noModError :: HscEnv -> SrcSpan -> ModuleName -> FindResult -> MsgEnvelope GhcMessage
    -- ToDo: we don't have a proper line number for this error
    noModError :: HscEnv
    -> SrcSpan -> ModuleName -> FindResult -> MsgEnvelope GhcMessage
    noModError HscEnv
    hsc_env SrcSpan
    loc ModuleName
    wanted_mod FindResult
    err
      = SrcSpan -> GhcMessage -> MsgEnvelope GhcMessage
    forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
    mkPlainErrorMsgEnvelope SrcSpan
    loc (GhcMessage -> MsgEnvelope GhcMessage)
    -> GhcMessage -> MsgEnvelope GhcMessage
    forall a b. (a -> b) -> a -> b
    $ DriverMessage -> GhcMessage
    GhcDriverMessage (DriverMessage -> GhcMessage) -> DriverMessage -> GhcMessage
    forall a b. (a -> b) -> a -> b
    $
        IfaceMessage -> DriverMessage
    DriverInterfaceError (IfaceMessage -> DriverMessage) -> IfaceMessage -> DriverMessage
    forall a b. (a -> b) -> a -> b
    $
        (MissingInterfaceError -> InterfaceLookingFor -> IfaceMessage
    Can'tFindInterface (HscEnv -> ModuleName -> FindResult -> MissingInterfaceError
    cannotFindModule HscEnv
    hsc_env ModuleName
    wanted_mod FindResult
    err) (ModuleName -> IsBootInterface -> InterfaceLookingFor
    LookingForModule ModuleName
    wanted_mod IsBootInterface
    NotBoot))

    {-
    noHsFileErr :: SrcSpan -> String -> DriverMessages
    noHsFileErr loc path
      = singleMessage $ mkPlainErrorMsgEnvelope loc (DriverFileNotFound path)
      -}

    moduleNotFoundErr :: ModuleName -> DriverMessages
    moduleNotFoundErr :: ModuleName -> DriverMessages
    moduleNotFoundErr ModuleName
    mod = MsgEnvelope DriverMessage -> DriverMessages
    forall e. MsgEnvelope e -> Messages e
    singleMessage (MsgEnvelope DriverMessage -> DriverMessages)
    -> MsgEnvelope DriverMessage -> DriverMessages
    forall a b. (a -> b) -> a -> b
    $ SrcSpan -> DriverMessage -> MsgEnvelope DriverMessage
    forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
    mkPlainErrorMsgEnvelope SrcSpan
    noSrcSpan (ModuleName -> DriverMessage
    DriverModuleNotFound ModuleName
    mod)

    multiRootsErr :: [ModSummary] -> IO ()
    multiRootsErr :: [ModSummary] -> IO ()
    multiRootsErr [] = FilePath -> IO ()
    forall a. HasCallStack => FilePath -> a
    panic FilePath
    "multiRootsErr"
    multiRootsErr summs :: [ModSummary]
    summs@(ModSummary
    summ1:[ModSummary]
    _)
      = MsgEnvelope GhcMessage -> IO ()
    forall (io :: * -> *) a.
    MonadIO io =>
    MsgEnvelope GhcMessage -> io a
    throwOneError (MsgEnvelope GhcMessage -> IO ())
    -> MsgEnvelope GhcMessage -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (DriverMessage -> GhcMessage)
    -> MsgEnvelope DriverMessage -> MsgEnvelope GhcMessage
    forall a b. (a -> b) -> MsgEnvelope a -> MsgEnvelope b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DriverMessage -> GhcMessage
    GhcDriverMessage (MsgEnvelope DriverMessage -> MsgEnvelope GhcMessage)
    -> MsgEnvelope DriverMessage -> MsgEnvelope GhcMessage
    forall a b. (a -> b) -> a -> b
    $
        SrcSpan -> DriverMessage -> MsgEnvelope DriverMessage
    forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
    mkPlainErrorMsgEnvelope SrcSpan
    noSrcSpan (DriverMessage -> MsgEnvelope DriverMessage)
    -> DriverMessage -> MsgEnvelope DriverMessage
    forall a b. (a -> b) -> a -> b
    $ Module -> [FilePath] -> DriverMessage
    DriverDuplicatedModuleDeclaration Module
    mod [FilePath]
    files
      where
        mod :: Module
    mod = ModSummary -> Module
    ms_mod ModSummary
    summ1
        files :: [FilePath]
    files = (ModSummary -> FilePath) -> [ModSummary] -> [FilePath]
    forall a b. (a -> b) -> [a] -> [b]
    map (FilePath -> Maybe FilePath -> FilePath
    forall a. HasCallStack => FilePath -> Maybe a -> a
    expectJust FilePath
    "checkDup" (Maybe FilePath -> FilePath)
    -> (ModSummary -> Maybe FilePath) -> ModSummary -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModLocation -> Maybe FilePath
    ml_hs_file (ModLocation -> Maybe FilePath)
    -> (ModSummary -> ModLocation) -> ModSummary -> Maybe FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModSummary -> ModLocation
    ms_location) [ModSummary]
    summs

    cyclicModuleErr :: [ModuleGraphNode] -> SDoc
    -- From a strongly connected component we find
    -- a single cycle to report
    cyclicModuleErr :: [ModuleGraphNode] -> SDoc
    cyclicModuleErr [ModuleGraphNode]
    mss
      = Bool -> SDoc -> SDoc
    forall a. HasCallStack => Bool -> a -> a
    assert (Bool -> Bool
    not ([ModuleGraphNode] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ModuleGraphNode]
    mss)) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
        case [Node NodeKey ModuleGraphNode] -> Maybe [ModuleGraphNode]
    forall payload key.
    Ord key =>
    [Node key payload] -> Maybe [payload]
    findCycle [Node NodeKey ModuleGraphNode]
    graph of
           Maybe [ModuleGraphNode]
    Nothing   -> FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "Unexpected non-cycle" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [ModuleGraphNode] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [ModuleGraphNode]
    mss
           Just [ModuleGraphNode]
    path0 -> [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat
            [ FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "Module graph contains a cycle:"
            , Int -> SDoc -> SDoc
    nest Int
    2 ([ModuleGraphNode] -> SDoc
    show_path [ModuleGraphNode]
    path0)]
      where
        graph :: [Node NodeKey ModuleGraphNode]
        graph :: [Node NodeKey ModuleGraphNode]
    graph =
          [ DigraphNode
            { node_payload :: ModuleGraphNode
    node_payload = ModuleGraphNode
    ms
            , node_key :: NodeKey
    node_key = ModuleGraphNode -> NodeKey
    mkNodeKey ModuleGraphNode
    ms
            , node_dependencies :: [NodeKey]
    node_dependencies = Bool -> ModuleGraphNode -> [NodeKey]
    nodeDependencies Bool
    False ModuleGraphNode
    ms
            }
          | ModuleGraphNode
    ms <- [ModuleGraphNode]
    mss
          ]

        show_path :: [ModuleGraphNode] -> SDoc
        show_path :: [ModuleGraphNode] -> SDoc
    show_path []  = FilePath -> SDoc
    forall a. HasCallStack => FilePath -> a
    panic FilePath
    "show_path"
        show_path [ModuleGraphNode
    m] = ModuleGraphNode -> SDoc
    ppr_node ModuleGraphNode
    m SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "imports itself"
        show_path (ModuleGraphNode
    m1:ModuleGraphNode
    m2:[ModuleGraphNode]
    ms) = [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat ( Int -> SDoc -> SDoc
    nest Int
    14 (ModuleGraphNode -> SDoc
    ppr_node ModuleGraphNode
    m1)
                                    SDoc -> [SDoc] -> [SDoc]
    forall a. a -> [a] -> [a]
    : Int -> SDoc -> SDoc
    nest Int
    6 (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "imports" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> ModuleGraphNode -> SDoc
    ppr_node ModuleGraphNode
    m2)
                                    SDoc -> [SDoc] -> [SDoc]
    forall a. a -> [a] -> [a]
    : [ModuleGraphNode] -> [SDoc]
    go [ModuleGraphNode]
    ms )
           where
             go :: [ModuleGraphNode] -> [SDoc]
    go []     = [FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "which imports" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> ModuleGraphNode -> SDoc
    ppr_node ModuleGraphNode
    m1]
             go (ModuleGraphNode
    m:[ModuleGraphNode]
    ms) = (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "which imports" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> ModuleGraphNode -> SDoc
    ppr_node ModuleGraphNode
    m) SDoc -> [SDoc] -> [SDoc]
    forall a. a -> [a] -> [a]
    : [ModuleGraphNode] -> [SDoc]
    go [ModuleGraphNode]
    ms

        ppr_node :: ModuleGraphNode -> SDoc
        ppr_node :: ModuleGraphNode -> SDoc
    ppr_node (ModuleNode [NodeKey]
    _deps ModSummary
    m) = FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "module" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> ModSummary -> SDoc
    ppr_ms ModSummary
    m
        ppr_node (InstantiationNode UnitId
    _uid InstantiatedUnit
    u) = FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "instantiated unit" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> InstantiatedUnit -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr InstantiatedUnit
    u
        ppr_node (LinkNode [NodeKey]
    uid UnitId
    _) = FilePath -> SDoc -> SDoc
    forall a. HasCallStack => FilePath -> SDoc -> a
    pprPanic FilePath
    "LinkNode should not be in a cycle" ([NodeKey] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [NodeKey]
    uid)

        ppr_ms :: ModSummary -> SDoc
        ppr_ms :: ModSummary -> SDoc
    ppr_ms ModSummary
    ms = SDoc -> SDoc
    quotes (ModuleName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName (ModSummary -> Module
    ms_mod ModSummary
    ms))) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+>
                    (SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text (ModSummary -> FilePath
    msHsFilePath ModSummary
    ms)))

    cleanCurrentModuleTempFilesMaybe :: MonadIO m => Logger -> TmpFs -> DynFlags -> m ()
    cleanCurrentModuleTempFilesMaybe :: forall (m :: * -> *).
    MonadIO m =>
    Logger -> TmpFs -> DynFlags -> m ()
    cleanCurrentModuleTempFilesMaybe Logger
    logger TmpFs
    tmpfs DynFlags
    dflags =
      if GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_KeepTmpFiles DynFlags
    dflags
        then IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ HasCallStack => Logger -> TmpFs -> IO ()
    Logger -> TmpFs -> IO ()
    keepCurrentModuleTempFiles Logger
    logger TmpFs
    tmpfs
        else IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ Logger -> TmpFs -> IO ()
    cleanCurrentModuleTempFiles Logger
    logger TmpFs
    tmpfs

    addDepsToHscEnv ::  [HomeModInfo] -> HscEnv -> HscEnv
    addDepsToHscEnv :: [HomeModInfo] -> HscEnv -> HscEnv
    addDepsToHscEnv [HomeModInfo]
    deps HscEnv
    hsc_env =
      (UnitEnvGraph HomeUnitEnv -> UnitEnvGraph HomeUnitEnv)
    -> HscEnv -> HscEnv
    hscUpdateHUG (\UnitEnvGraph HomeUnitEnv
    hug -> (HomeModInfo
     -> UnitEnvGraph HomeUnitEnv -> UnitEnvGraph HomeUnitEnv)
    -> UnitEnvGraph HomeUnitEnv
    -> [HomeModInfo]
    -> UnitEnvGraph HomeUnitEnv
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr HomeModInfo -> UnitEnvGraph HomeUnitEnv -> UnitEnvGraph HomeUnitEnv
    addHomeModInfoToHug UnitEnvGraph HomeUnitEnv
    hug [HomeModInfo]
    deps) HscEnv
    hsc_env

    setHPT ::  HomePackageTable -> HscEnv -> HscEnv
    setHPT :: HomePackageTable -> HscEnv -> HscEnv
    setHPT HomePackageTable
    deps HscEnv
    hsc_env =
      (HomePackageTable -> HomePackageTable) -> HscEnv -> HscEnv
    hscUpdateHPT (HomePackageTable -> HomePackageTable -> HomePackageTable
    forall a b. a -> b -> a
    const (HomePackageTable -> HomePackageTable -> HomePackageTable)
    -> HomePackageTable -> HomePackageTable -> HomePackageTable
    forall a b. (a -> b) -> a -> b
    $ HomePackageTable
    deps) HscEnv
    hsc_env

    setHUG ::  HomeUnitGraph -> HscEnv -> HscEnv
    setHUG :: UnitEnvGraph HomeUnitEnv -> HscEnv -> HscEnv
    setHUG UnitEnvGraph HomeUnitEnv
    deps HscEnv
    hsc_env =
      (UnitEnvGraph HomeUnitEnv -> UnitEnvGraph HomeUnitEnv)
    -> HscEnv -> HscEnv
    hscUpdateHUG (UnitEnvGraph HomeUnitEnv
    -> UnitEnvGraph HomeUnitEnv -> UnitEnvGraph HomeUnitEnv
    forall a b. a -> b -> a
    const (UnitEnvGraph HomeUnitEnv
     -> UnitEnvGraph HomeUnitEnv -> UnitEnvGraph HomeUnitEnv)
    -> UnitEnvGraph HomeUnitEnv
    -> UnitEnvGraph HomeUnitEnv
    -> UnitEnvGraph HomeUnitEnv
    forall a b. (a -> b) -> a -> b
    $ UnitEnvGraph HomeUnitEnv
    deps) HscEnv
    hsc_env

    -- | Wrap an action to catch and handle exceptions.
    wrapAction :: (GhcMessage -> AnyGhcDiagnostic) -> HscEnv -> IO a -> IO (Maybe a)
    wrapAction :: forall a.
    (GhcMessage -> AnyGhcDiagnostic) -> HscEnv -> IO a -> IO (Maybe a)
    wrapAction GhcMessage -> AnyGhcDiagnostic
    msg_wrapper HscEnv
    hsc_env IO a
    k = do
      let lcl_logger :: Logger
    lcl_logger = HscEnv -> Logger
    hsc_logger HscEnv
    hsc_env
          lcl_dynflags :: DynFlags
    lcl_dynflags = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env
          print_config :: DiagnosticOpts GhcMessage
    print_config = DynFlags -> DiagnosticOpts GhcMessage
    initPrintConfig DynFlags
    lcl_dynflags
      let logg :: SourceError -> IO ()
    logg SourceError
    err = Logger
    -> DiagnosticOpts (UnknownDiagnostic GhcMessageOpts)
    -> DiagOpts
    -> Messages (UnknownDiagnostic GhcMessageOpts)
    -> IO ()
    forall a.
    Diagnostic a =>
    Logger -> DiagnosticOpts a -> DiagOpts -> Messages a -> IO ()
    printMessages Logger
    lcl_logger DiagnosticOpts (UnknownDiagnostic GhcMessageOpts)
    DiagnosticOpts GhcMessage
    print_config (DynFlags -> DiagOpts
    initDiagOpts DynFlags
    lcl_dynflags) (GhcMessage -> AnyGhcDiagnostic
    GhcMessage -> UnknownDiagnostic GhcMessageOpts
    msg_wrapper (GhcMessage -> UnknownDiagnostic GhcMessageOpts)
    -> Messages GhcMessage
    -> Messages (UnknownDiagnostic GhcMessageOpts)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SourceError -> Messages GhcMessage
    srcErrorMessages SourceError
    err)
      -- MP: It is a bit strange how prettyPrintGhcErrors handles some errors but then we handle
      -- SourceError and ThreadKilled differently directly below. TODO: Refactor to use `catches`
      -- directly. MP should probably use safeTry here to not catch async exceptions but that will regress performance due to
      -- internally using forkIO.
      Either SomeException a
    mres <- IO a -> IO (Either SomeException a)
    forall (m :: * -> *) e a.
    (HasCallStack, MonadCatch m, Exception e) =>
    m a -> m (Either e a)
    MC.try (IO a -> IO (Either SomeException a))
    -> IO a -> IO (Either SomeException a)
    forall a b. (a -> b) -> a -> b
    $ IO a -> IO a
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO a -> IO a) -> IO a -> IO a
    forall a b. (a -> b) -> a -> b
    $ Logger -> IO a -> IO a
    forall (m :: * -> *) a. ExceptionMonad m => Logger -> m a -> m a
    prettyPrintGhcErrors Logger
    lcl_logger (IO a -> IO a) -> IO a -> IO a
    forall a b. (a -> b) -> a -> b
    $ IO a
    k
      case Either SomeException a
    mres of
        Right a
    res -> Maybe a -> IO (Maybe a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe a -> IO (Maybe a)) -> Maybe a -> IO (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ a -> Maybe a
    forall a. a -> Maybe a
    Just a
    res
        Left SomeException
    exc -> do
            case SomeException -> Maybe SourceError
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    exc of
              Just (SourceError
    err :: SourceError)
                -> SourceError -> IO ()
    logg SourceError
    err
              Maybe SourceError
    Nothing -> case SomeException -> Maybe SomeAsyncException
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    exc of
                            -- ThreadKilled in particular needs to actually kill the thread.
                            -- So rethrow that and the other async exceptions
                            Just (SomeAsyncException
    err :: SomeAsyncException) -> SomeAsyncException -> IO ()
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO SomeAsyncException
    err
                            Maybe SomeAsyncException
    _ -> Logger -> SDoc -> IO ()
    errorMsg Logger
    lcl_logger (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text (SomeException -> FilePath
    forall a. Show a => a -> FilePath
    show SomeException
    exc))
            return Maybe a
    forall a. Maybe a
    Nothing

    withParLog :: TVar LogQueueQueue -> Int -> ((Logger -> Logger) -> IO b) -> IO b
    withParLog :: forall b.
    TVar LogQueueQueue -> Int -> ((Logger -> Logger) -> IO b) -> IO b
    withParLog TVar LogQueueQueue
    lqq_var Int
    k (Logger -> Logger) -> IO b
    cont = do
      let init_log :: IO LogQueue
    init_log = do
            -- Make a new log queue
            LogQueue
    lq <- Int -> IO LogQueue
    newLogQueue Int
    k
            -- Add it into the LogQueueQueue
            STM () -> IO ()
    forall a. STM a -> IO a
    atomically (STM () -> IO ()) -> STM () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ TVar LogQueueQueue -> LogQueue -> STM ()
    initLogQueue TVar LogQueueQueue
    lqq_var LogQueue
    lq
            return LogQueue
    lq
          finish_log :: LogQueue -> m ()
    finish_log LogQueue
    lq = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (LogQueue -> IO ()
    finishLogQueue LogQueue
    lq)
      IO LogQueue -> (LogQueue -> IO ()) -> (LogQueue -> IO b) -> IO b
    forall (m :: * -> *) a c b.
    (HasCallStack, MonadMask m) =>
    m a -> (a -> m c) -> (a -> m b) -> m b
    MC.bracket IO LogQueue
    init_log LogQueue -> IO ()
    forall {m :: * -> *}. MonadIO m => LogQueue -> m ()
    finish_log ((LogQueue -> IO b) -> IO b) -> (LogQueue -> IO b) -> IO b
    forall a b. (a -> b) -> a -> b
    $ \LogQueue
    lq -> (Logger -> Logger) -> IO b
    cont (((LogFlags -> MessageClass -> SrcSpan -> SDoc -> IO ())
     -> LogFlags -> MessageClass -> SrcSpan -> SDoc -> IO ())
    -> Logger -> Logger
    pushLogHook ((LogFlags -> MessageClass -> SrcSpan -> SDoc -> IO ())
    -> (LogFlags -> MessageClass -> SrcSpan -> SDoc -> IO ())
    -> LogFlags
    -> MessageClass
    -> SrcSpan
    -> SDoc
    -> IO ()
    forall a b. a -> b -> a
    const (LogQueue -> LogFlags -> MessageClass -> SrcSpan -> SDoc -> IO ()
    parLogAction LogQueue
    lq)))

    withLoggerHsc :: Int -> MakeEnv -> (HscEnv -> IO a) -> IO a
    withLoggerHsc :: forall a. Int -> MakeEnv -> (HscEnv -> IO a) -> IO a
    withLoggerHsc Int
    k MakeEnv{forall a. Int -> ((Logger -> Logger) -> IO a) -> IO a
    withLogger :: MakeEnv -> forall a. Int -> ((Logger -> Logger) -> IO a) -> IO a
    withLogger :: forall a. Int -> ((Logger -> Logger) -> IO a) -> IO a
    withLogger, HscEnv
    hsc_env :: MakeEnv -> HscEnv
    hsc_env :: HscEnv
    hsc_env} HscEnv -> IO a
    cont = do
      Int -> ((Logger -> Logger) -> IO a) -> IO a
    forall a. Int -> ((Logger -> Logger) -> IO a) -> IO a
    withLogger Int
    k (((Logger -> Logger) -> IO a) -> IO a)
    -> ((Logger -> Logger) -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \Logger -> Logger
    modifyLogger -> do
        let lcl_logger :: Logger
    lcl_logger = Logger -> Logger
    modifyLogger (HscEnv -> Logger
    hsc_logger HscEnv
    hsc_env)
            hsc_env' :: HscEnv
    hsc_env' = HscEnv
    hsc_env { hsc_logger = lcl_logger }
        -- Run continuation with modified logger
        HscEnv -> IO a
    cont HscEnv
    hsc_env'

    executeInstantiationNode :: Int
      -> Int
      -> HomeUnitGraph
      -> UnitId
      -> InstantiatedUnit
      -> RunMakeM ()
    executeInstantiationNode :: Int
    -> Int
    -> UnitEnvGraph HomeUnitEnv
    -> UnitId
    -> InstantiatedUnit
    -> ReaderT MakeEnv (MaybeT IO) ()
    executeInstantiationNode Int
    k Int
    n UnitEnvGraph HomeUnitEnv
    deps UnitId
    uid InstantiatedUnit
    iu = do
            MakeEnv
    env <- ReaderT MakeEnv (MaybeT IO) MakeEnv
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
            -- Output of the logger is mediated by a central worker to
            -- avoid output interleaving
            Maybe Messager
    msg <- (MakeEnv -> Maybe Messager)
    -> ReaderT MakeEnv (MaybeT IO) (Maybe Messager)
    forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks MakeEnv -> Maybe Messager
    env_messager
            GhcMessage -> UnknownDiagnostic GhcMessageOpts
    wrapper <- (MakeEnv -> GhcMessage -> UnknownDiagnostic GhcMessageOpts)
    -> ReaderT
         MakeEnv
         (MaybeT IO)
         (GhcMessage -> UnknownDiagnostic GhcMessageOpts)
    forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks MakeEnv -> GhcMessage -> AnyGhcDiagnostic
    MakeEnv -> GhcMessage -> UnknownDiagnostic GhcMessageOpts
    diag_wrapper
            MaybeT IO () -> ReaderT MakeEnv (MaybeT IO) ()
    forall (m :: * -> *) a. Monad m => m a -> ReaderT MakeEnv m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (MaybeT IO () -> ReaderT MakeEnv (MaybeT IO) ())
    -> MaybeT IO () -> ReaderT MakeEnv (MaybeT IO) ()
    forall a b. (a -> b) -> a -> b
    $ IO (Maybe ()) -> MaybeT IO ()
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
    MaybeT (IO (Maybe ()) -> MaybeT IO ()) -> IO (Maybe ()) -> MaybeT IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> MakeEnv -> (HscEnv -> IO (Maybe ())) -> IO (Maybe ())
    forall a. Int -> MakeEnv -> (HscEnv -> IO a) -> IO a
    withLoggerHsc Int
    k MakeEnv
    env ((HscEnv -> IO (Maybe ())) -> IO (Maybe ()))
    -> (HscEnv -> IO (Maybe ())) -> IO (Maybe ())
    forall a b. (a -> b) -> a -> b
    $ \HscEnv
    hsc_env ->
              let lcl_hsc_env :: HscEnv
    lcl_hsc_env = UnitEnvGraph HomeUnitEnv -> HscEnv -> HscEnv
    setHUG UnitEnvGraph HomeUnitEnv
    deps HscEnv
    hsc_env
              in (GhcMessage -> AnyGhcDiagnostic)
    -> HscEnv -> IO () -> IO (Maybe ())
    forall a.
    (GhcMessage -> AnyGhcDiagnostic) -> HscEnv -> IO a -> IO (Maybe a)
    wrapAction GhcMessage -> AnyGhcDiagnostic
    GhcMessage -> UnknownDiagnostic GhcMessageOpts
    wrapper HscEnv
    lcl_hsc_env (IO () -> IO (Maybe ())) -> IO () -> IO (Maybe ())
    forall a b. (a -> b) -> a -> b
    $ do
                ()
    res <- HscEnv
    -> Maybe Messager
    -> Int
    -> Int
    -> UnitId
    -> InstantiatedUnit
    -> IO ()
    upsweep_inst HscEnv
    lcl_hsc_env Maybe Messager
    msg Int
    k Int
    n UnitId
    uid InstantiatedUnit
    iu
                Logger -> TmpFs -> DynFlags -> IO ()
    forall (m :: * -> *).
    MonadIO m =>
    Logger -> TmpFs -> DynFlags -> m ()
    cleanCurrentModuleTempFilesMaybe (HscEnv -> Logger
    hsc_logger HscEnv
    hsc_env) (HscEnv -> TmpFs
    hsc_tmpfs HscEnv
    hsc_env) (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env)
                return ()
    res

    executeCompileNode :: Int
      -> Int
      -> Maybe HomeModInfo
      -> HomeUnitGraph
      -> Maybe [ModuleName] -- List of modules we need to rehydrate before compiling
      -> ModSummary
      -> RunMakeM HomeModInfo
    executeCompileNode :: Int
    -> Int
    -> Maybe HomeModInfo
    -> UnitEnvGraph HomeUnitEnv
    -> Maybe [ModuleName]
    -> ModSummary
    -> ReaderT MakeEnv (MaybeT IO) HomeModInfo
    executeCompileNode Int
    k Int
    n !Maybe HomeModInfo
    old_hmi UnitEnvGraph HomeUnitEnv
    hug Maybe [ModuleName]
    mrehydrate_mods ModSummary
    mod = do
      me :: MakeEnv
    me@MakeEnv{Maybe Messager
    AbstractSem
    HscEnv
    GhcMessage -> AnyGhcDiagnostic
    forall a. Int -> ((Logger -> Logger) -> IO a) -> IO a
    hsc_env :: MakeEnv -> HscEnv
    compile_sem :: MakeEnv -> AbstractSem
    withLogger :: MakeEnv -> forall a. Int -> ((Logger -> Logger) -> IO a) -> IO a
    env_messager :: MakeEnv -> Maybe Messager
    diag_wrapper :: MakeEnv -> GhcMessage -> AnyGhcDiagnostic
    hsc_env :: HscEnv
    compile_sem :: AbstractSem
    withLogger :: forall a. Int -> ((Logger -> Logger) -> IO a) -> IO a
    env_messager :: Maybe Messager
    diag_wrapper :: GhcMessage -> AnyGhcDiagnostic
    ..} <- ReaderT MakeEnv (MaybeT IO) MakeEnv
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
      -- Rehydrate any dependencies if this module had a boot file or is a signature file.
      MaybeT IO HomeModInfo -> ReaderT MakeEnv (MaybeT IO) HomeModInfo
    forall (m :: * -> *) a. Monad m => m a -> ReaderT MakeEnv m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (MaybeT IO HomeModInfo -> ReaderT MakeEnv (MaybeT IO) HomeModInfo)
    -> MaybeT IO HomeModInfo -> ReaderT MakeEnv (MaybeT IO) HomeModInfo
    forall a b. (a -> b) -> a -> b
    $ IO (Maybe HomeModInfo) -> MaybeT IO HomeModInfo
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
    MaybeT (AbstractSem -> IO (Maybe HomeModInfo) -> IO (Maybe HomeModInfo)
    forall b. AbstractSem -> IO b -> IO b
    withAbstractSem AbstractSem
    compile_sem (IO (Maybe HomeModInfo) -> IO (Maybe HomeModInfo))
    -> IO (Maybe HomeModInfo) -> IO (Maybe HomeModInfo)
    forall a b. (a -> b) -> a -> b
    $ Int
    -> MakeEnv
    -> (HscEnv -> IO (Maybe HomeModInfo))
    -> IO (Maybe HomeModInfo)
    forall a. Int -> MakeEnv -> (HscEnv -> IO a) -> IO a
    withLoggerHsc Int
    k MakeEnv
    me ((HscEnv -> IO (Maybe HomeModInfo)) -> IO (Maybe HomeModInfo))
    -> (HscEnv -> IO (Maybe HomeModInfo)) -> IO (Maybe HomeModInfo)
    forall a b. (a -> b) -> a -> b
    $ \HscEnv
    hsc_env -> do
         HscEnv
    hydrated_hsc_env <- IO HscEnv -> IO HscEnv
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO HscEnv -> IO HscEnv) -> IO HscEnv -> IO HscEnv
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> ModSummary -> Maybe [ModuleName] -> IO HscEnv
    maybeRehydrateBefore (UnitEnvGraph HomeUnitEnv -> HscEnv -> HscEnv
    setHUG UnitEnvGraph HomeUnitEnv
    hug HscEnv
    hsc_env) ModSummary
    mod Maybe [ModuleName]
    fixed_mrehydrate_mods
         let -- Use the cached DynFlags which includes OPTIONS_GHC pragmas
             lcl_dynflags :: DynFlags
    lcl_dynflags = ModSummary -> DynFlags
    ms_hspp_opts ModSummary
    mod
         let lcl_hsc_env :: HscEnv
    lcl_hsc_env =
                 -- Localise the hsc_env to use the cached flags
                 HasDebugCallStack => DynFlags -> HscEnv -> HscEnv
    DynFlags -> HscEnv -> HscEnv
    hscSetFlags DynFlags
    lcl_dynflags (HscEnv -> HscEnv) -> HscEnv -> HscEnv
    forall a b. (a -> b) -> a -> b
    $
                 HscEnv
    hydrated_hsc_env
         -- Compile the module, locking with a semaphore to avoid too many modules
         -- being compiled at the same time leading to high memory usage.
         (GhcMessage -> AnyGhcDiagnostic)
    -> HscEnv -> IO HomeModInfo -> IO (Maybe HomeModInfo)
    forall a.
    (GhcMessage -> AnyGhcDiagnostic) -> HscEnv -> IO a -> IO (Maybe a)
    wrapAction GhcMessage -> AnyGhcDiagnostic
    diag_wrapper HscEnv
    lcl_hsc_env (IO HomeModInfo -> IO (Maybe HomeModInfo))
    -> IO HomeModInfo -> IO (Maybe HomeModInfo)
    forall a b. (a -> b) -> a -> b
    $ do
          HomeModInfo
    res <- HscEnv
    -> Maybe Messager
    -> Maybe HomeModInfo
    -> ModSummary
    -> Int
    -> Int
    -> IO HomeModInfo
    upsweep_mod HscEnv
    lcl_hsc_env Maybe Messager
    env_messager Maybe HomeModInfo
    old_hmi ModSummary
    mod Int
    k Int
    n
          Logger -> TmpFs -> DynFlags -> IO ()
    forall (m :: * -> *).
    MonadIO m =>
    Logger -> TmpFs -> DynFlags -> m ()
    cleanCurrentModuleTempFilesMaybe (HscEnv -> Logger
    hsc_logger HscEnv
    hsc_env) (HscEnv -> TmpFs
    hsc_tmpfs HscEnv
    hsc_env) DynFlags
    lcl_dynflags
          return HomeModInfo
    res)

      where
        fixed_mrehydrate_mods :: Maybe [ModuleName]
    fixed_mrehydrate_mods =
          case ModSummary -> HscSource
    ms_hsc_src ModSummary
    mod of
            -- MP: It is probably a bit of a misimplementation in backpack that
            -- compiling a signature requires an knot_var for that unit.
            -- If you remove this then a lot of backpack tests fail.
            HscSource
    HsigFile -> [ModuleName] -> Maybe [ModuleName]
    forall a. a -> Maybe a
    Just []
            HscSource
    _        -> Maybe [ModuleName]
    mrehydrate_mods

    {- Rehydration, see Note [Rehydrating Modules] -}

    rehydrate :: HscEnv        -- ^ The HPT in this HscEnv needs rehydrating.
              -> [HomeModInfo] -- ^ These are the modules we want to rehydrate.
              -> IO HscEnv
    rehydrate :: HscEnv -> [HomeModInfo] -> IO HscEnv
    rehydrate HscEnv
    hsc_env [HomeModInfo]
    hmis = do
      Logger -> Int -> SDoc -> IO ()
    debugTraceMsg Logger
    logger Int
    2 (SDoc -> IO ()) -> SDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (
         FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "Re-hydrating loop: " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> ([Module] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ((HomeModInfo -> Module) -> [HomeModInfo] -> [Module]
    forall a b. (a -> b) -> [a] -> [b]
    map (ModIface -> Module
    forall (phase :: ModIfacePhase). ModIface_ phase -> Module
    mi_module (ModIface -> Module)
    -> (HomeModInfo -> ModIface) -> HomeModInfo -> Module
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HomeModInfo -> ModIface
    hm_iface) [HomeModInfo]
    hmis)))
      [(ModuleName, HomeModInfo)]
    new_mods <- ([(ModuleName, HomeModInfo)] -> IO [(ModuleName, HomeModInfo)])
    -> IO [(ModuleName, HomeModInfo)]
    forall a. (a -> IO a) -> IO a
    fixIO (([(ModuleName, HomeModInfo)] -> IO [(ModuleName, HomeModInfo)])
     -> IO [(ModuleName, HomeModInfo)])
    -> ([(ModuleName, HomeModInfo)] -> IO [(ModuleName, HomeModInfo)])
    -> IO [(ModuleName, HomeModInfo)]
    forall a b. (a -> b) -> a -> b
    $ \[(ModuleName, HomeModInfo)]
    new_mods -> do
          let new_hpt :: HomePackageTable
    new_hpt = HomePackageTable -> [(ModuleName, HomeModInfo)] -> HomePackageTable
    addListToHpt HomePackageTable
    old_hpt [(ModuleName, HomeModInfo)]
    new_mods
          let new_hsc_env :: HscEnv
    new_hsc_env = (HomePackageTable -> HomePackageTable) -> HscEnv -> HscEnv
    hscUpdateHPT_lazy (HomePackageTable -> HomePackageTable -> HomePackageTable
    forall a b. a -> b -> a
    const HomePackageTable
    new_hpt) HscEnv
    hsc_env
          [ModDetails]
    mds <- SDoc -> HscEnv -> IfG [ModDetails] -> IO [ModDetails]
    forall a. SDoc -> HscEnv -> IfG a -> IO a
    initIfaceCheck (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "rehydrate") HscEnv
    new_hsc_env (IfG [ModDetails] -> IO [ModDetails])
    -> IfG [ModDetails] -> IO [ModDetails]
    forall a b. (a -> b) -> a -> b
    $
                    (HomeModInfo -> IOEnv (Env IfGblEnv ()) ModDetails)
    -> [HomeModInfo] -> IfG [ModDetails]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (ModIface -> IOEnv (Env IfGblEnv ()) ModDetails
    typecheckIface (ModIface -> IOEnv (Env IfGblEnv ()) ModDetails)
    -> (HomeModInfo -> ModIface)
    -> HomeModInfo
    -> IOEnv (Env IfGblEnv ()) ModDetails
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HomeModInfo -> ModIface
    hm_iface) [HomeModInfo]
    hmis
          let new_mods :: [(ModuleName, HomeModInfo)]
    new_mods = [ (ModuleName
    mn,HomeModInfo
    hmi{ hm_details = details })
                         | (HomeModInfo
    hmi,ModDetails
    details) <- [HomeModInfo] -> [ModDetails] -> [(HomeModInfo, ModDetails)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [HomeModInfo]
    hmis [ModDetails]
    mds
                         , let mn :: ModuleName
    mn = Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName (ModIface -> Module
    forall (phase :: ModIfacePhase). ModIface_ phase -> Module
    mi_module (HomeModInfo -> ModIface
    hm_iface HomeModInfo
    hmi)) ]
          [(ModuleName, HomeModInfo)] -> IO [(ModuleName, HomeModInfo)]
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    return [(ModuleName, HomeModInfo)]
    new_mods
      return $ HomePackageTable -> HscEnv -> HscEnv
    setHPT ((HomePackageTable -> (ModuleName, HomeModInfo) -> HomePackageTable)
    -> HomePackageTable
    -> [(ModuleName, HomeModInfo)]
    -> HomePackageTable
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (\HomePackageTable
    old (ModuleName
    mn, HomeModInfo
    hmi) -> HomePackageTable -> ModuleName -> HomeModInfo -> HomePackageTable
    addToHpt HomePackageTable
    old ModuleName
    mn HomeModInfo
    hmi) HomePackageTable
    old_hpt [(ModuleName, HomeModInfo)]
    new_mods) HscEnv
    hsc_env

      where
        logger :: Logger
    logger  = HscEnv -> Logger
    hsc_logger HscEnv
    hsc_env
        to_delete :: [ModuleName]
    to_delete =  ((HomeModInfo -> ModuleName) -> [HomeModInfo] -> [ModuleName]
    forall a b. (a -> b) -> [a] -> [b]
    map (Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName (Module -> ModuleName)
    -> (HomeModInfo -> Module) -> HomeModInfo -> ModuleName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModIface -> Module
    forall (phase :: ModIfacePhase). ModIface_ phase -> Module
    mi_module (ModIface -> Module)
    -> (HomeModInfo -> ModIface) -> HomeModInfo -> Module
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HomeModInfo -> ModIface
    hm_iface) [HomeModInfo]
    hmis)
        -- Filter out old modules before tying the knot, otherwise we can end
        -- up with a thunk which keeps reference to the old HomeModInfo.
        !old_hpt :: HomePackageTable
    old_hpt = (HomePackageTable -> ModuleName -> HomePackageTable)
    -> HomePackageTable -> [ModuleName] -> HomePackageTable
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' HomePackageTable -> ModuleName -> HomePackageTable
    delFromHpt (HscEnv -> HomePackageTable
    hsc_HPT HscEnv
    hsc_env) [ModuleName]
    to_delete

    -- If needed, then rehydrate the necessary modules with a suitable KnotVars for the
    -- module currently being compiled.
    maybeRehydrateBefore :: HscEnv -> ModSummary -> Maybe [ModuleName] -> IO HscEnv
    maybeRehydrateBefore :: HscEnv -> ModSummary -> Maybe [ModuleName] -> IO HscEnv
    maybeRehydrateBefore HscEnv
    hsc_env ModSummary
    _ Maybe [ModuleName]
    Nothing = HscEnv -> IO HscEnv
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return HscEnv
    hsc_env
    maybeRehydrateBefore HscEnv
    hsc_env ModSummary
    mod (Just [ModuleName]
    mns) = do
      ModuleEnv (IORef TypeEnv)
    knot_var <- HscEnv -> IO (ModuleEnv (IORef TypeEnv))
    initialise_knot_var HscEnv
    hsc_env
      let hmis :: [HomeModInfo]
    hmis = (ModuleName -> HomeModInfo) -> [ModuleName] -> [HomeModInfo]
    forall a b. (a -> b) -> [a] -> [b]
    map (FilePath -> Maybe HomeModInfo -> HomeModInfo
    forall a. HasCallStack => FilePath -> Maybe a -> a
    expectJust FilePath
    "mr" (Maybe HomeModInfo -> HomeModInfo)
    -> (ModuleName -> Maybe HomeModInfo) -> ModuleName -> HomeModInfo
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HomePackageTable -> ModuleName -> Maybe HomeModInfo
    lookupHpt (HscEnv -> HomePackageTable
    hsc_HPT HscEnv
    hsc_env)) [ModuleName]
    mns
      HscEnv -> [HomeModInfo] -> IO HscEnv
    rehydrate (HscEnv
    hsc_env { hsc_type_env_vars = knotVarsFromModuleEnv knot_var }) [HomeModInfo]
    hmis

      where
       initialise_knot_var :: HscEnv -> IO (ModuleEnv (IORef TypeEnv))
    initialise_knot_var HscEnv
    hsc_env = IO (ModuleEnv (IORef TypeEnv)) -> IO (ModuleEnv (IORef TypeEnv))
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (ModuleEnv (IORef TypeEnv)) -> IO (ModuleEnv (IORef TypeEnv)))
    -> IO (ModuleEnv (IORef TypeEnv)) -> IO (ModuleEnv (IORef TypeEnv))
    forall a b. (a -> b) -> a -> b
    $
        let mod_name :: Module
    mod_name = Maybe HomeUnit -> Module -> Module
    homeModuleInstantiation (HscEnv -> Maybe HomeUnit
    hsc_home_unit_maybe HscEnv
    hsc_env) (ModSummary -> Module
    ms_mod ModSummary
    mod)
        in [(Module, IORef TypeEnv)] -> ModuleEnv (IORef TypeEnv)
    forall a. [(Module, a)] -> ModuleEnv a
    mkModuleEnv ([(Module, IORef TypeEnv)] -> ModuleEnv (IORef TypeEnv))
    -> (IORef TypeEnv -> [(Module, IORef TypeEnv)])
    -> IORef TypeEnv
    -> ModuleEnv (IORef TypeEnv)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Module, IORef TypeEnv)
    -> [(Module, IORef TypeEnv)] -> [(Module, IORef TypeEnv)]
    forall a. a -> [a] -> [a]
    :[]) ((Module, IORef TypeEnv) -> [(Module, IORef TypeEnv)])
    -> (IORef TypeEnv -> (Module, IORef TypeEnv))
    -> IORef TypeEnv
    -> [(Module, IORef TypeEnv)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Module
    mod_name,) (IORef TypeEnv -> ModuleEnv (IORef TypeEnv))
    -> IO (IORef TypeEnv) -> IO (ModuleEnv (IORef TypeEnv))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TypeEnv -> IO (IORef TypeEnv)
    forall a. a -> IO (IORef a)
    newIORef TypeEnv
    emptyTypeEnv

    rehydrateAfter :: HscEnv
      -> [ModuleName]
      -> IO [HomeModInfo]
    rehydrateAfter :: HscEnv -> [ModuleName] -> IO [HomeModInfo]
    rehydrateAfter HscEnv
    new_hsc [ModuleName]
    mns = do
      let new_hpt :: HomePackageTable
    new_hpt = HscEnv -> HomePackageTable
    hsc_HPT HscEnv
    new_hsc
          hmis :: [HomeModInfo]
    hmis = (ModuleName -> HomeModInfo) -> [ModuleName] -> [HomeModInfo]
    forall a b. (a -> b) -> [a] -> [b]
    map (FilePath -> Maybe HomeModInfo -> HomeModInfo
    forall a. HasCallStack => FilePath -> Maybe a -> a
    expectJust FilePath
    "mrAfter" (Maybe HomeModInfo -> HomeModInfo)
    -> (ModuleName -> Maybe HomeModInfo) -> ModuleName -> HomeModInfo
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HomePackageTable -> ModuleName -> Maybe HomeModInfo
    lookupHpt HomePackageTable
    new_hpt) [ModuleName]
    mns
      HscEnv
    hsc_env <- HscEnv -> [HomeModInfo] -> IO HscEnv
    rehydrate (HscEnv
    new_hsc { hsc_type_env_vars = emptyKnotVars }) [HomeModInfo]
    hmis
      return $ (ModuleName -> HomeModInfo) -> [ModuleName] -> [HomeModInfo]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ModuleName
    mn -> FilePath -> Maybe HomeModInfo -> HomeModInfo
    forall a. HasCallStack => FilePath -> Maybe a -> a
    expectJust FilePath
    "rehydrate" (Maybe HomeModInfo -> HomeModInfo)
    -> Maybe HomeModInfo -> HomeModInfo
    forall a b. (a -> b) -> a -> b
    $ HomePackageTable -> ModuleName -> Maybe HomeModInfo
    lookupHpt (HscEnv -> HomePackageTable
    hsc_HPT HscEnv
    hsc_env) ModuleName
    mn) [ModuleName]
    mns

    {-
    Note [Hydrating Modules]
    ~~~~~~~~~~~~~~~~~~~~~~~~
    There are at least 4 different representations of an interface file as described
    by this diagram.

    ------------------------------
    |       On-disk M.hi         |
    ------------------------------
        |             ^
        | Read file   | Write file
        V             |
    -------------------------------
    |      ByteString             |
    -------------------------------
        |             ^
        | Binary.get  | Binary.put
        V             |
    --------------------------------
    |    ModIface (an acyclic AST) |
    --------------------------------
        |           ^
        | hydrate   | mkIfaceTc
        V           |
    ---------------------------------
    |  ModDetails (lots of cycles)  |
    ---------------------------------

    The last step, converting a ModIface into a ModDetails is known as "hydration".

    Hydration happens in three different places

    * When an interface file is initially loaded from disk, it has to be hydrated.
    * When a module is finished compiling, we hydrate the ModIface in order to generate
      the version of ModDetails which exists in memory (see Note [ModDetails and --make mode])
    * When dealing with boot files and module loops (see Note [Rehydrating Modules])

    Note [Rehydrating Modules]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~
    If a module has a boot file then it is critical to rehydrate the modules on
    the path between the two (see #20561).

    Suppose we have ("R" for "recursive"):
    ```
    R.hs-boot:   module R where
                   data T
                   g :: T -> T

    A.hs:        module A( f, T, g ) where
                    import {-# SOURCE #-} R
                    data S = MkS T
                    f :: T -> S = ...g...

    R.hs:        module R where
                    import A
                    data T = T1 | T2 S
                    g = ...f...
    ```

    == Why we need to rehydrate A's ModIface before compiling R.hs

    After compiling A.hs we'll have a TypeEnv in which the Id for `f` has a type
    type uses the AbstractTyCon T; and a TyCon for `S` that also mentions that same
    AbstractTyCon. (Abstract because it came from R.hs-boot; we know nothing about
    it.)

    When compiling R.hs, we build a TyCon for `T`.  But that TyCon mentions `S`, and
    it currently has an AbstractTyCon for `T` inside it.  But we want to build a
    fully cyclic structure, in which `S` refers to `T` and `T` refers to `S`.

    Solution: **rehydration**.  *Before compiling `R.hs`*, rehydrate all the
    ModIfaces below it that depend on R.hs-boot.  To rehydrate a ModIface, call
    `typecheckIface` to convert it to a ModDetails.  It's just a de-serialisation
    step, no type inference, just lookups.

    Now `S` will be bound to a thunk that, when forced, will "see" the final binding
    for `T`; see [Tying the knot](https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/tying-the-knot).
    But note that this must be done *before* compiling R.hs.

    == Why we need to rehydrate A's ModIface after compiling R.hs

    When compiling R.hs, the knot-tying stuff above will ensure that `f`'s unfolding
    mentions the `LocalId` for `g`.  But when we finish R, we carefully ensure that
    all those `LocalIds` are turned into completed `GlobalIds`, replete with
    unfoldings etc.   Alas, that will not apply to the occurrences of `g` in `f`'s
    unfolding. And if we leave matters like that, they will stay that way, and *all*
    subsequent modules that import A will see a crippled unfolding for `f`.

    Solution: rehydrate both R and A's ModIface together, right after completing R.hs.

    ~~ Which modules to rehydrate

    We only need rehydrate modules that are
    * Below R.hs
    * Above R.hs-boot

    There might be many unrelated modules (in the home package) that don't need to be
    rehydrated.

    == Loops with multiple boot files

    It is possible for a module graph to have a loop (SCC, when ignoring boot files)
    which requires multiple boot files to break. In this case, we must perform
    several hydration steps:
      1. The hydration steps described above, which are necessary for correctness.
      2. An extra hydration step at the end of compiling the entire SCC, in order to
         remove space leaks, as we explain below.

    Consider the following example:

       ┌─────┐     ┌─────┐
       │  A  │     │  B  │
       └──┬──┘     └──┬──┘
          │           │
      ┌───▼───────────▼───┐
      │         C         │
      └───┬───────────┬───┘
          │           │
     ┌────▼───┐   ┌───▼────┐
     │ A-boot │   │ B-boot │
     └────────┘   └────────┘

    A, B and C live together in a SCC. Suppose that we compile the modules in the
    order:

      A-boot, B-boot, C, A, B.

    When we come to compile A, we will perform the necessary hydration steps,
    because A has a boot file. This means that C will be hydrated relative to A,
    and the ModDetails for A will reference C/A. Then, when B is compiled,
    C will be rehydrated again, and so B will reference C/A,B. At this point,
    its interface will be hydrated relative to both A and B.
    This causes a space leak: there are now two different copies of C's ModDetails,
    kept alive by modules A and B. This is especially problematic if C is large.

    The way to avoid this space leak is to rehydrate an entire SCC together at the
    end of compilation, so that all the ModDetails point to interfaces for .hs files.
    In this example, when we hydrate A, B and C together, then both A and B will refer to
    C/A,B.

    See #21900 for some more discussion.

    == Modules "above" the loop

    This dark corner is the subject of #14092.

    Suppose we add to our example
    ```
    X.hs     module X where
               import A
               data XT = MkX T
               fx = ...g...
    ```
    If in `--make` we compile R.hs-boot, then A.hs, then X.hs, we'll get a `ModDetails` for `X` that has an AbstractTyCon for `T` in the argument type of `MkX`.  So:

    * Either we should delay compiling X until after R has been compiled. (This is what we do)
    * Or we should rehydrate X after compiling R -- because it transitively depends on R.hs-boot.

    Ticket #20200 has exposed some issues to do with the knot-tying logic in GHC.Make, in `--make` mode.
    #20200 has lots of issues, many of them now fixed;
    this particular issue starts [here](https://gitlab.haskell.org/ghc/ghc/-/issues/20200#note_385758).

    The wiki page [Tying the knot](https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/tying-the-knot) is helpful.
    Also closely related are
        * #14092
        * #14103

    -}

    executeLinkNode :: HomeUnitGraph -> (Int, Int) -> UnitId -> [NodeKey] -> RunMakeM ()
    executeLinkNode :: UnitEnvGraph HomeUnitEnv
    -> (Int, Int)
    -> UnitId
    -> [NodeKey]
    -> ReaderT MakeEnv (MaybeT IO) ()
    executeLinkNode UnitEnvGraph HomeUnitEnv
    hug (Int, Int)
    kn UnitId
    uid [NodeKey]
    deps = do
      UnitId
    -> ReaderT MakeEnv (MaybeT IO) () -> ReaderT MakeEnv (MaybeT IO) ()
    forall a. UnitId -> RunMakeM a -> RunMakeM a
    withCurrentUnit UnitId
    uid (ReaderT MakeEnv (MaybeT IO) () -> ReaderT MakeEnv (MaybeT IO) ())
    -> ReaderT MakeEnv (MaybeT IO) () -> ReaderT MakeEnv (MaybeT IO) ()
    forall a b. (a -> b) -> a -> b
    $ do
        MakeEnv{Maybe Messager
    AbstractSem
    HscEnv
    GhcMessage -> AnyGhcDiagnostic
    forall a. Int -> ((Logger -> Logger) -> IO a) -> IO a
    hsc_env :: MakeEnv -> HscEnv
    compile_sem :: MakeEnv -> AbstractSem
    withLogger :: MakeEnv -> forall a. Int -> ((Logger -> Logger) -> IO a) -> IO a
    env_messager :: MakeEnv -> Maybe Messager
    diag_wrapper :: MakeEnv -> GhcMessage -> AnyGhcDiagnostic
    hsc_env :: HscEnv
    compile_sem :: AbstractSem
    withLogger :: forall a. Int -> ((Logger -> Logger) -> IO a) -> IO a
    env_messager :: Maybe Messager
    diag_wrapper :: GhcMessage -> AnyGhcDiagnostic
    ..} <- ReaderT MakeEnv (MaybeT IO) MakeEnv
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
        let dflags :: DynFlags
    dflags = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env
        let hsc_env' :: HscEnv
    hsc_env' = UnitEnvGraph HomeUnitEnv -> HscEnv -> HscEnv
    setHUG UnitEnvGraph HomeUnitEnv
    hug HscEnv
    hsc_env
            msg' :: Maybe (RecompileRequired -> IO ())
    msg' = (\Messager
    messager -> \RecompileRequired
    recomp -> Messager
    messager HscEnv
    hsc_env (Int, Int)
    kn RecompileRequired
    recomp ([NodeKey] -> UnitId -> ModuleGraphNode
    LinkNode [NodeKey]
    deps UnitId
    uid)) (Messager -> RecompileRequired -> IO ())
    -> Maybe Messager -> Maybe (RecompileRequired -> IO ())
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe Messager
    env_messager

        SuccessFlag
    linkresult <- IO SuccessFlag -> ReaderT MakeEnv (MaybeT IO) SuccessFlag
    forall a. IO a -> ReaderT MakeEnv (MaybeT IO) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO SuccessFlag -> ReaderT MakeEnv (MaybeT IO) SuccessFlag)
    -> IO SuccessFlag -> ReaderT MakeEnv (MaybeT IO) SuccessFlag
    forall a b. (a -> b) -> a -> b
    $ AbstractSem -> IO SuccessFlag -> IO SuccessFlag
    forall b. AbstractSem -> IO b -> IO b
    withAbstractSem AbstractSem
    compile_sem (IO SuccessFlag -> IO SuccessFlag)
    -> IO SuccessFlag -> IO SuccessFlag
    forall a b. (a -> b) -> a -> b
    $ do
                                GhcLink
    -> Logger
    -> TmpFs
    -> FinderCache
    -> Hooks
    -> DynFlags
    -> UnitEnv
    -> Bool
    -> Maybe (RecompileRequired -> IO ())
    -> HomePackageTable
    -> IO SuccessFlag
    link (DynFlags -> GhcLink
    ghcLink DynFlags
    dflags)
                                    (HscEnv -> Logger
    hsc_logger HscEnv
    hsc_env')
                                    (HscEnv -> TmpFs
    hsc_tmpfs HscEnv
    hsc_env')
                                    (HscEnv -> FinderCache
    hsc_FC HscEnv
    hsc_env')
                                    (HscEnv -> Hooks
    hsc_hooks HscEnv
    hsc_env')
                                    DynFlags
    dflags
                                    (HscEnv -> UnitEnv
    hsc_unit_env HscEnv
    hsc_env')
                                    Bool
    True -- We already decided to link
                                    Maybe (RecompileRequired -> IO ())
    msg'
                                    (HscEnv -> HomePackageTable
    hsc_HPT HscEnv
    hsc_env')
        case SuccessFlag
    linkresult of
          SuccessFlag
    Failed -> FilePath -> ReaderT MakeEnv (MaybeT IO) ()
    forall a. FilePath -> ReaderT MakeEnv (MaybeT IO) a
    forall (m :: * -> *) a. MonadFail m => FilePath -> m a
    fail FilePath
    "Link Failed"
          SuccessFlag
    Succeeded -> () -> ReaderT MakeEnv (MaybeT IO) ()
    forall a. a -> ReaderT MakeEnv (MaybeT IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    {-
    Note [ModuleNameSet, efficiency and space leaks]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    During upsweep, the results of compiling modules are placed into a MVar. When we need
    to compute the right compilation environment for a module, we consult this MVar and
    set the HomeUnitGraph accordingly. This is done to avoid having to precisely track
    module dependencies and recreating the HUG from scratch each time, which is very expensive.

    In serial mode (-j1), this all works out fine: a module can only be compiled
    after its dependencies have finished compiling, and compilation can't be
    interleaved with the compilation of other module loops. This ensures that
    the HUG only ever contains finalised interfaces.

    In parallel mode, we have to be more careful: the HUG variable can contain non-finalised
    interfaces, which have been started by another thread. In order to avoid a space leak
    in which a finalised interface is compiled against a HPT which contains a non-finalised
    interface, we have to restrict the HUG to only contain the visible modules.

    The collection of visible modules explains which transitive modules are visible
    from a certain point. It is recorded in the ModuleNameSet.
    Before a module is compiled, we use this set to restrict the HUG to the visible
    modules only, avoiding this tricky space leak.

    Efficiency of the ModuleNameSet is of utmost importance, because a union occurs for
    each edge in the module graph. To achieve this, the set is represented directly as an IntSet,
    which provides suitable performance – even using a UniqSet (which is backed by an IntMap) is
    too slow. The crucial test of performance here is the time taken to a do a no-op build in --make mode.

    See test "jspace" for an example which used to trigger this problem.

    -}

    -- See Note [ModuleNameSet, efficiency and space leaks]
    type ModuleNameSet = M.Map UnitId W.Word64Set

    addToModuleNameSet :: UnitId -> ModuleName -> ModuleNameSet -> ModuleNameSet
    addToModuleNameSet :: UnitId -> ModuleName -> ModuleNameSet -> ModuleNameSet
    addToModuleNameSet UnitId
    uid ModuleName
    mn ModuleNameSet
    s =
      let k :: Word64
    k = (Unique -> Word64
    getKey (Unique -> Word64) -> Unique -> Word64
    forall a b. (a -> b) -> a -> b
    $ ModuleName -> Unique
    forall a. Uniquable a => a -> Unique
    getUnique (ModuleName -> Unique) -> ModuleName -> Unique
    forall a b. (a -> b) -> a -> b
    $ ModuleName
    mn)
      in (Word64Set -> Word64Set -> Word64Set)
    -> UnitId -> Word64Set -> ModuleNameSet -> ModuleNameSet
    forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
    M.insertWith (Word64Set -> Word64Set -> Word64Set
    W.union) UnitId
    uid (Word64 -> Word64Set
    W.singleton Word64
    k) ModuleNameSet
    s

    -- | Wait for some dependencies to finish and then read from the given MVar.
    wait_deps_hug :: MVar HomeUnitGraph -> [BuildResult] -> ReaderT MakeEnv (MaybeT IO) (HomeUnitGraph, ModuleNameSet)
    wait_deps_hug :: MVar (UnitEnvGraph HomeUnitEnv)
    -> [BuildResult]
    -> ReaderT
         MakeEnv (MaybeT IO) (UnitEnvGraph HomeUnitEnv, ModuleNameSet)
    wait_deps_hug MVar (UnitEnvGraph HomeUnitEnv)
    hug_var [BuildResult]
    deps = do
      ([HomeModInfo]
    _, ModuleNameSet
    module_deps) <- [BuildResult] -> RunMakeM ([HomeModInfo], ModuleNameSet)
    wait_deps [BuildResult]
    deps
      UnitEnvGraph HomeUnitEnv
    hug <- IO (UnitEnvGraph HomeUnitEnv)
    -> ReaderT MakeEnv (MaybeT IO) (UnitEnvGraph HomeUnitEnv)
    forall a. IO a -> ReaderT MakeEnv (MaybeT IO) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (UnitEnvGraph HomeUnitEnv)
     -> ReaderT MakeEnv (MaybeT IO) (UnitEnvGraph HomeUnitEnv))
    -> IO (UnitEnvGraph HomeUnitEnv)
    -> ReaderT MakeEnv (MaybeT IO) (UnitEnvGraph HomeUnitEnv)
    forall a b. (a -> b) -> a -> b
    $ MVar (UnitEnvGraph HomeUnitEnv) -> IO (UnitEnvGraph HomeUnitEnv)
    forall a. MVar a -> IO a
    readMVar MVar (UnitEnvGraph HomeUnitEnv)
    hug_var
      let pruneHomeUnitEnv :: UnitId -> HomeUnitEnv -> HomeUnitEnv
    pruneHomeUnitEnv UnitId
    uid HomeUnitEnv
    hme =
            let -- Restrict to things which are in the transitive closure to avoid retaining
                -- reference to loop modules which have already been compiled by other threads.
                -- See Note [ModuleNameSet, efficiency and space leaks]
                !new :: HomePackageTable
    new = HomePackageTable -> Word64Set -> HomePackageTable
    forall {k} (key :: k) elt.
    UniqDFM key elt -> Word64Set -> UniqDFM key elt
    udfmRestrictKeysSet (HomeUnitEnv -> HomePackageTable
    homeUnitEnv_hpt HomeUnitEnv
    hme) (Word64Set -> Maybe Word64Set -> Word64Set
    forall a. a -> Maybe a -> a
    fromMaybe Word64Set
    W.empty (Maybe Word64Set -> Word64Set) -> Maybe Word64Set -> Word64Set
    forall a b. (a -> b) -> a -> b
    $ UnitId -> ModuleNameSet -> Maybe Word64Set
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup  UnitId
    uid ModuleNameSet
    module_deps)
            in HomeUnitEnv
    hme { homeUnitEnv_hpt = new }
      return ((UnitId -> HomeUnitEnv -> HomeUnitEnv)
    -> UnitEnvGraph HomeUnitEnv -> UnitEnvGraph HomeUnitEnv
    forall v b. (UnitId -> v -> b) -> UnitEnvGraph v -> UnitEnvGraph b
    unitEnv_mapWithKey UnitId -> HomeUnitEnv -> HomeUnitEnv
    pruneHomeUnitEnv UnitEnvGraph HomeUnitEnv
    hug, ModuleNameSet
    module_deps)

    -- | Wait for dependencies to finish, and then return their results.
    wait_deps :: [BuildResult] -> RunMakeM ([HomeModInfo], ModuleNameSet)
    wait_deps :: [BuildResult] -> RunMakeM ([HomeModInfo], ModuleNameSet)
    wait_deps [] = ([HomeModInfo], ModuleNameSet)
    -> RunMakeM ([HomeModInfo], ModuleNameSet)
    forall a. a -> ReaderT MakeEnv (MaybeT IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], ModuleNameSet
    forall k a. Map k a
    M.empty)
    wait_deps (BuildResult
    x:[BuildResult]
    xs) = do
      (Maybe HomeModInfo
    res, ModuleNameSet
    deps) <- MaybeT IO (Maybe HomeModInfo, ModuleNameSet)
    -> RunMakeM (Maybe HomeModInfo, ModuleNameSet)
    forall (m :: * -> *) a. Monad m => m a -> ReaderT MakeEnv m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (MaybeT IO (Maybe HomeModInfo, ModuleNameSet)
     -> RunMakeM (Maybe HomeModInfo, ModuleNameSet))
    -> MaybeT IO (Maybe HomeModInfo, ModuleNameSet)
    -> RunMakeM (Maybe HomeModInfo, ModuleNameSet)
    forall a b. (a -> b) -> a -> b
    $ ResultVar (Maybe HomeModInfo, ModuleNameSet)
    -> MaybeT IO (Maybe HomeModInfo, ModuleNameSet)
    forall a. ResultVar a -> MaybeT IO a
    waitResult (BuildResult -> ResultVar (Maybe HomeModInfo, ModuleNameSet)
    resultVar BuildResult
    x)
      ([HomeModInfo]
    hmis, ModuleNameSet
    all_deps) <- [BuildResult] -> RunMakeM ([HomeModInfo], ModuleNameSet)
    wait_deps [BuildResult]
    xs
      let !new_deps :: ModuleNameSet
    new_deps = ModuleNameSet
    deps ModuleNameSet -> ModuleNameSet -> ModuleNameSet
    `unionModuleNameSet` ModuleNameSet
    all_deps
      case Maybe HomeModInfo
    res of
        Maybe HomeModInfo
    Nothing -> ([HomeModInfo], ModuleNameSet)
    -> RunMakeM ([HomeModInfo], ModuleNameSet)
    forall a. a -> ReaderT MakeEnv (MaybeT IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([HomeModInfo]
    hmis, ModuleNameSet
    new_deps)
        Just HomeModInfo
    hmi -> ([HomeModInfo], ModuleNameSet)
    -> RunMakeM ([HomeModInfo], ModuleNameSet)
    forall a. a -> ReaderT MakeEnv (MaybeT IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HomeModInfo
    hmiHomeModInfo -> [HomeModInfo] -> [HomeModInfo]
    forall a. a -> [a] -> [a]
    :[HomeModInfo]
    hmis, ModuleNameSet
    new_deps)
      where
        unionModuleNameSet :: ModuleNameSet -> ModuleNameSet -> ModuleNameSet
    unionModuleNameSet = (Word64Set -> Word64Set -> Word64Set)
    -> ModuleNameSet -> ModuleNameSet -> ModuleNameSet
    forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
    M.unionWith Word64Set -> Word64Set -> Word64Set
    W.union

    -- Executing the pipelines

    label_self :: String -> IO ()
    label_self :: FilePath -> IO ()
    label_self FilePath
    thread_name = do
        ThreadId
    self_tid <- IO ThreadId
    CC.myThreadId
        ThreadId -> FilePath -> IO ()
    CC.labelThread ThreadId
    self_tid FilePath
    thread_name

    runPipelines :: WorkerLimit -> HscEnv -> (GhcMessage -> AnyGhcDiagnostic) -> Maybe Messager -> [MakeAction] -> IO ()
    -- Don't even initialise plugins if there are no pipelines
    runPipelines :: WorkerLimit
    -> HscEnv
    -> (GhcMessage -> AnyGhcDiagnostic)
    -> Maybe Messager
    -> [MakeAction]
    -> IO ()
    runPipelines WorkerLimit
    n_job HscEnv
    hsc_env GhcMessage -> AnyGhcDiagnostic
    diag_wrapper Maybe Messager
    mHscMessager [MakeAction]
    all_pipelines = do
      IO () -> IO ()
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO ()
    label_self FilePath
    "main --make thread"
      case WorkerLimit
    n_job of
        NumProcessorsLimit Int
    n | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    1 -> HscEnv
    -> (GhcMessage -> AnyGhcDiagnostic)
    -> Maybe Messager
    -> [MakeAction]
    -> IO ()
    runSeqPipelines HscEnv
    hsc_env GhcMessage -> AnyGhcDiagnostic
    diag_wrapper Maybe Messager
    mHscMessager [MakeAction]
    all_pipelines
        WorkerLimit
    _n -> WorkerLimit
    -> HscEnv
    -> (GhcMessage -> AnyGhcDiagnostic)
    -> Maybe Messager
    -> [MakeAction]
    -> IO ()
    runParPipelines WorkerLimit
    n_job HscEnv
    hsc_env GhcMessage -> AnyGhcDiagnostic
    diag_wrapper Maybe Messager
    mHscMessager [MakeAction]
    all_pipelines

    runSeqPipelines :: HscEnv -> (GhcMessage -> AnyGhcDiagnostic) -> Maybe Messager -> [MakeAction] -> IO ()
    runSeqPipelines :: HscEnv
    -> (GhcMessage -> AnyGhcDiagnostic)
    -> Maybe Messager
    -> [MakeAction]
    -> IO ()
    runSeqPipelines HscEnv
    plugin_hsc_env GhcMessage -> AnyGhcDiagnostic
    diag_wrapper Maybe Messager
    mHscMessager [MakeAction]
    all_pipelines =
      let env :: MakeEnv
    env = MakeEnv { hsc_env :: HscEnv
    hsc_env = HscEnv
    plugin_hsc_env
                        , withLogger :: forall a. Int -> ((Logger -> Logger) -> IO a) -> IO a
    withLogger = \Int
    _ (Logger -> Logger) -> IO a
    k -> (Logger -> Logger) -> IO a
    k Logger -> Logger
    forall a. a -> a
    id
                        , compile_sem :: AbstractSem
    compile_sem = IO () -> IO () -> AbstractSem
    AbstractSem (() -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()) (() -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
                        , env_messager :: Maybe Messager
    env_messager = Maybe Messager
    mHscMessager
                        , diag_wrapper :: GhcMessage -> AnyGhcDiagnostic
    diag_wrapper = GhcMessage -> AnyGhcDiagnostic
    diag_wrapper
                        }
      in WorkerLimit -> MakeEnv -> [MakeAction] -> IO ()
    runAllPipelines (Int -> WorkerLimit
    NumProcessorsLimit Int
    1) MakeEnv
    env [MakeAction]
    all_pipelines

    runNjobsAbstractSem :: Int -> (AbstractSem -> IO a) -> IO a
    runNjobsAbstractSem :: forall a. Int -> (AbstractSem -> IO a) -> IO a
    runNjobsAbstractSem Int
    n_jobs AbstractSem -> IO a
    action = do
      QSem
    compile_sem <- Int -> IO QSem
    newQSem Int
    n_jobs
      Int
    n_capabilities <- IO Int
    getNumCapabilities
      Int
    n_cpus <- IO Int
    getNumProcessors
      let
        asem :: AbstractSem
    asem = IO () -> IO () -> AbstractSem
    AbstractSem (QSem -> IO ()
    waitQSem QSem
    compile_sem) (QSem -> IO ()
    signalQSem QSem
    compile_sem)
        set_num_caps :: Int -> IO ()
    set_num_caps Int
    n = Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Int
    n_capabilities Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    1) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> IO ()
    setNumCapabilities Int
    n
        updNumCapabilities :: IO ()
    updNumCapabilities =  do
          -- Setting number of capabilities more than
          -- CPU count usually leads to high userspace
          -- lock contention. #9221
          Int -> IO ()
    set_num_caps (Int -> IO ()) -> Int -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    n_jobs Int
    n_cpus
        resetNumCapabilities :: IO ()
    resetNumCapabilities = Int -> IO ()
    set_num_caps Int
    n_capabilities
      IO () -> IO () -> IO a -> IO a
    forall (m :: * -> *) a c b.
    (HasCallStack, MonadMask m) =>
    m a -> m c -> m b -> m b
    MC.bracket_ IO ()
    updNumCapabilities IO ()
    resetNumCapabilities (IO a -> IO a) -> IO a -> IO a
    forall a b. (a -> b) -> a -> b
    $ AbstractSem -> IO a
    action AbstractSem
    asem

    runWorkerLimit :: WorkerLimit -> (AbstractSem -> IO a) -> IO a
    runWorkerLimit :: forall a. WorkerLimit -> (AbstractSem -> IO a) -> IO a
    runWorkerLimit WorkerLimit
    worker_limit AbstractSem -> IO a
    action = case WorkerLimit
    worker_limit of
        NumProcessorsLimit Int
    n_jobs ->
          Int -> (AbstractSem -> IO a) -> IO a
    forall a. Int -> (AbstractSem -> IO a) -> IO a
    runNjobsAbstractSem Int
    n_jobs AbstractSem -> IO a
    action
        JSemLimit SemaphoreName
    sem ->
          SemaphoreName -> (AbstractSem -> IO a) -> IO a
    forall a. SemaphoreName -> (AbstractSem -> IO a) -> IO a
    runJSemAbstractSem SemaphoreName
    sem AbstractSem -> IO a
    action

    -- | Build and run a pipeline
    runParPipelines :: WorkerLimit -- ^ How to limit work parallelism
                 -> HscEnv         -- ^ The basic HscEnv which is augmented with specific info for each module
                 -> (GhcMessage -> AnyGhcDiagnostic)
                 -> Maybe Messager   -- ^ Optional custom messager to use to report progress
                 -> [MakeAction]  -- ^ The build plan for all the module nodes
                 -> IO ()
    runParPipelines :: WorkerLimit
    -> HscEnv
    -> (GhcMessage -> AnyGhcDiagnostic)
    -> Maybe Messager
    -> [MakeAction]
    -> IO ()
    runParPipelines WorkerLimit
    worker_limit HscEnv
    plugin_hsc_env GhcMessage -> AnyGhcDiagnostic
    diag_wrapper Maybe Messager
    mHscMessager [MakeAction]
    all_pipelines = do

      -- A variable which we write to when an error has happened and we have to tell the
      -- logging thread to gracefully shut down.
      TVar Bool
    stopped_var <- Bool -> IO (TVar Bool)
    forall a. a -> IO (TVar a)
    newTVarIO Bool
    False
      -- The queue of LogQueues which actions are able to write to. When an action starts it
      -- will add it's LogQueue into this queue.
      TVar LogQueueQueue
    log_queue_queue_var <- LogQueueQueue -> IO (TVar LogQueueQueue)
    forall a. a -> IO (TVar a)
    newTVarIO LogQueueQueue
    newLogQueueQueue
      -- Thread which coordinates the printing of logs
      IO ()
    wait_log_thread <- Logger -> TVar Bool -> TVar LogQueueQueue -> IO (IO ())
    logThread (HscEnv -> Logger
    hsc_logger HscEnv
    plugin_hsc_env) TVar Bool
    stopped_var TVar LogQueueQueue
    log_queue_queue_var

      -- Make the logger thread-safe, in case there is some output which isn't sent via the LogQueue.
      Logger
    thread_safe_logger <- IO Logger -> IO Logger
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Logger -> IO Logger) -> IO Logger -> IO Logger
    forall a b. (a -> b) -> a -> b
    $ Logger -> IO Logger
    makeThreadSafe (HscEnv -> Logger
    hsc_logger HscEnv
    plugin_hsc_env)
      let thread_safe_hsc_env :: HscEnv
    thread_safe_hsc_env = HscEnv
    plugin_hsc_env { hsc_logger = thread_safe_logger }

      WorkerLimit -> (AbstractSem -> IO ()) -> IO ()
    forall a. WorkerLimit -> (AbstractSem -> IO a) -> IO a
    runWorkerLimit WorkerLimit
    worker_limit ((AbstractSem -> IO ()) -> IO ())
    -> (AbstractSem -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \AbstractSem
    abstract_sem -> do
        let env :: MakeEnv
    env = MakeEnv { hsc_env :: HscEnv
    hsc_env = HscEnv
    thread_safe_hsc_env
                          , withLogger :: forall a. Int -> ((Logger -> Logger) -> IO a) -> IO a
    withLogger = TVar LogQueueQueue -> Int -> ((Logger -> Logger) -> IO a) -> IO a
    forall b.
    TVar LogQueueQueue -> Int -> ((Logger -> Logger) -> IO b) -> IO b
    withParLog TVar LogQueueQueue
    log_queue_queue_var
                          , compile_sem :: AbstractSem
    compile_sem = AbstractSem
    abstract_sem
                          , env_messager :: Maybe Messager
    env_messager = Maybe Messager
    mHscMessager
                          , diag_wrapper :: GhcMessage -> AnyGhcDiagnostic
    diag_wrapper = GhcMessage -> AnyGhcDiagnostic
    diag_wrapper
                          }
        -- Reset the number of capabilities once the upsweep ends.
        WorkerLimit -> MakeEnv -> [MakeAction] -> IO ()
    runAllPipelines WorkerLimit
    worker_limit MakeEnv
    env [MakeAction]
    all_pipelines
        STM () -> IO ()
    forall a. STM a -> IO a
    atomically (STM () -> IO ()) -> STM () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ TVar Bool -> Bool -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar Bool
    stopped_var Bool
    True
        IO ()
    wait_log_thread

    withLocalTmpFS :: RunMakeM a -> RunMakeM a
    withLocalTmpFS :: forall a. RunMakeM a -> RunMakeM a
    withLocalTmpFS RunMakeM a
    act = do
      let initialiser :: ReaderT MakeEnv (MaybeT IO) HscEnv
    initialiser = do
            MakeEnv{Maybe Messager
    AbstractSem
    HscEnv
    GhcMessage -> AnyGhcDiagnostic
    forall a. Int -> ((Logger -> Logger) -> IO a) -> IO a
    hsc_env :: MakeEnv -> HscEnv
    compile_sem :: MakeEnv -> AbstractSem
    withLogger :: MakeEnv -> forall a. Int -> ((Logger -> Logger) -> IO a) -> IO a
    env_messager :: MakeEnv -> Maybe Messager
    diag_wrapper :: MakeEnv -> GhcMessage -> AnyGhcDiagnostic
    hsc_env :: HscEnv
    compile_sem :: AbstractSem
    withLogger :: forall a. Int -> ((Logger -> Logger) -> IO a) -> IO a
    env_messager :: Maybe Messager
    diag_wrapper :: GhcMessage -> AnyGhcDiagnostic
    ..} <- ReaderT MakeEnv (MaybeT IO) MakeEnv
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
            TmpFs
    lcl_tmpfs <- IO TmpFs -> ReaderT MakeEnv (MaybeT IO) TmpFs
    forall a. IO a -> ReaderT MakeEnv (MaybeT IO) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO TmpFs -> ReaderT MakeEnv (MaybeT IO) TmpFs)
    -> IO TmpFs -> ReaderT MakeEnv (MaybeT IO) TmpFs
    forall a b. (a -> b) -> a -> b
    $ TmpFs -> IO TmpFs
    forkTmpFsFrom (HscEnv -> TmpFs
    hsc_tmpfs HscEnv
    hsc_env)
            return $ HscEnv
    hsc_env { hsc_tmpfs  = lcl_tmpfs }
          finaliser :: HscEnv -> ReaderT MakeEnv m ()
    finaliser HscEnv
    lcl_env = do
            MakeEnv
    gbl_env <- ReaderT MakeEnv m MakeEnv
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
            IO () -> ReaderT MakeEnv m ()
    forall a. IO a -> ReaderT MakeEnv m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> ReaderT MakeEnv m ()) -> IO () -> ReaderT MakeEnv m ()
    forall a b. (a -> b) -> a -> b
    $ TmpFs -> TmpFs -> IO ()
    mergeTmpFsInto (HscEnv -> TmpFs
    hsc_tmpfs HscEnv
    lcl_env) (HscEnv -> TmpFs
    hsc_tmpfs (MakeEnv -> HscEnv
    hsc_env MakeEnv
    gbl_env))
           -- Add remaining files which weren't cleaned up into local tmp fs for
           -- clean-up later.
           -- Clear the logQueue if this node had it's own log queue
      ReaderT MakeEnv (MaybeT IO) HscEnv
    -> (HscEnv -> ReaderT MakeEnv (MaybeT IO) ())
    -> (HscEnv -> RunMakeM a)
    -> RunMakeM a
    forall (m :: * -> *) a c b.
    (HasCallStack, MonadMask m) =>
    m a -> (a -> m c) -> (a -> m b) -> m b
    MC.bracket ReaderT MakeEnv (MaybeT IO) HscEnv
    initialiser HscEnv -> ReaderT MakeEnv (MaybeT IO) ()
    forall {m :: * -> *}. MonadIO m => HscEnv -> ReaderT MakeEnv m ()
    finaliser ((HscEnv -> RunMakeM a) -> RunMakeM a)
    -> (HscEnv -> RunMakeM a) -> RunMakeM a
    forall a b. (a -> b) -> a -> b
    $ \HscEnv
    lcl_hsc_env -> (MakeEnv -> MakeEnv) -> RunMakeM a -> RunMakeM a
    forall r (m :: * -> *) a.
    (r -> r) -> ReaderT r m a -> ReaderT r m a
    local (\MakeEnv
    env -> MakeEnv
    env { hsc_env = lcl_hsc_env}) RunMakeM a
    act

    -- | Run the given actions and then wait for them all to finish.
    runAllPipelines :: WorkerLimit -> MakeEnv -> [MakeAction] -> IO ()
    runAllPipelines :: WorkerLimit -> MakeEnv -> [MakeAction] -> IO ()
    runAllPipelines WorkerLimit
    worker_limit MakeEnv
    env [MakeAction]
    acts = do
      let single_worker :: Bool
    single_worker = WorkerLimit -> Bool
    isWorkerLimitSequential WorkerLimit
    worker_limit
          spawn_actions :: IO [ThreadId]
          spawn_actions :: IO [ThreadId]
    spawn_actions = if Bool
    single_worker
            then (ThreadId -> [ThreadId] -> [ThreadId]
    forall a. a -> [a] -> [a]
    :[]) (ThreadId -> [ThreadId]) -> IO ThreadId -> IO [ThreadId]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
    forkIOWithUnmask (((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId)
    -> ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
    forall a b. (a -> b) -> a -> b
    $ \forall a. IO a -> IO a
    unmask -> IO [()] -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO [()] -> IO ()) -> IO [()] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (((forall a. IO a -> IO a) -> IO ()) -> IO ())
    -> MakeEnv -> [MakeAction] -> IO [()]
    forall a.
    (((forall a. IO a -> IO a) -> IO ()) -> IO a)
    -> MakeEnv -> [MakeAction] -> IO [a]
    runLoop (\(forall a. IO a -> IO a) -> IO ()
    io -> (forall a. IO a -> IO a) -> IO ()
    io IO a -> IO a
    forall a. IO a -> IO a
    unmask) MakeEnv
    env [MakeAction]
    acts)
            else (((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId)
    -> MakeEnv -> [MakeAction] -> IO [ThreadId]
    forall a.
    (((forall a. IO a -> IO a) -> IO ()) -> IO a)
    -> MakeEnv -> [MakeAction] -> IO [a]
    runLoop ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
    forkIOWithUnmask MakeEnv
    env [MakeAction]
    acts

          kill_actions :: [ThreadId] -> IO ()
          kill_actions :: [ThreadId] -> IO ()
    kill_actions [ThreadId]
    tids = (ThreadId -> IO ()) -> [ThreadId] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ThreadId -> IO ()
    killThread [ThreadId]
    tids

      IO [ThreadId]
    -> ([ThreadId] -> IO ()) -> ([ThreadId] -> IO ()) -> IO ()
    forall (m :: * -> *) a c b.
    (HasCallStack, MonadMask m) =>
    m a -> (a -> m c) -> (a -> m b) -> m b
    MC.bracket IO [ThreadId]
    spawn_actions [ThreadId] -> IO ()
    kill_actions (([ThreadId] -> IO ()) -> IO ()) -> ([ThreadId] -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \[ThreadId]
    _ -> do
        (MakeAction -> IO ()) -> [MakeAction] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ MakeAction -> IO ()
    waitMakeAction [MakeAction]
    acts

    -- | Execute each action in order, limiting the amount of parallelism by the given
    -- semaphore.
    runLoop :: (((forall a. IO a -> IO a) -> IO ()) -> IO a) -> MakeEnv -> [MakeAction] -> IO [a]
    runLoop :: forall a.
    (((forall a. IO a -> IO a) -> IO ()) -> IO a)
    -> MakeEnv -> [MakeAction] -> IO [a]
    runLoop ((forall a. IO a -> IO a) -> IO ()) -> IO a
    _ MakeEnv
    _env [] = [a] -> IO [a]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
    runLoop ((forall a. IO a -> IO a) -> IO ()) -> IO a
    fork_thread MakeEnv
    env (MakeAction RunMakeM a
    act MVar (Maybe a)
    res_var :[MakeAction]
    acts) = do
      a
    new_thread <-
        ((forall a. IO a -> IO a) -> IO ()) -> IO a
    fork_thread (((forall a. IO a -> IO a) -> IO ()) -> IO a)
    -> ((forall a. IO a -> IO a) -> IO ()) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \forall a. IO a -> IO a
    unmask -> (do
                Maybe a
    mres <- (IO (Maybe a) -> IO (Maybe a)
    forall a. IO a -> IO a
    unmask (IO (Maybe a) -> IO (Maybe a)) -> IO (Maybe a) -> IO (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ RunMakeM a -> IO (Maybe a)
    forall a. RunMakeM a -> IO (Maybe a)
    run_pipeline (RunMakeM a -> RunMakeM a
    forall a. RunMakeM a -> RunMakeM a
    withLocalTmpFS RunMakeM a
    act))
                          IO (Maybe a) -> IO () -> IO (Maybe a)
    forall (m :: * -> *) a b.
    (HasCallStack, MonadCatch m) =>
    m a -> m b -> m a
    `MC.onException` (MVar (Maybe a) -> Maybe a -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar (Maybe a)
    res_var Maybe a
    forall a. Maybe a
    Nothing) -- Defensive: If there's an unhandled exception then still signal the failure.
                MVar (Maybe a) -> Maybe a -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar (Maybe a)
    res_var Maybe a
    mres)
      [a]
    threads <- (((forall a. IO a -> IO a) -> IO ()) -> IO a)
    -> MakeEnv -> [MakeAction] -> IO [a]
    forall a.
    (((forall a. IO a -> IO a) -> IO ()) -> IO a)
    -> MakeEnv -> [MakeAction] -> IO [a]
    runLoop ((forall a. IO a -> IO a) -> IO ()) -> IO a
    fork_thread MakeEnv
    env [MakeAction]
    acts
      return (a
    new_thread a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    threads)
      where
          run_pipeline :: RunMakeM a -> IO (Maybe a)
          run_pipeline :: forall a. RunMakeM a -> IO (Maybe a)
    run_pipeline RunMakeM a
    p = MaybeT IO a -> IO (Maybe a)
    forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
    runMaybeT (RunMakeM a -> MakeEnv -> MaybeT IO a
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT RunMakeM a
    p MakeEnv
    env)

    data MakeAction = forall a . MakeAction !(RunMakeM a) !(MVar (Maybe a))

    waitMakeAction :: MakeAction -> IO ()
    waitMakeAction :: MakeAction -> IO ()
    waitMakeAction (MakeAction RunMakeM a
    _ MVar (Maybe a)
    mvar) = () () -> IO (Maybe a) -> IO ()
    forall a b. a -> IO b -> IO a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ MVar (Maybe a) -> IO (Maybe a)
    forall a. MVar a -> IO a
    readMVar MVar (Maybe a)
    mvar

    {- Note [GHC Heap Invariants]
       ~~~~~~~~~~~~~~~~~~~~~~~~~~
    This note is a general place to explain some of the heap invariants which should
    hold for a program compiled with --make mode. These invariants are all things
    which can be checked easily using ghc-debug.

    1. No HomeModInfo are reachable via the EPS.
       Why? Interfaces are lazily loaded into the EPS and the lazy thunk retains
            a reference to the entire HscEnv, if we are not careful the HscEnv will
            contain the HomePackageTable at the time the interface was loaded and
            it will never be released.
       Where? dontLeakTheHPT in GHC.Iface.Load

    2. No KnotVars are live at the end of upsweep (#20491)
       Why? KnotVars contains an old stale reference to the TypeEnv for modules
            which participate in a loop. At the end of a loop all the KnotVars references
            should be removed by the call to typecheckLoop.
       Where? typecheckLoop in GHC.Driver.Make.

    3. Immediately after a reload, no ModDetails are live.
       Why? During the upsweep all old ModDetails are replaced with a new ModDetails
            generated from a ModIface. If we don't clear the ModDetails before the
            reload takes place then memory usage during the reload is twice as much
            as it should be as we retain a copy of the ModDetails for too long.
       Where? pruneCache in GHC.Driver.Make

    4. No TcGblEnv or TcLclEnv are live after typechecking is completed.
       Why? By the time we get to simplification all the data structures from typechecking
            should be eliminated.
       Where? No one place in the compiler. These leaks can be introduced by not suitable
              forcing functions which take a TcLclEnv as an argument.

    5. At the end of a successful upsweep, the number of live ModDetails equals the
       number of non-boot Modules.
       Why? Each module has a HomeModInfo which contains a ModDetails from that module.
       Where? See Note [ModuleNameSet, efficiency and space leaks], a variety of places
              in the driver are responsible.
    -}