    {-# LANGUAGE CPP #-}

    module GHC.Driver.Env
       ( Hsc(..)
       , HscEnv (..)
       , hsc_home_unit
       , hsc_units
       , runHsc
       , mkInteractiveHscEnv
       , runInteractiveHsc
       , hscEPS
       , hptCompleteSigs
       , hptInstances
       , hptAnns
       , hptAllThings
       , hptSomeThingsBelowUs
       , hptRules
       , prepareAnnotations
       , lookupType
       , lookupIfaceByModule
       , mainModIs
       )
    where

    #include "HsVersions.h"

    import GHC.Prelude

    import GHC.Driver.Ppr
    import GHC.Driver.Session
    import GHC.Driver.Errors ( printOrThrowWarnings )

    import GHC.Runtime.Context
    import GHC.Driver.Env.Types ( Hsc(..), HscEnv(..) )

    import GHC.Unit
    import GHC.Unit.Module.ModGuts
    import GHC.Unit.Module.ModIface
    import GHC.Unit.Module.ModDetails
    import GHC.Unit.Module.Deps
    import GHC.Unit.Home.ModInfo
    import GHC.Unit.Env
    import GHC.Unit.External

    import GHC.Core         ( CoreRule )
    import GHC.Core.FamInstEnv
    import GHC.Core.InstEnv ( ClsInst )

    import GHC.Types.Annotations ( Annotation, AnnEnv, mkAnnEnv, plusAnnEnv )
    import GHC.Types.CompleteMatch
    import GHC.Types.Name
    import GHC.Types.Name.Env
    import GHC.Types.TyThing

    import GHC.Builtin.Names ( gHC_PRIM )

    import GHC.Data.Maybe
    import GHC.Data.Bag

    import GHC.Utils.Outputable
    import GHC.Utils.Monad
    import GHC.Utils.Panic
    import GHC.Utils.Misc

    import Control.Monad    ( guard )
    import Data.IORef

    runHsc :: HscEnv -> Hsc a -> IO a
    runHsc :: forall a. HscEnv -> Hsc a -> IO a
    runHsc HscEnv
    hsc_env (Hsc HscEnv -> WarningMessages -> IO (a, WarningMessages)
    hsc) = do
        (a
    a, WarningMessages
    w) <- HscEnv -> WarningMessages -> IO (a, WarningMessages)
    hsc HscEnv
    hsc_env forall a. Bag a
    emptyBag
        Logger -> DynFlags -> WarningMessages -> IO ()
    printOrThrowWarnings (HscEnv -> Logger
    hsc_logger HscEnv
    hsc_env) (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env) WarningMessages
    w
        forall (m :: * -> *) a. Monad m => a -> m a
    return a
    a

    -- | Switches in the DynFlags and Plugins from the InteractiveContext
    mkInteractiveHscEnv :: HscEnv -> HscEnv
    mkInteractiveHscEnv :: HscEnv -> HscEnv
    mkInteractiveHscEnv HscEnv
    hsc_env =
        let ic :: InteractiveContext
    ic = HscEnv -> InteractiveContext
    hsc_IC HscEnv
    hsc_env
        in HscEnv
    hsc_env { hsc_dflags :: DynFlags
    hsc_dflags  = InteractiveContext -> DynFlags
    ic_dflags  InteractiveContext
    ic
                   , hsc_plugins :: [LoadedPlugin]
    hsc_plugins = InteractiveContext -> [LoadedPlugin]
    ic_plugins InteractiveContext
    ic
                   }

    -- | A variant of runHsc that switches in the DynFlags and Plugins from the
    -- InteractiveContext before running the Hsc computation.
    runInteractiveHsc :: HscEnv -> Hsc a -> IO a
    runInteractiveHsc :: forall a. HscEnv -> Hsc a -> IO a
    runInteractiveHsc HscEnv
    hsc_env = forall a. HscEnv -> Hsc a -> IO a
    runHsc (HscEnv -> HscEnv
    mkInteractiveHscEnv HscEnv
    hsc_env)

    hsc_home_unit :: HscEnv -> HomeUnit
    hsc_home_unit :: HscEnv -> HomeUnit
    hsc_home_unit = UnitEnv -> HomeUnit
    ue_home_unit forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HscEnv -> UnitEnv
    hsc_unit_env

    hsc_units :: HscEnv -> UnitState
    hsc_units :: HscEnv -> UnitState
    hsc_units = UnitEnv -> UnitState
    ue_units forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HscEnv -> UnitEnv
    hsc_unit_env

    {-

    Note [Target code interpreter]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    Template Haskell and GHCi use an interpreter to execute code that is built for
    the compiler target platform (= code host platform) on the compiler host
    platform (= code build platform).

    The internal interpreter can be used when both platforms are the same and when
    the built code is compatible with the compiler itself (same way, etc.). This
    interpreter is not always available: for instance stage1 compiler doesn't have
    it because there might be an ABI mismatch between the code objects (built by
    stage1 compiler) and the stage1 compiler itself (built by stage0 compiler).

    In most cases, an external interpreter can be used instead: it runs in a
    separate process and it communicates with the compiler via a two-way message
    passing channel. The process is lazily spawned to avoid overhead when it is not
    used.

    The target code interpreter to use can be selected per session via the
    `hsc_interp` field of `HscEnv`. There may be no interpreter available at all, in
    which case Template Haskell and GHCi will fail to run. The interpreter to use is
    configured via command-line flags (in `GHC.setSessionDynFlags`).

    -}

    -- Note [hsc_type_env_var hack]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -- hsc_type_env_var is used to initialize tcg_type_env_var, and
    -- eventually it is the mutable variable that is queried from
    -- if_rec_types to get a TypeEnv.  So, clearly, it's something
    -- related to knot-tying (see Note [Tying the knot]).
    -- hsc_type_env_var is used in two places: initTcRn (where
    -- it initializes tcg_type_env_var) and initIfaceCheck
    -- (where it initializes if_rec_types).
    --
    -- But why do we need a way to feed a mutable variable in?  Why
    -- can't we just initialize tcg_type_env_var when we start
    -- typechecking?  The problem is we need to knot-tie the
    -- EPS, and we may start adding things to the EPS before type
    -- checking starts.
    --
    -- Here is a concrete example. Suppose we are running
    -- "ghc -c A.hs", and we have this file system state:
    --
    --  A.hs-boot   A.hi-boot **up to date**
    --  B.hs        B.hi      **up to date**
    --  A.hs        A.hi      **stale**
    --
    -- The first thing we do is run checkOldIface on A.hi.
    -- checkOldIface will call loadInterface on B.hi so it can
    -- get its hands on the fingerprints, to find out if A.hi
    -- needs recompilation.  But loadInterface also populates
    -- the EPS!  And so if compilation turns out to be necessary,
    -- as it is in this case, the thunks we put into the EPS for
    -- B.hi need to have the correct if_rec_types mutable variable
    -- to query.
    --
    -- If the mutable variable is only allocated WHEN we start
    -- typechecking, then that's too late: we can't get the
    -- information to the thunks.  So we need to pre-commit
    -- to a type variable in 'hscIncrementalCompile' BEFORE we
    -- check the old interface.
    --
    -- This is all a massive hack because arguably checkOldIface
    -- should not populate the EPS. But that's a refactor for
    -- another day.

    -- | Retrieve the ExternalPackageState cache.
    hscEPS :: HscEnv -> IO ExternalPackageState
    hscEPS :: HscEnv -> IO ExternalPackageState
    hscEPS HscEnv
    hsc_env = forall a. IORef a -> IO a
    readIORef (HscEnv -> IORef ExternalPackageState
    hsc_EPS HscEnv
    hsc_env)

    hptCompleteSigs :: HscEnv -> [CompleteMatch]
    hptCompleteSigs :: HscEnv -> [CompleteMatch]
    hptCompleteSigs = forall a. (HomeModInfo -> [a]) -> HscEnv -> [a]
    hptAllThings  (ModDetails -> [CompleteMatch]
    md_complete_matches forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HomeModInfo -> ModDetails
    hm_details)

    -- | Find all the instance declarations (of classes and families) from
    -- the Home Package Table filtered by the provided predicate function.
    -- Used in @tcRnImports@, to select the instances that are in the
    -- transitive closure of imports from the currently compiled module.
    hptInstances :: HscEnv -> (ModuleName -> Bool) -> ([ClsInst], [FamInst])
    hptInstances :: HscEnv -> (ModuleName -> Bool) -> ([ClsInst], [FamInst])
    hptInstances HscEnv
    hsc_env ModuleName -> Bool
    want_this_module
      = let ([[ClsInst]]
    insts, [[FamInst]]
    famInsts) = forall a b. [(a, b)] -> ([a], [b])
    unzip forall a b. (a -> b) -> a -> b
    $ forall a b c. (a -> b -> c) -> b -> a -> c
    flip forall a. (HomeModInfo -> [a]) -> HscEnv -> [a]
    hptAllThings HscEnv
    hsc_env forall a b. (a -> b) -> a -> b
    $ \HomeModInfo
    mod_info -> do
                    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (ModuleName -> Bool
    want_this_module (forall unit. GenModule unit -> ModuleName
    moduleName (forall (phase :: ModIfacePhase). ModIface_ phase -> Module
    mi_module (HomeModInfo -> ModIface
    hm_iface HomeModInfo
    mod_info))))
                    let details :: ModDetails
    details = HomeModInfo -> ModDetails
    hm_details HomeModInfo
    mod_info
                    forall (m :: * -> *) a. Monad m => a -> m a
    return (ModDetails -> [ClsInst]
    md_insts ModDetails
    details, ModDetails -> [FamInst]
    md_fam_insts ModDetails
    details)
        in (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[ClsInst]]
    insts, forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[FamInst]]
    famInsts)

    -- | Get rules from modules "below" this one (in the dependency sense)
    hptRules :: HscEnv -> [ModuleNameWithIsBoot] -> [CoreRule]
    hptRules :: HscEnv -> [ModuleNameWithIsBoot] -> [CoreRule]
    hptRules = forall a.
    (HomeModInfo -> [a])
    -> Bool -> HscEnv -> [ModuleNameWithIsBoot] -> [a]
    hptSomeThingsBelowUs (ModDetails -> [CoreRule]
    md_rules forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HomeModInfo -> ModDetails
    hm_details) Bool
    False

    -- | Get annotations from modules "below" this one (in the dependency sense)
    hptAnns :: HscEnv -> Maybe [ModuleNameWithIsBoot] -> [Annotation]
    hptAnns :: HscEnv -> Maybe [ModuleNameWithIsBoot] -> [Annotation]
    hptAnns HscEnv
    hsc_env (Just [ModuleNameWithIsBoot]
    deps) = forall a.
    (HomeModInfo -> [a])
    -> Bool -> HscEnv -> [ModuleNameWithIsBoot] -> [a]
    hptSomeThingsBelowUs (ModDetails -> [Annotation]
    md_anns forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HomeModInfo -> ModDetails
    hm_details) Bool
    False HscEnv
    hsc_env [ModuleNameWithIsBoot]
    deps
    hptAnns HscEnv
    hsc_env Maybe [ModuleNameWithIsBoot]
    Nothing = forall a. (HomeModInfo -> [a]) -> HscEnv -> [a]
    hptAllThings (ModDetails -> [Annotation]
    md_anns forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HomeModInfo -> ModDetails
    hm_details) HscEnv
    hsc_env

    hptAllThings :: (HomeModInfo -> [a]) -> HscEnv -> [a]
    hptAllThings :: forall a. (HomeModInfo -> [a]) -> HscEnv -> [a]
    hptAllThings HomeModInfo -> [a]
    extract HscEnv
    hsc_env = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap HomeModInfo -> [a]
    extract (HomePackageTable -> [HomeModInfo]
    eltsHpt (HscEnv -> HomePackageTable
    hsc_HPT HscEnv
    hsc_env))

    -- | Get things from modules "below" this one (in the dependency sense)
    -- C.f Inst.hptInstances
    hptSomeThingsBelowUs :: (HomeModInfo -> [a]) -> Bool -> HscEnv -> [ModuleNameWithIsBoot] -> [a]
    hptSomeThingsBelowUs :: forall a.
    (HomeModInfo -> [a])
    -> Bool -> HscEnv -> [ModuleNameWithIsBoot] -> [a]
    hptSomeThingsBelowUs HomeModInfo -> [a]
    extract Bool
    include_hi_boot HscEnv
    hsc_env [ModuleNameWithIsBoot]
    deps
      | GhcMode -> Bool
    isOneShot (DynFlags -> GhcMode
    ghcMode (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env)) = []

      | Bool
    otherwise
      = let hpt :: HomePackageTable
    hpt = HscEnv -> HomePackageTable
    hsc_HPT HscEnv
    hsc_env
        in
        [ a
    thing
        |   -- Find each non-hi-boot module below me
          GWIB { gwib_mod :: forall mod. GenWithIsBoot mod -> mod
    gwib_mod = ModuleName
    mod, gwib_isBoot :: forall mod. GenWithIsBoot mod -> IsBootInterface
    gwib_isBoot = IsBootInterface
    is_boot } <- [ModuleNameWithIsBoot]
    deps
        , Bool
    include_hi_boot Bool -> Bool -> Bool
    || (IsBootInterface
    is_boot forall a. Eq a => a -> a -> Bool
    == IsBootInterface
    NotBoot)

            -- unsavoury: when compiling the base package with --make, we
            -- sometimes try to look up RULES etc for GHC.Prim. GHC.Prim won't
            -- be in the HPT, because we never compile it; it's in the EPT
            -- instead. ToDo: clean up, and remove this slightly bogus filter:
        , ModuleName
    mod forall a. Eq a => a -> a -> Bool
    /= forall unit. GenModule unit -> ModuleName
    moduleName Module
    gHC_PRIM

            -- Look it up in the HPT
        , let things :: [a]
    things = case HomePackageTable -> ModuleName -> Maybe HomeModInfo
    lookupHpt HomePackageTable
    hpt ModuleName
    mod of
                        Just HomeModInfo
    info -> HomeModInfo -> [a]
    extract HomeModInfo
    info
                        Maybe HomeModInfo
    Nothing -> forall a. String -> SDoc -> a -> a
    pprTrace String
    "WARNING in hptSomeThingsBelowUs" SDoc
    msg []
              msg :: SDoc
    msg = [SDoc] -> SDoc
    vcat [String -> SDoc
    text String
    "missing module" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr ModuleName
    mod,
                          String -> SDoc
    text String
    "Probable cause: out-of-date interface files"]
                            -- This really shouldn't happen, but see #962

            -- And get its dfuns
        , a
    thing <- [a]
    things ]

    -- | Deal with gathering annotations in from all possible places
    --   and combining them into a single 'AnnEnv'
    prepareAnnotations :: HscEnv -> Maybe ModGuts -> IO AnnEnv
    prepareAnnotations :: HscEnv -> Maybe ModGuts -> IO AnnEnv
    prepareAnnotations HscEnv
    hsc_env Maybe ModGuts
    mb_guts = do
        ExternalPackageState
    eps <- HscEnv -> IO ExternalPackageState
    hscEPS HscEnv
    hsc_env
        let -- Extract annotations from the module being compiled if supplied one
            mb_this_module_anns :: Maybe AnnEnv
    mb_this_module_anns = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([Annotation] -> AnnEnv
    mkAnnEnv forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModGuts -> [Annotation]
    mg_anns) Maybe ModGuts
    mb_guts
            -- Extract dependencies of the module if we are supplied one,
            -- otherwise load annotations from all home package table
            -- entries regardless of dependency ordering.
            home_pkg_anns :: AnnEnv
    home_pkg_anns  = ([Annotation] -> AnnEnv
    mkAnnEnv forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HscEnv -> Maybe [ModuleNameWithIsBoot] -> [Annotation]
    hptAnns HscEnv
    hsc_env) forall a b. (a -> b) -> a -> b
    $ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Dependencies -> [ModuleNameWithIsBoot]
    dep_mods forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModGuts -> Dependencies
    mg_deps) Maybe ModGuts
    mb_guts
            other_pkg_anns :: AnnEnv
    other_pkg_anns = ExternalPackageState -> AnnEnv
    eps_ann_env ExternalPackageState
    eps
            ann_env :: AnnEnv
    ann_env        = forall a. (a -> a -> a) -> [a] -> a
    foldl1' AnnEnv -> AnnEnv -> AnnEnv
    plusAnnEnv forall a b. (a -> b) -> a -> b
    $ forall a. [Maybe a] -> [a]
    catMaybes [Maybe AnnEnv
    mb_this_module_anns,
                                                             forall a. a -> Maybe a
    Just AnnEnv
    home_pkg_anns,
                                                             forall a. a -> Maybe a
    Just AnnEnv
    other_pkg_anns]
        forall (m :: * -> *) a. Monad m => a -> m a
    return AnnEnv
    ann_env

    -- | Find the 'TyThing' for the given 'Name' by using all the resources
    -- at our disposal: the compiled modules in the 'HomePackageTable' and the
    -- compiled modules in other packages that live in 'PackageTypeEnv'. Note
    -- that this does NOT look up the 'TyThing' in the module being compiled: you
    -- have to do that yourself, if desired
    lookupType :: HscEnv -> Name -> IO (Maybe TyThing)
    lookupType :: HscEnv -> Name -> IO (Maybe TyThing)
    lookupType HscEnv
    hsc_env Name
    name = do
       ExternalPackageState
    eps <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ forall a. IORef a -> IO a
    readIORef (HscEnv -> IORef ExternalPackageState
    hsc_EPS HscEnv
    hsc_env)
       let pte :: PackageTypeEnv
    pte = ExternalPackageState -> PackageTypeEnv
    eps_PTE ExternalPackageState
    eps
           hpt :: HomePackageTable
    hpt = HscEnv -> HomePackageTable
    hsc_HPT HscEnv
    hsc_env

           mod :: Module
    mod = ASSERT2( isExternalName name, ppr name )
                 if Name -> Bool
    isHoleName Name
    name
                   then HomeUnit -> ModuleName -> Module
    mkHomeModule (HscEnv -> HomeUnit
    hsc_home_unit HscEnv
    hsc_env) (forall unit. GenModule unit -> ModuleName
    moduleName (HasDebugCallStack => Name -> Module
    nameModule Name
    name))
                   else HasDebugCallStack => Name -> Module
    nameModule Name
    name

           !ty :: Maybe TyThing
    ty = if GhcMode -> Bool
    isOneShot (DynFlags -> GhcMode
    ghcMode (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env))
                   -- in one-shot, we don't use the HPT
                   then forall a. NameEnv a -> Name -> Maybe a
    lookupNameEnv PackageTypeEnv
    pte Name
    name
                   else case HomePackageTable -> Module -> Maybe HomeModInfo
    lookupHptByModule HomePackageTable
    hpt Module
    mod of
                    Just HomeModInfo
    hm -> forall a. NameEnv a -> Name -> Maybe a
    lookupNameEnv (ModDetails -> PackageTypeEnv
    md_types (HomeModInfo -> ModDetails
    hm_details HomeModInfo
    hm)) Name
    name
                    Maybe HomeModInfo
    Nothing -> forall a. NameEnv a -> Name -> Maybe a
    lookupNameEnv PackageTypeEnv
    pte Name
    name
       forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe TyThing
    ty

    -- | Find the 'ModIface' for a 'Module', searching in both the loaded home
    -- and external package module information
    lookupIfaceByModule
            :: HomePackageTable
            -> PackageIfaceTable
            -> Module
            -> Maybe ModIface
    lookupIfaceByModule :: HomePackageTable -> PackageIfaceTable -> Module -> Maybe ModIface
    lookupIfaceByModule HomePackageTable
    hpt PackageIfaceTable
    pit Module
    mod
      = case HomePackageTable -> Module -> Maybe HomeModInfo
    lookupHptByModule HomePackageTable
    hpt Module
    mod of
           Just HomeModInfo
    hm -> forall a. a -> Maybe a
    Just (HomeModInfo -> ModIface
    hm_iface HomeModInfo
    hm)
           Maybe HomeModInfo
    Nothing -> forall a. ModuleEnv a -> Module -> Maybe a
    lookupModuleEnv PackageIfaceTable
    pit Module
    mod
       -- If the module does come from the home package, why do we look in the PIT as well?
       -- (a) In OneShot mode, even home-package modules accumulate in the PIT
       -- (b) Even in Batch (--make) mode, there is *one* case where a home-package
       --     module is in the PIT, namely GHC.Prim when compiling the base package.
       -- We could eliminate (b) if we wanted, by making GHC.Prim belong to a package
       -- of its own, but it doesn't seem worth the bother.

    mainModIs :: HscEnv -> Module
    mainModIs :: HscEnv -> Module
    mainModIs HscEnv
    hsc_env = HomeUnit -> ModuleName -> Module
    mkHomeModule (HscEnv -> HomeUnit
    hsc_home_unit HscEnv
    hsc_env) (DynFlags -> ModuleName
    mainModuleNameIs (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env))