content: {-# LANGUAGE NondecreasingIndentation #-}
  {-# LANGUAGE CPP #-}
  {-# LANGUAGE GADTs #-}
  {-# LANGUAGE DerivingStrategies #-}
  {-# LANGUAGE ApplicativeDo #-}
  {-# LANGUAGE MultiWayIf #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE BlockArguments #-}
  {-# LANGUAGE ViewPatterns #-}
  module GHC.Driver.Downsweep
    ( downsweep
    , downsweepThunk
    , downsweepInstalledModules
    , downsweepFromRootNodes
    , downsweepInteractiveImports
    , DownsweepMode(..)
     -- * Summary functions
    , summariseModule
    , summariseFile
    , summariseModuleInterface
    , SummariseResult(..)
    -- * Helper functions
    , instantiationNodes
    , checkHomeUnitsClosed
    ) where
  
  import GHC.Prelude
  
  import GHC.Platform.Ways
  
  import GHC.Driver.Config.Finder (initFinderOpts)
  import GHC.Driver.Config.Parser (initParserOpts)
  import GHC.Driver.Phases
  import {-# SOURCE #-} GHC.Driver.Pipeline (preprocess)
  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.Messager
  import GHC.Driver.MakeSem
  import GHC.Driver.MakeAction
  import GHC.Driver.Config.Diagnostic
  import GHC.Driver.Ppr
  
  import GHC.Iface.Load
  
  import GHC.Parser.Header
  import GHC.Rename.Names
  import GHC.Tc.Utils.Backpack
  import GHC.Runtime.Context
  
  import Language.Haskell.Syntax.ImpExp
  
  import GHC.Data.Graph.Directed
  import GHC.Data.FastString
  import GHC.Data.Maybe      ( expectJust )
  import qualified GHC.Data.Maybe as M
  import GHC.Data.OsPath     ( unsafeEncodeUtf )
  import GHC.Data.StringBuffer
  import GHC.Data.Graph.Directed.Reachability
  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.Utils.Constants
  
  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.Types.Basic
  
  
  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.Module.Deps
  import qualified GHC.Unit.Home.Graph as HUG
  import GHC.Unit.Module.Stage
  
  import Data.Either ( rights, partitionEithers, lefts )
  import qualified Data.Map as Map
  import qualified Data.Set as Set
  
  import Control.Concurrent.MVar
  import Control.Monad
  import Control.Monad.Trans.Except ( ExceptT(..), runExceptT, throwE )
  import qualified Control.Monad.Catch as MC
  import Data.Maybe
  import Data.List (partition)
  import Data.Time
  import Data.List (unfoldr)
  import Data.Bifunctor (first, bimap)
  import System.Directory
  import System.FilePath
  
  import Control.Monad.Trans.Reader
  import qualified Data.Map.Strict as M
  import Control.Monad.Trans.Class
  import System.IO.Unsafe (unsafeInterleaveIO)
  
  {-
  Note [Downsweep and the ModuleGraph]
  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  
  The ModuleGraph stores the relationship between all the modules, units, and
  instantiations in the current session.
  
  When we do downsweep, we build up a new ModuleGraph, starting from the root
  modules. By following all the dependencies we construct a graph which allows
  us to answer questions about the transitive closure of the imports.
  
  The module graph is accessible in the HscEnv.
  
  When is this graph constructed?
  
  1. In `--make` mode, we construct the graph before starting to do any compilation.
  
  2. In `-c` (oneshot) mode, we construct the graph when we have calculated the
     ModSummary for the module we are compiling. The `ModuleGraph` is stored in a
     thunk, so it is only constructed when it is needed. This avoids reading
     the interface files of the whole transitive closure unless they are needed.
  
  3. In some situations (such as loading plugins) we may need to construct the
     graph without having a ModSummary. In this case we use the `downsweepInstalledModules`
     function.
  
  The result is having a uniform graph available for the whole compilation pipeline.
  
  -}
  
  -- 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 ModuleNodeInfo]
  
  -----------------------------------------------------------------------------
  --
  -- | Downsweep (dependency analysis) for --make mode
  --
  -- 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 ModuleGraph 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.
  --
  -- This function is intendned for use by --make mode and will also insert
  -- LinkNodes and InstantiationNodes for any home units.
  --
  -- It will also turn on code generation for any modules that need it by calling
  -- 'enableCodeGenForTH'.
  downsweep :: HscEnv
            -> (GhcMessage -> AnyGhcDiagnostic)
            -> Maybe Messager
            -> [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], ModuleGraph)
                  -- 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 hsc_env diag_wrapper msg old_summaries excl_mods allow_dup_roots = do
    n_jobs <- mkWorkerLimit (hsc_dflags hsc_env)
    (root_errs, root_summaries) <- rootSummariesParallel n_jobs hsc_env diag_wrapper msg summary
    let closure_errs = checkHomeUnitsClosed unit_env
        unit_env = hsc_unit_env hsc_env
  
        all_errs = closure_errs ++ root_errs
  
    case all_errs of
      [] -> do
         (downsweep_errs, downsweep_nodes) <- downsweepFromRootNodes hsc_env old_summary_map excl_mods allow_dup_roots DownsweepUseCompile (map ModuleNodeCompile root_summaries) []
  
         let (other_errs, unit_nodes) = partitionEithers $ HUG.unitEnv_foldWithKey (\nodes uid hue -> nodes ++ unitModuleNodes downsweep_nodes uid hue) [] (hsc_HUG hsc_env)
  
         let all_nodes = downsweep_nodes ++ unit_nodes
         let all_errs = downsweep_errs ++ other_errs
  
         let logger = hsc_logger hsc_env
             tmpfs = hsc_tmpfs hsc_env
         -- 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
         th_configured_nodes <- enableCodeGenForTH logger tmpfs unit_env all_nodes
  
         return (all_errs, th_configured_nodes)
      _  -> return (all_errs, emptyMG)
    where
      summary = getRootSummary excl_mods old_summary_map
  
      -- 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 =
        M.fromList [((ms_unitid ms, msHsFilePath ms), ms) | ms <- old_summaries]
  
      -- Dependencies arising on a unit (backpack and module linking deps)
      unitModuleNodes :: [ModuleGraphNode] -> UnitId -> HomeUnitEnv -> [Either (Messages DriverMessage) ModuleGraphNode]
      unitModuleNodes summaries uid hue =
        maybeToList (linkNodes summaries uid hue)
  
  -- | Calculate the module graph starting from a single ModSummary. The result is a
  -- thunk, which when forced will perform the downsweep. This is useful in oneshot
  -- mode where the module graph may never be needed.
  -- If downsweep fails, then the resulting errors are just thrown.
  downsweepThunk :: HscEnv -> ModSummary -> IO ModuleGraph
  downsweepThunk hsc_env mod_summary = unsafeInterleaveIO $ do
    debugTraceMsg (hsc_logger hsc_env) 3 $ text "Computing Module Graph thunk..."
    ~(errs, mg) <- downsweepFromRootNodes hsc_env mempty [] True DownsweepUseFixed [ModuleNodeCompile mod_summary] []
    let dflags = hsc_dflags hsc_env
    liftIO $ printOrThrowDiagnostics (hsc_logger hsc_env)
                                     (initPrintConfig dflags)
                                     (initDiagOpts dflags)
                                     (GhcDriverMessage <$> unionManyMessages errs)
    return (mkModuleGraph mg)
  
  -- | Construct a module graph starting from the interactive context.
  -- Produces, a thunk, which when forced will perform the downsweep.
  -- This graph contains the current interactive module, and its dependencies.
  --
  --  Invariant: The hsc_mod_graph already contains the relevant home modules which
  --  might be imported by the interactive imports.
  --
  -- This is a first approximation for this function. There probably should also
  -- be edges linking the interactive modules together. (Ie Ghci7 importing Ghci6
  -- and so on)
  -- See Note [runTcInteractive module graph]
  downsweepInteractiveImports :: HscEnv -> InteractiveContext -> IO ModuleGraph
  downsweepInteractiveImports hsc_env ic = unsafeInterleaveIO $ do
    debugTraceMsg (hsc_logger hsc_env) 3 $ (text "Computing Interactive Module Graph thunk...")
    let imps = ic_imports (hsc_IC hsc_env)
  
    let interactive_mn = icInteractiveModule ic
    -- No sensible value for ModLocation.. if you hit this panic then you probably
    -- need to add proper support for modules without any source files to the driver.
    let ml = pprPanic "modLocation" (ppr interactive_mn <+> ppr imps)
    let key = moduleToMnk interactive_mn NotBoot
    let node_type = ModuleNodeFixed key ml
  
    -- The existing nodes in the module graph. This will be populated when GHCi runs
    -- :load. Any home package modules need to already be in here.
    let cached_nodes = Map.fromList [ (mkNodeKey n, n) | n <- mg_mss (hsc_mod_graph hsc_env) ]
  
    (module_edges, graph) <- loopFromInteractive hsc_env (map mkEdge imps) cached_nodes
    let interactive_node = ModuleNode module_edges node_type
  
    let all_nodes  = M.elems graph
    return $ mkModuleGraph (interactive_node : all_nodes)
  
    where
   --
      mkEdge :: InteractiveImport -> Either ModuleNodeEdge (UnitId, ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))
      -- A simple edge to a module from the same home unit
      mkEdge (IIModule n) =
        let
          mod_node_key = ModNodeKeyWithUid
            { mnkModuleName = GWIB (moduleName n) NotBoot
            , mnkUnitId =
                -- 'toUnitId' is safe here, as we can't import modules that
                -- don't have a 'UnitId'.
                toUnitId (moduleUnit n)
            }
          mod_node_edge =
            ModuleNodeEdge NormalLevel (NodeKey_Module mod_node_key)
        in Left mod_node_edge
      -- A complete import statement
      mkEdge (IIDecl i) =
        let lvl = convImportLevel (ideclLevelSpec i)
            wanted_mod = unLoc (ideclName i)
            is_boot = ideclSource i
            mb_pkg = renameRawPkgQual (hsc_unit_env hsc_env) (unLoc $ ideclName i) (ideclPkgQual i)
            unitId = homeUnitId $ hsc_home_unit hsc_env
        in Right (unitId, lvl, mb_pkg, GWIB (noLoc wanted_mod) is_boot)
  
  loopFromInteractive :: HscEnv
                      -> [Either ModuleNodeEdge (UnitId, ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))]
                      -> M.Map NodeKey ModuleGraphNode
                      -> IO ([ModuleNodeEdge],M.Map NodeKey ModuleGraphNode)
  loopFromInteractive _ [] cached_nodes = return ([], cached_nodes)
  loopFromInteractive hsc_env (edge:edges) cached_nodes =
    case edge of
      Left edge -> do
          (edges, cached_nodes') <- loopFromInteractive hsc_env edges cached_nodes
          return (edge : edges, cached_nodes')
      Right (unitId, lvl, mb_pkg, GWIB wanted_mod is_boot) -> do
        let home_unit = ue_unitHomeUnit unitId (hsc_unit_env hsc_env)
        let k _ loc mod =
              let key = moduleToMnk mod is_boot
              in return $ FoundHome (ModuleNodeFixed key loc)
        found <- liftIO $ summariseModuleDispatch k hsc_env home_unit is_boot wanted_mod mb_pkg []
        case found of
          -- Case 1: Home modules have to already be in the cache.
          FoundHome (ModuleNodeFixed mod _) -> do
            let edge = ModuleNodeEdge lvl (NodeKey_Module mod)
            -- Note: Does not perform any further downsweep as the module must already be in the cache.
            (edges, cached_nodes') <- loopFromInteractive hsc_env edges cached_nodes
            return (edge : edges, cached_nodes')
          -- Case 2: External units may not be in the cache, if we haven't already initialised the
          -- module graph. We can construct the module graph for those here by calling loopUnit.
          External uid -> do
            let hsc_env' = hscSetActiveHomeUnit home_unit hsc_env
                cached_nodes' = loopUnit hsc_env' cached_nodes [uid]
                edge = ModuleNodeEdge lvl (NodeKey_ExternalUnit uid)
            (edges, cached_nodes') <- loopFromInteractive hsc_env edges cached_nodes'
            return (edge : edges, cached_nodes')
          -- And if it's not found.. just carry on and hope.
          _ -> loopFromInteractive hsc_env edges cached_nodes
  
  
  -- | Create a module graph from a list of installed modules.
  -- This is used by the loader when we need to load modules but there
  -- isn't already an existing module graph. For example, when loading plugins
  -- during initialisation.
  --
  -- If you call this function, then if the `Module` you request to downsweep can't
  -- be found then this function will throw errors.
  -- If you need to use this function elsewhere, then it would make sense to make it
  -- return [DriverMessages] and [ModuleGraph] so that the caller can handle the errors as it sees fit.
  -- At the moment, it is overfitted for what `get_reachable_nodes` needs.
  downsweepInstalledModules :: HscEnv -> [Module] -> IO ModuleGraph
  downsweepInstalledModules hsc_env mods = do
      let
          (home_mods, external_mods) = partition (\u -> moduleUnitId u `elem` hsc_all_home_unit_ids hsc_env) mods
          installed_mods = map (fst . getModuleInstantiation) home_mods
          external_uids = map moduleUnitId external_mods
  
          process :: InstalledModule -> IO ModuleNodeInfo
          process i = do
            res <- findExactModule hsc_env i NotBoot
            case res of
              InstalledFound loc -> return $ ModuleNodeFixed (installedModuleToMnk i) loc
              -- It is an internal-ish error if this happens, since we any call to this function should
              -- already know that we can find the modules we need to load.
              _ -> throwGhcException $ ProgramError $ showSDoc (hsc_dflags hsc_env) $ text "downsweepInstalledModules: Could not find installed module" <+> ppr i
  
      nodes <- mapM process installed_mods
      (errs, mg) <- downsweepFromRootNodes hsc_env mempty [] True DownsweepUseFixed nodes external_uids
  
      -- Similarly here, we should really not get any errors, but print them out if we do.
      let dflags = hsc_dflags hsc_env
      liftIO $ printOrThrowDiagnostics (hsc_logger hsc_env)
                                       (initPrintConfig dflags)
                                       (initDiagOpts dflags)
                                       (GhcDriverMessage <$> unionManyMessages errs)
  
      return (mkModuleGraph mg)
  
  
  
  -- | Whether downsweep should use compiler or fixed nodes. Compile nodes are used
  -- by --make mode, and fixed nodes by oneshot mode.
  --
  -- See Note [Module Types in the ModuleGraph] for the difference between the two.
  data DownsweepMode = DownsweepUseCompile | DownsweepUseFixed
  
  -- | Perform downsweep, starting from the given root 'ModuleNodeInfo's and root
  -- 'UnitId's.
  -- This function will start at the given roots, and traverse downwards to find
  -- all the dependencies, all the way to the leaf units.
  downsweepFromRootNodes :: HscEnv
                    -> M.Map (UnitId, FilePath) ModSummary
                    -> [ModuleName]
                    -> Bool
                    -> DownsweepMode -- ^ Whether to create fixed or compile nodes for dependencies
                    -> [ModuleNodeInfo] -- ^ The starting ModuleNodeInfo
                    -> [UnitId] -- ^ The starting units
                    -> IO ([DriverMessages], [ModuleGraphNode])
  downsweepFromRootNodes hsc_env old_summaries excl_mods allow_dup_roots mode root_nodes root_uids
     = do
         let root_map = mkRootMap root_nodes
         checkDuplicates root_map
         let env = DownsweepEnv hsc_env mode old_summaries excl_mods
         (deps', map0) <- runDownsweepM env  $ do
                      (module_deps, map0) <- loopModuleNodeInfos root_nodes (M.empty, root_map)
                      let all_deps = loopUnit hsc_env module_deps root_uids
                      let all_instantiations =  getHomeUnitInstantiations hsc_env
                      deps' <- loopInstantiations all_instantiations all_deps
                      return (deps', map0)
  
  
         let downsweep_errs = lefts $ concat $ M.elems map0
             downsweep_nodes = M.elems deps'
  
         return (downsweep_errs, downsweep_nodes)
       where
          getHomeUnitInstantiations :: HscEnv -> [(UnitId, InstantiatedUnit)]
          getHomeUnitInstantiations hsc_env = HUG.unitEnv_foldWithKey (\nodes uid hue -> nodes ++  instantiationNodes uid (homeUnitEnv_units hue)) [] (hsc_HUG hsc_env)
  
          -- 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 root_map
             | not allow_dup_roots
             , dup_root:_ <- dup_roots = liftIO $ multiRootsErr sec dup_root
             | otherwise = pure ()
             where
               sec = initSourceErrorContext (hsc_dflags hsc_env)
               dup_roots :: [[ModuleNodeInfo]]        -- Each at least of length 2
               dup_roots = filterOut isSingleton $ map rights (M.elems root_map)
  
  
  calcDeps :: ModSummary -> [(UnitId, ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))]
  calcDeps ms =
    -- Add a dependency on the HsBoot file if it exists
    -- This gets passed to the loopImports function which just ignores it if it
    -- can't be found.
    [(ms_unitid ms, NormalLevel, NoPkgQual, GWIB (noLoc $ ms_mod_name ms) IsBoot) | NotBoot <- [isBootSummary ms] ] ++
    [(ms_unitid ms, lvl, b, c) | (lvl, b, c) <- msDeps ms ]
  
  
  type DownsweepM a = ReaderT DownsweepEnv IO a
  data DownsweepEnv = DownsweepEnv {
        downsweep_hsc_env :: HscEnv
      , _downsweep_mode :: DownsweepMode
      , _downsweep_old_summaries :: M.Map (UnitId, FilePath) ModSummary
      , _downsweep_excl_mods :: [ModuleName]
  }
  
  runDownsweepM :: DownsweepEnv -> DownsweepM a -> IO a
  runDownsweepM env act = runReaderT act env
  
  
  loopInstantiations :: [(UnitId, InstantiatedUnit)]
                     -> M.Map NodeKey ModuleGraphNode
                     -> DownsweepM (M.Map NodeKey ModuleGraphNode)
  loopInstantiations [] done = pure done
  loopInstantiations ((home_uid, iud) :xs) done = do
    hsc_env <- asks downsweep_hsc_env
    let home_unit = ue_unitHomeUnit home_uid (hsc_unit_env hsc_env)
    let hsc_env' = hscSetActiveHomeUnit home_unit hsc_env
        done' = loopUnit hsc_env' done [instUnitInstanceOf iud]
        payload = InstantiationNode home_uid iud
    loopInstantiations xs (M.insert (mkNodeKey payload) payload done')
  
  
  -- 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)
        -> DownsweepM ((M.Map NodeKey ModuleGraphNode), DownsweepCache)
  loopSummaries [] done = pure done
  loopSummaries (ms:next) (done, summarised)
    | Just {} <- M.lookup k done
    = loopSummaries next (done, summarised)
    -- Didn't work out what the imports mean yet, now do that.
    | otherwise = do
       (final_deps, done', summarised') <- loopImports (calcDeps ms) done summarised
       -- This has the effect of finding a .hs file if we are looking at the .hs-boot file.
       (_, done'', summarised'') <- loopImports (maybeToList hs_file_for_boot) done' summarised'
       loopSummaries next (M.insert k (ModuleNode final_deps (ModuleNodeCompile ms)) done'', summarised'')
    where
      k = NodeKey_Module (msKey ms)
  
      hs_file_for_boot
        | HsBootFile <- ms_hsc_src ms
        = Just $ ((ms_unitid ms), NormalLevel, NoPkgQual, (GWIB (noLoc $ ms_mod_name ms) NotBoot))
        | otherwise
        = Nothing
  
  loopModuleNodeInfos :: [ModuleNodeInfo] -> (M.Map NodeKey ModuleGraphNode, DownsweepCache) -> DownsweepM (M.Map NodeKey ModuleGraphNode, DownsweepCache)
  loopModuleNodeInfos is cache = foldM (flip loopModuleNodeInfo) cache is
  
  loopModuleNodeInfo :: ModuleNodeInfo -> (M.Map NodeKey ModuleGraphNode, DownsweepCache) -> DownsweepM (M.Map NodeKey ModuleGraphNode, DownsweepCache)
  loopModuleNodeInfo mod_node_info (done, summarised) = do
    case mod_node_info of
      ModuleNodeCompile ms -> do
        loopSummaries [ms] (done, summarised)
      ModuleNodeFixed mod ml -> do
        done' <- loopFixedModule mod ml done
        return (done', summarised)
  
  -- NB: loopFixedModule does not take a downsweep cache, because if you
  -- ever reach a Fixed node, everything under that also must be fixed.
  loopFixedModule :: ModNodeKeyWithUid -> ModLocation
                  -> M.Map NodeKey ModuleGraphNode
                  -> DownsweepM (M.Map NodeKey ModuleGraphNode)
  loopFixedModule key loc done = do
    let nk = NodeKey_Module key
    hsc_env <- asks downsweep_hsc_env
    case M.lookup nk done of
      Just {} -> return done
      Nothing -> do
        -- MP: TODO, we should just read the dependency info from the interface rather than either
        -- a. Loading the whole thing into the EPS (this might never nececssary and causes lots of things to be permanently loaded into memory)
        -- b. Loading the whole interface into a buffer before discarding it. (wasted allocation and deserialisation)
        read_result <- liftIO $
          -- 1. Check if the interface is already loaded into the EPS by some other
          -- part of the compiler.
          lookupIfaceByModuleHsc hsc_env (mnkToModule key) >>= \case
            Just iface -> return (M.Succeeded iface)
            Nothing -> readIface (hsc_hooks hsc_env) (hsc_logger hsc_env) (hsc_dflags hsc_env) (hsc_NC hsc_env) (mnkToModule key) (ml_hi_file loc)
        case read_result of
          M.Succeeded iface -> do
            -- Computer information about this node
            let node_deps = ifaceDeps (mi_deps iface)
                edges = map mkFixedEdge node_deps
                node = ModuleNode edges (ModuleNodeFixed key loc)
            foldM (loopFixedNodeKey (mnkUnitId key)) (M.insert nk node done) (bimap snd snd <$> node_deps)
          -- Ignore any failure, we might try to read a .hi-boot file for
          -- example, even if there is not one.
          M.Failed {} ->
            return done
  
  loopFixedNodeKey :: UnitId -> M.Map NodeKey ModuleGraphNode -> Either ModNodeKeyWithUid UnitId -> DownsweepM  (M.Map NodeKey ModuleGraphNode)
  loopFixedNodeKey _ done (Left key) = do
    loopFixedImports [key] done
  loopFixedNodeKey home_uid done (Right uid) = do
    -- Set active unit so that looking loopUnit finds the correct
    -- -package flags in the unit state.
    hsc_env <- asks downsweep_hsc_env
    let hsc_env' = hscSetActiveUnitId home_uid hsc_env
    return $ loopUnit hsc_env' done [uid]
  
  mkFixedEdge :: Either (ImportLevel, ModNodeKeyWithUid) (ImportLevel, UnitId) -> ModuleNodeEdge
  mkFixedEdge (Left (lvl, key)) = mkModuleEdge lvl (NodeKey_Module key)
  mkFixedEdge (Right (lvl, uid)) = mkModuleEdge lvl (NodeKey_ExternalUnit uid)
  
  ifaceDeps :: Dependencies -> [Either (ImportLevel, ModNodeKeyWithUid) (ImportLevel, UnitId)]
  ifaceDeps deps =
    [ Left (tcImportLevel lvl, ModNodeKeyWithUid dep uid)
    | (lvl, uid, dep) <- Set.toList (dep_direct_mods deps)
    ] ++
    [ Right (tcImportLevel lvl, uid)
    | (lvl, uid) <- Set.toList (dep_direct_pkgs deps)
    ]
  
  -- Like loopImports, but we already know exactly which module we are looking for.
  loopFixedImports :: [ModNodeKeyWithUid]
                   -> M.Map NodeKey ModuleGraphNode
                   -> DownsweepM (M.Map NodeKey ModuleGraphNode)
  loopFixedImports [] done = pure done
  loopFixedImports (key:keys) done = do
    let nk = NodeKey_Module key
    hsc_env <- asks downsweep_hsc_env
    case M.lookup nk done of
      Just {} -> loopFixedImports keys done
      Nothing -> do
        read_result <- liftIO $ findExactModule hsc_env (mnkToInstalledModule key) (mnkIsBoot key)
        case read_result of
          InstalledFound loc -> do
            done' <- loopFixedModule key loc done
            loopFixedImports keys done'
          _otherwise ->
            -- If the finder fails, just keep going, there will be another
            -- error later.
            loopFixedImports keys done
  
  downsweepSummarise :: HomeUnit
                     -> IsBootInterface
                     -> Located ModuleName
                     -> PkgQual
                     -> Maybe (StringBuffer, UTCTime)
                     -> DownsweepM SummariseResult
  downsweepSummarise home_unit is_boot wanted_mod mb_pkg maybe_buf = do
    DownsweepEnv hsc_env mode old_summaries excl_mods <- ask
    case mode of
      DownsweepUseCompile -> liftIO $ summariseModule hsc_env home_unit old_summaries is_boot wanted_mod mb_pkg maybe_buf excl_mods
      DownsweepUseFixed -> liftIO $ summariseModuleInterface hsc_env home_unit is_boot wanted_mod mb_pkg excl_mods
  
  
  -- 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, ImportLevel, 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
       -> DownsweepM ([ModuleNodeEdge],
            M.Map NodeKey ModuleGraphNode, DownsweepCache)
                  -- The result is the completed NodeMap
  loopImports [] done summarised = return ([], done, summarised)
  loopImports ((home_uid, imp, mb_pkg, gwib) : ss) done summarised
    | Just summs <- M.lookup cache_key summarised
    = case summs of
        [Right ms] -> do
          let nk = mkModuleEdge imp (NodeKey_Module (mnKey ms))
          (rest, summarised', done') <- loopImports ss done summarised
          return (nk: rest, summarised', done')
        [Left _err] ->
          loopImports ss done summarised
        _errs ->  do
          loopImports ss done summarised
    | otherwise
    = do
         hsc_env <- asks downsweep_hsc_env
         let home_unit = ue_unitHomeUnit home_uid (hsc_unit_env hsc_env)
         mb_s <- downsweepSummarise home_unit
                                 is_boot wanted_mod mb_pkg
                                 Nothing
         case mb_s of
             NotThere -> loopImports ss done summarised
             External uid -> do
              -- Pass an updated hsc_env to loopUnit, as each unit might
              -- have a different visible package database.
              let hsc_env' = hscSetActiveHomeUnit home_unit hsc_env
              let done' = loopUnit hsc_env' done [uid]
              (other_deps, done'', summarised') <- loopImports ss done' summarised
              return (mkModuleEdge imp (NodeKey_ExternalUnit uid) : other_deps, done'', summarised')
             FoundInstantiation iud -> do
              (other_deps, done', summarised') <- loopImports ss done summarised
              return (mkModuleEdge imp (NodeKey_Unit iud) : other_deps, done', summarised')
             FoundHomeWithError (_uid, e) ->  loopImports ss done (Map.insert cache_key [(Left e)] summarised)
             FoundHome s -> do
               (done', summarised') <-
                 loopModuleNodeInfo s (done, Map.insert cache_key [Right s] summarised)
               (other_deps, final_done, final_summarised) <- loopImports ss done' summarised'
  
               -- MP: This assumes that we can only instantiate non home units, which is probably fair enough for now.
               return (mkModuleEdge imp (NodeKey_Module (mnKey s)) : other_deps, final_done, final_summarised)
    where
      cache_key = (home_uid, mb_pkg, unLoc <$> gwib)
      GWIB { gwib_mod = L loc mod, gwib_isBoot = is_boot } = gwib
      wanted_mod = L loc mod
  
  loopUnit :: HscEnv -> Map.Map NodeKey ModuleGraphNode -> [UnitId] -> Map.Map NodeKey ModuleGraphNode
  loopUnit _ cache [] = cache
  loopUnit lcl_hsc_env cache (u:uxs) = do
     let nk = (NodeKey_ExternalUnit u)
     case Map.lookup nk cache of
       Just {} -> loopUnit lcl_hsc_env cache uxs
       Nothing -> case unitDepends <$> lookupUnitId (hsc_units lcl_hsc_env) u of
                   Just us -> loopUnit lcl_hsc_env (loopUnit lcl_hsc_env (Map.insert nk (UnitNode us u) cache) us) uxs
                   Nothing -> pprPanic "loopUnit" (text "Malformed package database, missing " <+> ppr u)
  
  multiRootsErr :: SourceErrorContext -> [ModuleNodeInfo] -> IO ()
  multiRootsErr _ [] = panic "multiRootsErr"
  multiRootsErr sec summs@(summ1:_)
    = throwOneError sec $ fmap GhcDriverMessage $
      mkPlainErrorMsgEnvelope noSrcSpan $ DriverDuplicatedModuleDeclaration mod files
    where
      mod = moduleNodeInfoModule summ1
      files = mapMaybe (ml_hs_file . moduleNodeInfoLocation) summs
  
  moduleNotFoundErr :: UnitId -> ModuleName -> DriverMessages
  moduleNotFoundErr uid mod = singleMessage $ mkPlainErrorMsgEnvelope noSrcSpan (DriverModuleNotFound uid mod)
  
  -- | 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.
  instantiationNodes :: UnitId -> UnitState -> [(UnitId, InstantiatedUnit)]
  instantiationNodes uid unit_state = map (uid,) iuids_to_check
    where
      iuids_to_check :: [InstantiatedUnit]
      iuids_to_check =
        nubSort $ concatMap (goUnitId . fst) (explicitUnits unit_state)
       where
        goUnitId uid =
          [ recur
          | VirtUnit indef <- [uid]
          , inst <- instUnitInsts indef
          , recur <- (indef :) $ goUnitId $ moduleUnit $ snd inst
          ]
  
  -- The linking plan for each module. If we need to do linking for a home unit
  -- then this function returns a graph node which depends on all the modules in the home unit.
  
  -- At the moment nothing can depend on these LinkNodes.
  linkNodes :: [ModuleGraphNode] -> UnitId -> HomeUnitEnv -> Maybe (Either (Messages DriverMessage) ModuleGraphNode)
  linkNodes summaries uid hue =
    let dflags = homeUnitEnv_dflags hue
        ofile = outputFile_ dflags
  
        unit_nodes :: [NodeKey]
        unit_nodes = map mkNodeKey (filter ((== uid) . mgNodeUnitId) summaries)
    -- Issue a warning for the confusing case where the user
    -- said '-o foo' but we're not going to do any linking.
    -- We attempt linking if either (a) one of the modules is
    -- called Main, or (b) the user said -no-hs-main, indicating
    -- that main() is going to come from somewhere else.
    --
        no_hs_main = gopt Opt_NoHsMain dflags
  
        main_sum = any (== NodeKey_Module (ModNodeKeyWithUid (GWIB (mainModuleNameIs dflags) NotBoot) uid)) unit_nodes
  
        do_linking =  main_sum || no_hs_main || ghcLink dflags == LinkDynLib || ghcLink dflags == LinkStaticLib
  
    in if | ghcLink dflags == LinkBinary && isJust ofile && not do_linking ->
              Just (Left $ singleMessage $ mkPlainErrorMsgEnvelope noSrcSpan (DriverRedirectedNoMain $ mainModuleNameIs dflags))
          -- This should be an error, not a warning (#10895).
          | ghcLink dflags /= NoLink, do_linking -> Just (Right (LinkNode unit_nodes uid))
          | otherwise  -> Nothing
  
  getRootSummary ::
    [ModuleName] ->
    M.Map (UnitId, FilePath) ModSummary ->
    HscEnv ->
    Target ->
    IO (Either DriverMessages ModSummary)
  getRootSummary excl_mods old_summary_map hsc_env target
    | TargetFile file mb_phase <- targetId
    = do
      let offset_file = augmentByWorkingDirectory dflags file
      exists <- liftIO $ doesFileExist offset_file
      if exists || isJust maybe_buf
      then summariseFile hsc_env home_unit old_summary_map offset_file mb_phase
           maybe_buf
      else
        return $ Left $ singleMessage $
        mkPlainErrorMsgEnvelope noSrcSpan (DriverFileNotFound offset_file)
    | TargetModule modl <- targetId
    = do
      maybe_summary <- summariseModule hsc_env home_unit old_summary_map NotBoot
                       (L rootLoc modl) (ThisPkg (homeUnitId home_unit))
                       maybe_buf excl_mods
      pure case maybe_summary of
        FoundHome (ModuleNodeCompile s)  -> Right s
        FoundHomeWithError err -> Left (snd err)
        _ -> Left (moduleNotFoundErr uid modl)
      where
        Target {targetId, targetContents = maybe_buf, targetUnitId = uid} = target
        home_unit = ue_unitHomeUnit uid (hsc_unit_env hsc_env)
        rootLoc = mkGeneralSrcSpan (fsLit "<command line>")
        dflags = homeUnitEnv_dflags (ue_findHomeUnitEnv uid (hsc_unit_env hsc_env))
  
  -- | Execute 'getRootSummary' for the 'Target's using the parallelism pipeline
  -- system.
  -- Create bundles of 'Target's wrapped in a 'MakeAction' that uses
  -- 'withAbstractSem' to wait for a free slot, limiting the number of
  -- concurrently computed summaries to the value of the @-j@ option or the slots
  -- allocated by the job server, if that is used.
  --
  -- The 'MakeAction' returns 'Maybe', which is not handled as an error, because
  -- 'runLoop' only sets it to 'Nothing' when an exception was thrown, so the
  -- result won't be read anyway here.
  --
  -- To emulate the current behavior, we funnel exceptions past the concurrency
  -- barrier and rethrow the first one afterwards.
  rootSummariesParallel ::
    WorkerLimit ->
    HscEnv ->
    (GhcMessage -> AnyGhcDiagnostic) ->
    Maybe Messager ->
    (HscEnv -> Target -> IO (Either DriverMessages ModSummary)) ->
    IO ([DriverMessages], [ModSummary])
  rootSummariesParallel n_jobs hsc_env diag_wrapper msg get_summary = do
    (actions, get_results) <- unzip <$> mapM action_and_result (zip [1..] bundles)
    runPipelines n_jobs hsc_env diag_wrapper msg actions
    (sequence . catMaybes <$> sequence get_results) >>= \case
      Right results -> pure (partitionEithers (concat results))
      Left exc -> throwIO exc
    where
      bundles = mk_bundles targets
  
      mk_bundles = unfoldr \case
        [] -> Nothing
        ts -> Just (splitAt bundle_size ts)
  
      bundle_size = 20
  
      targets = hsc_targets hsc_env
  
      action_and_result (log_queue_id, ts) = do
        res_var <- liftIO newEmptyMVar
        pure $! (MakeAction (action log_queue_id ts) res_var, readMVar res_var)
  
      action log_queue_id target_bundle = do
        env@MakeEnv {compile_sem} <- ask
        lift $ lift $
          withAbstractSem compile_sem $
          withLoggerHsc log_queue_id env \ lcl_hsc_env ->
            MC.try (mapM (get_summary lcl_hsc_env) target_bundle) >>= \case
              Left e | Just (_ :: SomeAsyncException) <- fromException e ->
                throwIO e
              a -> pure a
  
  -- | 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 ue
      | Set.null bad_unit_ids = []
      | otherwise = [singleMessage $ mkPlainErrorMsgEnvelope rootLoc $ DriverHomePackagesNotClosed (Set.toList bad_unit_ids)]
    where
      home_id_set = HUG.allUnits $ ue_home_unit_graph ue
      bad_unit_ids = upwards_closure Set.\\ home_id_set {- Remove all home units reached, keep only bad nodes -}
      rootLoc = mkGeneralSrcSpan (fsLit "<command line>")
  
      downwards_closure :: Graph (Node UnitId UnitId)
      downwards_closure = graphFromEdgedVerticesUniq graphNodes
  
      inverse_closure = graphReachability $ transposeG downwards_closure
  
      upwards_closure = Set.fromList $ map node_key $ allReachableMany inverse_closure [DigraphNode uid uid [] | uid <- Set.toList home_id_set]
  
      all_unit_direct_deps :: UniqMap UnitId (Set.Set UnitId)
      all_unit_direct_deps
        = HUG.unitEnv_foldWithKey go emptyUniqMap $ ue_home_unit_graph ue
        where
          go rest this this_uis =
             plusUniqMap_C Set.union
               (addToUniqMap_C Set.union external_depends this (Set.fromList $ this_deps))
               rest
             where
               external_depends = mapUniqMap (Set.fromList . unitDepends) (unitInfoMap this_units)
               this_units = homeUnitEnv_units this_uis
               this_deps = [ toUnitId unit | (unit,Just _) <- explicitUnits this_units]
  
      graphNodes :: [Node UnitId UnitId]
      graphNodes = go Set.empty home_id_set
        where
          go done todo
            = case Set.minView todo of
                Nothing -> []
                Just (uid, todo')
                  | Set.member uid done -> go done todo'
                  | otherwise -> case lookupUniqMap all_unit_direct_deps uid of
                      Nothing -> pprPanic "uid not found" (ppr (uid, all_unit_direct_deps))
                      Just depends ->
                        let todo'' = (depends Set.\\ done) `Set.union` todo'
                        in DigraphNode uid uid (Set.toList depends) : go (Set.insert uid done) 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 ModuleGraph
  enableCodeGenForTH logger tmpfs unit_env =
    enableCodeGenWhen logger tmpfs TFL_CurrentModule TFL_GhcSession unit_env
  
  
  data CodeGenEnable = EnableByteCode | EnableObject | EnableByteCodeAndObject deriving (Eq, Show, Ord)
  
  instance Outputable CodeGenEnable where
    ppr = text . 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 ModuleGraph
  enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = do
    mgMapM enable_code_gen mg
    where
      defaultBackendOf ms = platformDefaultBackend (targetPlatform $ ue_unitFlags (ms_unitid ms) unit_env)
  
      enable_code_gen :: ModuleNodeInfo -> IO ModuleNodeInfo
      enable_code_gen (ModuleNodeCompile ms) = ModuleNodeCompile <$> enable_code_gen_ms ms
      enable_code_gen m@(ModuleNodeFixed {}) = return m
  
      -- FIXME: Strong resemblance and some duplication between this and `makeDynFlagsConsistent`.
      -- It would be good to consider how to make these checks more uniform and not duplicated.
      enable_code_gen_ms :: ModSummary -> IO ModSummary
      enable_code_gen_ms ms
        | ModSummary
          { ms_location = ms_location
          , ms_hsc_src = HsSrcFile
          , ms_hspp_opts = dflags
          } <- ms
        , Just enable_spec <- needs_codegen_map ms =
        if | nocode_enable ms -> do
                 let new_temp_file suf dynsuf = do
                       tn <- newTempName logger tmpfs (tmpDir dflags) staticLife suf
                       let dyn_tn = tn -<.> dynsuf
                       addFilesToClean tmpfs dynLife [dyn_tn]
                       return (unsafeEncodeUtf tn, unsafeEncodeUtf 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.
                   --
                 ((hi_file, dyn_hi_file), (o_file, dyn_o_file)) <-
                   -- If ``-fwrite-interface` is specified, then the .o and .hi files
                   -- are written into `-odir` and `-hidir` respectively.  #16670
                   if gopt Opt_WriteInterface dflags
                     then return ((ml_hi_file_ospath ms_location, ml_dyn_hi_file_ospath ms_location)
                                 , (ml_obj_file_ospath ms_location, ml_dyn_obj_file_ospath ms_location))
                     else (,) <$> (new_temp_file (hiSuf_ dflags) (dynHiSuf_ dflags))
                              <*> (new_temp_file (objectSuf_ dflags) (dynObjectSuf_ dflags))
                 let new_dflags = case enable_spec of
                                    EnableByteCode -> dflags { backend = bytecodeBackend }
                                    EnableObject   -> dflags { backend = defaultBackendOf ms }
                                    EnableByteCodeAndObject -> (gopt_set dflags Opt_ByteCodeAndObjectCode) { backend = defaultBackendOf ms}
                 let ms' = ms
                       { ms_location =
                           ms_location { ml_hi_file_ospath = hi_file
                                       , ml_obj_file_ospath = o_file
                                       , ml_dyn_hi_file_ospath = dyn_hi_file
                                       , ml_dyn_obj_file_ospath = dyn_o_file }
                       , ms_hspp_opts = updOptLevel 0 $ new_dflags
                       }
                 -- Recursive call to catch the other cases
                 enable_code_gen_ms 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
           | bytecode_and_enable enable_spec ms -> do
                 let ms' = ms
                       { ms_hspp_opts = gopt_set (ms_hspp_opts ms) Opt_ByteCodeAndObjectCode
                       }
                 -- Recursive call to catch the other cases
                 enable_code_gen_ms ms'
           | dynamic_too_enable enable_spec ms -> do
                 let ms' = ms
                       { ms_hspp_opts = gopt_set (ms_hspp_opts ms) Opt_BuildDynamicToo
                       }
                 -- Recursive call to catch the other cases
                 enable_code_gen_ms ms'
           | ext_interp_enable ms -> do
                 let ms' = ms
                       { ms_hspp_opts = gopt_set (ms_hspp_opts ms) Opt_ExternalInterpreter
                       }
                 -- Recursive call to catch the other cases
                 enable_code_gen_ms ms'
  
           | needs_full_ways dflags -> do
                 let ms' = ms { ms_hspp_opts = set_full_ways dflags }
                 -- Recursive call to catch the other cases
                 enable_code_gen_ms ms'
  
           | otherwise -> return ms
  
      enable_code_gen_ms ms = return ms
  
      nocode_enable ms@(ModSummary { ms_hspp_opts = dflags }) =
        not (backendGeneratesCode (backend dflags)) &&
        -- Don't enable codegen for TH on indefinite packages; we
        -- can't compile anything anyway! See #16219.
        isHomeUnitDefinite (ue_unitHomeUnit (ms_unitid ms) unit_env)
  
      bytecode_and_enable enable_spec ms =
        -- In the situation where we **would** need to enable dynamic-too
        -- IF we had decided we needed objects
        dynamic_too_enable EnableObject ms
          -- but we prefer to use bytecode rather than objects
          && prefer_bytecode
          -- and we haven't already turned it on
          && not generate_both
        where
          lcl_dflags   = ms_hspp_opts ms
          prefer_bytecode = case enable_spec of
                              EnableByteCodeAndObject -> True
                              EnableByteCode -> True
                              EnableObject -> False
  
          generate_both   = gopt Opt_ByteCodeAndObjectCode 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.
      -- FIXME: Duplicated from makeDynFlagsConsistent
      dynamic_too_enable enable_spec ms
        | sTargetRTSLinkerOnlySupportsSharedLibs $ settings lcl_dflags =
            not isDynWay && not dyn_too_enabled
              && enable_object
        | otherwise =
            hostIsDynamic && not hostIsProfiled && internalInterpreter &&
              not isDynWay && not isProfWay &&  not dyn_too_enabled
                && enable_object
        where
         lcl_dflags   = ms_hspp_opts ms
         internalInterpreter = not (gopt Opt_ExternalInterpreter lcl_dflags)
         dyn_too_enabled = gopt Opt_BuildDynamicToo lcl_dflags
         isDynWay    = hasWay (ways lcl_dflags) WayDyn
         isProfWay   = hasWay (ways lcl_dflags) WayProf
         enable_object = case enable_spec of
                              EnableByteCode -> False
                              EnableByteCodeAndObject -> True
                              EnableObject -> 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 ms = not ghciSupported && internalInterpreter
        where
         lcl_dflags   = ms_hspp_opts ms
         internalInterpreter = not (gopt Opt_ExternalInterpreter lcl_dflags)
  
  
      mg = mkModuleGraph mod_graph
  
      (td_map, lookup_node) = mkStageDeps mod_graph
  
      queryReachable ns = isReachableMany td_map (mapMaybe lookup_node ns)
  
      -- NB: Do not inline these, it is very important to share them across all calls
      -- to needs_obj_set and needs_bc_set.
      !query_obj =
        let !deps = queryReachable need_obj_set
        in \k -> deps (expectJust $ lookup_node k)
  
      !query_bc  =
        let !deps = queryReachable need_bc_set
        in \k -> deps (expectJust $ lookup_node k)
  
      -- The direct dependencies of modules which require object code
      need_obj_set =
  
          -- Note we don't need object code for a module if it uses TemplateHaskell itself. Only
          -- it's dependencies.
          [ (mkNodeKey m, RunStage)
          | m@(ModuleNode _deps (ModuleNodeCompile ms)) <- mod_graph
          , isTemplateHaskellOrQQNonBoot ms
          , not (gopt Opt_UseBytecodeRatherThanObjects (ms_hspp_opts ms))
          ]
  
      -- The direct dependencies of modules which require byte code
      need_bc_set =
          [ (mkNodeKey m, RunStage)
          | m@(ModuleNode _deps (ModuleNodeCompile ms)) <- mod_graph
          , isTemplateHaskellOrQQNonBoot ms
          , gopt Opt_UseBytecodeRatherThanObjects (ms_hspp_opts ms)
          ]
  
      needs_obj_set, needs_bc_set :: ModNodeKeyWithUid -> Bool
      needs_obj_set k = query_obj (NodeKey_Module k, CompileStage)
  
      needs_bc_set k = query_bc  (NodeKey_Module k, CompileStage)
  
      -- A map which tells us how to enable code generation for a NodeKey
      needs_codegen_map :: ModSummary -> Maybe CodeGenEnable
      needs_codegen_map ms =
        let nk = msKey ms
  
  
        -- Another option here would be to just produce object code, rather than both object and
        -- byte code
        in case (needs_obj_set nk, needs_bc_set nk) of
          (True, True)   -> Just EnableByteCodeAndObject
          (True, False)  -> Just EnableObject
          (False, True)  -> Just EnableByteCode
          (False, False) -> Nothing
  
      -- FIXME: Duplicated from makeDynFlagsConsistent
      needs_full_ways dflags
        = ghcLink dflags == LinkInMemory &&
          not (gopt Opt_ExternalInterpreter dflags) &&
          targetWays_ dflags /= hostFullWays
      set_full_ways dflags =
          let platform = targetPlatform dflags
              dflags_a = dflags { targetWays_ = hostFullWays }
              dflags_b = foldl gopt_set dflags_a
                       $ concatMap (wayGeneralFlags platform)
                                   hostFullWays
              dflags_c = foldl gopt_unset dflags_b
                       $ concatMap (wayUnsetGeneralFlags platform)
                                   hostFullWays
          in dflags_c
  
  {- 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, there would be no need for -fwrite-interface as it
  would 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.
  
  Explicit Level Imports
  ~~~~~~~~~~~~~~~~~~~~~~
  When `-XExplicitLevelImports` is enabled, code is only generated for modules
  needed for the compile stage. The ReachabilityIndex created by `mkStageDeps` answers
  the question, if I compile a module for a specific stage, then which modules at
  other stages do I need. The roots of this query are the modules which use `TemplateHaskell`
  at the runtime stage, and modules we need code generation for are those which
  are needed at the compile time stage. All the logic about how ExplicitLevelImports
  and TemplateHaskell affect the needed stages of a module is encoded in mkStageDeps.
  
  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 (for dynamically linked compilers) Fix it. (The needed way is 'hostFullWays')
  * 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.
  -}
  
  -- | Populate the Downsweep cache with the root modules.
  mkRootMap
    :: [ModuleNodeInfo]
    -> DownsweepCache
  mkRootMap summaries = Map.fromListWith (flip (++))
    [ ((moduleNodeInfoUnitId s, NoPkgQual, moduleNodeInfoMnwib s), [Right s]) | s <- 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 hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf
          -- we can use a cached summary if one is available and the
          -- source file hasn't changed,
     | Just old_summary <- M.lookup (homeUnitId home_unit, src_fn) old_summaries
     = do
          let location = ms_location $ old_summary
  
          src_hash <- 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
          checkSummaryHash
              hsc_env (new_summary src_fn)
              old_summary location src_hash
  
     | otherwise
     = do src_hash <- get_src_hash
          new_summary src_fn src_hash
    where
      -- change the main active unit so all operations happen relative to the given unit
      hsc_env = hscSetActiveHomeUnit home_unit 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 = case maybe_buf of
                        Just (buf,_) -> return $ fingerprintStringBuffer buf
                        Nothing -> liftIO $ getFileHash src_fn
  
      new_summary src_fn src_hash = runExceptT $ do
          preimps@PreprocessedImports {..}
              <- getPreprocessedImports hsc_env src_fn mb_phase maybe_buf
  
          let fopts = initFinderOpts (hsc_dflags hsc_env)
              (basename, extension) = splitExtension src_fn
  
              hsc_src
                | isHaskellSigSuffix (drop 1 extension) = HsigFile
                | isHaskellBootSuffix (drop 1 extension) = HsBootFile
                | otherwise = HsSrcFile
  
              -- Make a ModLocation for this file, adding the @-boot@ suffix to
              -- all paths if the original was a boot file.
              location = mkHomeModLocation fopts pi_mod_name (unsafeEncodeUtf basename) (unsafeEncodeUtf extension) hsc_src
  
          -- 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
          mod <- liftIO $ do
            let home_unit = hsc_home_unit hsc_env
            let fc        = hsc_FC hsc_env
            addHomeModuleToFinder fc home_unit pi_mod_name location hsc_src
  
          liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary
              { nms_src_fn = src_fn
              , nms_src_hash = src_hash
              , nms_hsc_src = hsc_src
              , nms_location = location
              , nms_mod = mod
              , nms_preimps = preimps
              }
  
  checkSummaryHash
      :: HscEnv
      -> (Fingerprint -> IO (Either e ModSummary))
      -> ModSummary -> ModLocation -> Fingerprint
      -> IO (Either e ModSummary)
  checkSummaryHash
    hsc_env new_summary
    old_summary
    location src_hash
    | ms_hs_hash old_summary == src_hash &&
        not (gopt Opt_ForceRecomp (hsc_dflags hsc_env)) = do
             -- update the object-file timestamp
             obj_timestamp <- modificationTimeIfExists (ml_obj_file 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.
             let fc      = hsc_FC hsc_env
                 mod     = ms_mod old_summary
                 hsc_src = ms_hsc_src old_summary
             addModuleToFinder fc mod location hsc_src
  
             hi_timestamp <- modificationTimeIfExists (ml_hi_file location)
             hie_timestamp <- modificationTimeIfExists (ml_hie_file location)
  
             return $ Right
               ( old_summary
                       { ms_obj_date = obj_timestamp
                       , ms_iface_date = hi_timestamp
                       , ms_hie_date = hie_timestamp
                       }
               )
  
     | otherwise =
             -- source changed: re-summarise.
             new_summary src_hash
  
  data SummariseResult =
          FoundInstantiation InstantiatedUnit
        | FoundHomeWithError (UnitId, DriverMessages)
        | FoundHome ModuleNodeInfo
        | External UnitId
        | NotThere
  
  -- | summariseModule finds the location of the source file for the given module.
  -- This version always returns a ModuleNodeCompile node, it is useful for
  -- --make mode.
  summariseModule :: HscEnv
                  -> HomeUnit
                  -> M.Map (UnitId, FilePath) ModSummary
                  -> IsBootInterface
                  -> Located ModuleName
                  -> PkgQual
                  -> Maybe (StringBuffer, UTCTime)
                  -> [ModuleName]
                  -> IO SummariseResult
  summariseModule hsc_env home_unit old_summaries is_boot wanted_mod mb_pkg maybe_buf excl_mods =
    summariseModuleDispatch k hsc_env home_unit is_boot wanted_mod mb_pkg excl_mods
    where
      k = summariseModuleWithSource home_unit old_summaries is_boot maybe_buf
  
  
  -- | Like summariseModule but for interface files that we don't want to compile.
  -- This version always returns a ModuleNodeFixed node.
  summariseModuleInterface :: HscEnv
                          -> HomeUnit
                          -> IsBootInterface
                          -> Located ModuleName
                          -> PkgQual
                          -> [ModuleName]
                          -> IO SummariseResult
  summariseModuleInterface hsc_env home_unit is_boot wanted_mod mb_pkg excl_mods =
    summariseModuleDispatch k hsc_env home_unit is_boot wanted_mod mb_pkg excl_mods
    where
      k _hsc_env loc mod = do
        -- The finder will return a path to the .hi-boot even if it doesn't actually
        -- exist. So check if it exists first before concluding it's there.
        does_exist <- doesFileExist (ml_hi_file loc)
        if does_exist
          then let key = moduleToMnk mod is_boot
               in return $ FoundHome (ModuleNodeFixed key loc)
          else return NotThere
  
  
  
  -- Summarise a module, and pick up source and timestamp.
  summariseModuleDispatch
            :: (HscEnv -> ModLocation -> Module -> IO SummariseResult) -- ^ Continuation about how to summarise a home module.
            -> HscEnv
            -> HomeUnit
            -> IsBootInterface    -- True <=> a {-# SOURCE #-} import
            -> Located ModuleName -- Imported module to be summarised
            -> PkgQual
            -> [ModuleName]               -- Modules to exclude
            -> IO SummariseResult
  
  
  summariseModuleDispatch k hsc_env' home_unit is_boot (L _ wanted_mod) mb_pkg excl_mods
    | wanted_mod `elem` excl_mods
    = return NotThere
    | otherwise  = find_it
    where
      -- Temporarily change the currently active home unit so all operations
      -- happen relative to it
      hsc_env   = hscSetActiveHomeUnit home_unit hsc_env'
  
      find_it :: IO SummariseResult
  
      find_it = do
          found <- findImportedModuleWithIsBoot hsc_env wanted_mod is_boot mb_pkg
          case found of
               Found location mod
                  | moduleUnitId mod `Set.member` hsc_all_home_unit_ids hsc_env ->
                          -- Home package
                           k hsc_env location mod
                  | VirtUnit iud <- moduleUnit mod
                  , not (isHomeModule home_unit mod)
                    -> return $ FoundInstantiation iud
                  | otherwise -> return $ External (moduleUnitId mod)
               _ -> return NotThere
                          -- Not found
                          -- (If it is TRULY not found at all, we'll
                          -- error when we actually try to compile)
  
  
  -- | The continuation to summarise a home module if we want to find the source file
  -- for it and potentially compile it.
  summariseModuleWithSource
            :: HomeUnit
            -> M.Map (UnitId, FilePath) ModSummary
            -- ^ Map of old summaries
            -> IsBootInterface    -- True <=> a {-# SOURCE #-} import
            -> Maybe (StringBuffer, UTCTime)
            -> HscEnv
            -> ModLocation
            -> Module
            -> IO SummariseResult
  summariseModuleWithSource home_unit old_summary_map is_boot maybe_buf hsc_env location mod = do
          -- Adjust location to point to the hs-boot source file,
          -- hi file, object file, when is_boot says so
          let src_fn = expectJust (ml_hs_file location)
  
                  -- Check that it exists
                  -- It might have been deleted since the Finder last found it
          maybe_h <- fileHashIfExists src_fn
          case maybe_h of
            -- This situation can also happen if we have found the .hs file but the
            -- .hs-boot file doesn't exist.
            Nothing -> return NotThere
            Just h  -> do
              fresult <- new_summary_cache_check location mod src_fn h
              return $ case fresult of
                Left err -> FoundHomeWithError (moduleUnitId mod, err)
                Right ms -> FoundHome (ModuleNodeCompile ms)
  
    where
      dflags    = hsc_dflags hsc_env
      new_summary_cache_check loc mod src_fn h
        | Just old_summary <- Map.lookup ((toUnitId (moduleUnit mod), src_fn)) 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_buf of
             Just (buf,_) ->
                 checkSummaryHash hsc_env (new_summary loc mod src_fn) old_summary loc (fingerprintStringBuffer buf)
             Nothing    ->
                 checkSummaryHash hsc_env (new_summary loc mod src_fn) old_summary loc h
        | otherwise = new_summary loc mod src_fn h
  
      new_summary :: ModLocation
                    -> Module
                    -> FilePath
                    -> Fingerprint
                    -> IO (Either DriverMessages ModSummary)
      new_summary location mod src_fn src_hash
        = runExceptT $ do
          preimps@PreprocessedImports {..}
              -- Remember to set the active unit here, otherwise the wrong include paths are passed to CPP
              -- See multiHomeUnits_cpp2 test
              <- getPreprocessedImports (hscSetActiveUnitId (moduleUnitId mod) hsc_env) src_fn Nothing 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
                | is_boot == IsBoot           = HsBootFile
                | isHaskellSigFilename src_fn = HsigFile
                | otherwise                   = HsSrcFile
  
          when (pi_mod_name /= moduleName mod) $
                  throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc
                         $ DriverFileModuleNameMismatch pi_mod_name (moduleName mod)
  
          let instantiations = homeUnitInstantiations home_unit
          when (hsc_src == HsigFile && isNothing (lookup pi_mod_name instantiations)) $
              throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc
                     $ DriverUnexpectedSignature pi_mod_name (checkBuildingCabalPackage dflags) instantiations
  
          liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary
              { nms_src_fn = src_fn
              , nms_src_hash = src_hash
              , nms_hsc_src = hsc_src
              , nms_location = location
              , nms_mod = mod
              , nms_preimps = preimps
              }
  
  -- | Convenience named arguments for 'makeNewModSummary' only used to make
  -- code more readable, not exported.
  data MakeNewModSummary
    = MakeNewModSummary
        { nms_src_fn :: FilePath
        , nms_src_hash :: Fingerprint
        , nms_hsc_src :: HscSource
        , nms_location :: ModLocation
        , nms_mod :: Module
        , nms_preimps :: PreprocessedImports
        }
  
  makeNewModSummary :: HscEnv -> MakeNewModSummary -> IO ModSummary
  makeNewModSummary hsc_env MakeNewModSummary{..} = do
    let PreprocessedImports{..} = nms_preimps
    obj_timestamp <- modificationTimeIfExists (ml_obj_file nms_location)
    dyn_obj_timestamp <- modificationTimeIfExists (ml_dyn_obj_file nms_location)
    hi_timestamp <- modificationTimeIfExists (ml_hi_file nms_location)
    hie_timestamp <- modificationTimeIfExists (ml_hie_file nms_location)
    bytecode_timestamp <- modificationTimeIfExists (ml_bytecode_file nms_location)
    extra_sig_imports <- findExtraSigImports hsc_env nms_hsc_src pi_mod_name
    (implicit_sigs, _inst_deps) <- implicitRequirementsShallow (hscSetActiveUnitId (moduleUnitId nms_mod) hsc_env) pi_theimps
  
    return $
          ModSummary
          { ms_mod = nms_mod
          , ms_hsc_src = nms_hsc_src
          , ms_location = nms_location
          , ms_hspp_file = pi_hspp_fn
          , ms_hspp_opts = pi_local_dflags
          , ms_hspp_buf  = Just pi_hspp_buf
          , ms_parsed_mod = Nothing
          , ms_srcimps = pi_srcimps
          , ms_textual_imps =
              ((,,) NormalLevel NoPkgQual . noLoc <$> extra_sig_imports) ++
              ((,,) NormalLevel NoPkgQual . noLoc <$> implicit_sigs) ++
              pi_theimps
          , ms_hs_hash = nms_src_hash
          , ms_iface_date = hi_timestamp
          , ms_hie_date = hie_timestamp
          , ms_obj_date = obj_timestamp
          , ms_dyn_obj_date = dyn_obj_timestamp
          , ms_bytecode_date = bytecode_timestamp
          }
  
  data PreprocessedImports
    = PreprocessedImports
        { pi_local_dflags :: DynFlags
        , pi_srcimps  :: [Located ModuleName]
        , pi_theimps  :: [(ImportLevel, PkgQual, Located ModuleName)]
        , pi_hspp_fn  :: FilePath
        , pi_hspp_buf :: StringBuffer
        , pi_mod_name_loc :: SrcSpan
        , 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 hsc_env src_fn mb_phase maybe_buf = do
    (pi_local_dflags, pi_hspp_fn)
        <- ExceptT $ preprocess hsc_env src_fn (fst <$> maybe_buf) mb_phase
    pi_hspp_buf <- liftIO $ hGetStringBuffer pi_hspp_fn
    (pi_srcimps', pi_theimps', L pi_mod_name_loc pi_mod_name)
        <- ExceptT $ do
            let imp_prelude = xopt LangExt.ImplicitPrelude pi_local_dflags
                popts = initParserOpts pi_local_dflags
                sec = initSourceErrorContext pi_local_dflags
            mimps <- getImports popts sec imp_prelude pi_hspp_buf pi_hspp_fn src_fn
            return (first (mkMessages . fmap mkDriverPsHeaderMessage . getMessages) mimps)
    let rn_pkg_qual = renameRawPkgQual (hsc_unit_env hsc_env)
    let rn_imps = fmap (\(sp, pk, lmn@(L _ mn)) -> (sp, rn_pkg_qual mn pk, lmn))
    let pi_srcimps = pi_srcimps'
    let pi_theimps = rn_imps pi_theimps'
    return PreprocessedImports {..}
  