{-# LANGUAGE DerivingVia #-}

module GHC.Driver.Env.Types
  ( Hsc(..)
  , HscEnv(..)
  ) where

import GHC.Driver.Errors.Types ( GhcMessage )
import {-# SOURCE #-} GHC.Driver.Hooks
import GHC.Driver.DynFlags ( ContainsDynFlags(..), HasDynFlags(..), DynFlags )
import GHC.Driver.LlvmConfigCache (LlvmConfigCache)

import GHC.Prelude
import GHC.Runtime.Context
import GHC.Runtime.Interpreter.Types ( Interp )
import GHC.Types.Error ( Messages )
import GHC.Types.Name.Cache
import GHC.Types.Target
import GHC.Types.TypeEnv
import GHC.Unit.Finder.Types
import GHC.Unit.Module.Graph
import GHC.Unit.Env
import GHC.Utils.Logger
import GHC.Utils.TmpFs
import {-# SOURCE #-} GHC.Driver.Plugins

import Control.Monad.IO.Class
import Control.Monad.Trans.Reader
import Control.Monad.Trans.State
import Data.IORef
import GHC.Driver.Env.KnotVars

-- | The Hsc monad: Passing an environment and diagnostic state
newtype Hsc a = Hsc (HscEnv -> Messages GhcMessage -> IO (a, Messages GhcMessage))
    deriving ((forall a b. (a -> b) -> Hsc a -> Hsc b)
-> (forall a b. a -> Hsc b -> Hsc a) -> Functor Hsc
forall a b. a -> Hsc b -> Hsc a
forall a b. (a -> b) -> Hsc a -> Hsc 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) -> Hsc a -> Hsc b
fmap :: forall a b. (a -> b) -> Hsc a -> Hsc b
$c<$ :: forall a b. a -> Hsc b -> Hsc a
<$ :: forall a b. a -> Hsc b -> Hsc a
Functor, Functor Hsc
Functor Hsc =>
(forall a. a -> Hsc a)
-> (forall a b. Hsc (a -> b) -> Hsc a -> Hsc b)
-> (forall a b c. (a -> b -> c) -> Hsc a -> Hsc b -> Hsc c)
-> (forall a b. Hsc a -> Hsc b -> Hsc b)
-> (forall a b. Hsc a -> Hsc b -> Hsc a)
-> Applicative Hsc
forall a. a -> Hsc a
forall a b. Hsc a -> Hsc b -> Hsc a
forall a b. Hsc a -> Hsc b -> Hsc b
forall a b. Hsc (a -> b) -> Hsc a -> Hsc b
forall a b c. (a -> b -> c) -> Hsc a -> Hsc b -> Hsc c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Hsc a
pure :: forall a. a -> Hsc a
$c<*> :: forall a b. Hsc (a -> b) -> Hsc a -> Hsc b
<*> :: forall a b. Hsc (a -> b) -> Hsc a -> Hsc b
$cliftA2 :: forall a b c. (a -> b -> c) -> Hsc a -> Hsc b -> Hsc c
liftA2 :: forall a b c. (a -> b -> c) -> Hsc a -> Hsc b -> Hsc c
$c*> :: forall a b. Hsc a -> Hsc b -> Hsc b
*> :: forall a b. Hsc a -> Hsc b -> Hsc b
$c<* :: forall a b. Hsc a -> Hsc b -> Hsc a
<* :: forall a b. Hsc a -> Hsc b -> Hsc a
Applicative, Applicative Hsc
Applicative Hsc =>
(forall a b. Hsc a -> (a -> Hsc b) -> Hsc b)
-> (forall a b. Hsc a -> Hsc b -> Hsc b)
-> (forall a. a -> Hsc a)
-> Monad Hsc
forall a. a -> Hsc a
forall a b. Hsc a -> Hsc b -> Hsc b
forall a b. Hsc a -> (a -> Hsc b) -> Hsc b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. Hsc a -> (a -> Hsc b) -> Hsc b
>>= :: forall a b. Hsc a -> (a -> Hsc b) -> Hsc b
$c>> :: forall a b. Hsc a -> Hsc b -> Hsc b
>> :: forall a b. Hsc a -> Hsc b -> Hsc b
$creturn :: forall a. a -> Hsc a
return :: forall a. a -> Hsc a
Monad, Monad Hsc
Monad Hsc => (forall a. IO a -> Hsc a) -> MonadIO Hsc
forall a. IO a -> Hsc a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> Hsc a
liftIO :: forall a. IO a -> Hsc a
MonadIO)
      via ReaderT HscEnv (StateT (Messages GhcMessage) IO)

instance HasDynFlags Hsc where
    getDynFlags :: Hsc DynFlags
getDynFlags = (HscEnv
 -> Messages GhcMessage -> IO (DynFlags, Messages GhcMessage))
-> Hsc DynFlags
forall a.
(HscEnv -> Messages GhcMessage -> IO (a, Messages GhcMessage))
-> Hsc a
Hsc ((HscEnv
  -> Messages GhcMessage -> IO (DynFlags, Messages GhcMessage))
 -> Hsc DynFlags)
-> (HscEnv
    -> Messages GhcMessage -> IO (DynFlags, Messages GhcMessage))
-> Hsc DynFlags
forall a b. (a -> b) -> a -> b
$ \HscEnv
e Messages GhcMessage
w -> (DynFlags, Messages GhcMessage)
-> IO (DynFlags, Messages GhcMessage)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HscEnv -> DynFlags
hsc_dflags HscEnv
e, Messages GhcMessage
w)

instance ContainsDynFlags HscEnv where
    extractDynFlags :: HscEnv -> DynFlags
extractDynFlags HscEnv
h = HscEnv -> DynFlags
hsc_dflags HscEnv
h

instance HasLogger Hsc where
    getLogger :: Hsc Logger
getLogger = (HscEnv -> Messages GhcMessage -> IO (Logger, Messages GhcMessage))
-> Hsc Logger
forall a.
(HscEnv -> Messages GhcMessage -> IO (a, Messages GhcMessage))
-> Hsc a
Hsc ((HscEnv
  -> Messages GhcMessage -> IO (Logger, Messages GhcMessage))
 -> Hsc Logger)
-> (HscEnv
    -> Messages GhcMessage -> IO (Logger, Messages GhcMessage))
-> Hsc Logger
forall a b. (a -> b) -> a -> b
$ \HscEnv
e Messages GhcMessage
w -> (Logger, Messages GhcMessage) -> IO (Logger, Messages GhcMessage)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HscEnv -> Logger
hsc_logger HscEnv
e, Messages GhcMessage
w)


-- | HscEnv is like 'GHC.Driver.Monad.Session', except that some of the fields are immutable.
-- An HscEnv is used to compile a single module from plain Haskell source
-- code (after preprocessing) to either C, assembly or C--. It's also used
-- to store the dynamic linker state to allow for multiple linkers in the
-- same address space.
-- Things like the module graph don't change during a single compilation.
--
-- Historical note: \"hsc\" used to be the name of the compiler binary,
-- when there was a separate driver and compiler.  To compile a single
-- module, the driver would invoke hsc on the source code... so nowadays
-- we think of hsc as the layer of the compiler that deals with compiling
-- a single module.
data HscEnv
  = HscEnv {
        HscEnv -> DynFlags
hsc_dflags :: DynFlags,
                -- ^ The dynamic flag settings

        HscEnv -> [Target]
hsc_targets :: [Target],
                -- ^ The targets (or roots) of the current session

        HscEnv -> ModuleGraph
hsc_mod_graph :: ModuleGraph,
                -- ^ The module graph of the current session

        HscEnv -> InteractiveContext
hsc_IC :: InteractiveContext,
                -- ^ The context for evaluating interactive statements

        HscEnv -> NameCache
hsc_NC  :: {-# UNPACK #-} !NameCache,
                -- ^ Global Name cache so that each Name gets a single Unique.
                -- Also track the origin of the Names.

        HscEnv -> FinderCache
hsc_FC   :: {-# UNPACK #-} !FinderCache,
                -- ^ The cached result of performing finding in the file system

        HscEnv -> KnotVars (IORef TypeEnv)
hsc_type_env_vars :: KnotVars (IORef TypeEnv)
                -- ^ Used for one-shot compilation only, to initialise
                -- the 'IfGblEnv'. See 'GHC.Tc.Utils.tcg_type_env_var' for
                -- 'GHC.Tc.Utils.TcGblEnv'.  See also Note [hsc_type_env_var hack]

        , HscEnv -> Maybe Interp
hsc_interp :: Maybe Interp
                -- ^ target code interpreter (if any) to use for TH and GHCi.
                -- See Note [Target code interpreter]

        , HscEnv -> Plugins
hsc_plugins :: !Plugins
                -- ^ Plugins

        , HscEnv -> UnitEnv
hsc_unit_env :: UnitEnv
                -- ^ Unit environment (unit state, home unit, etc.).
                --
                -- Initialized from the databases cached in 'hsc_unit_dbs' and
                -- from the DynFlags.

        , HscEnv -> Logger
hsc_logger :: !Logger
                -- ^ Logger with its flags.
                --
                -- Don't forget to update the logger flags if the logging
                -- related DynFlags change. Or better, use hscSetFlags setter
                -- which does it.

        , HscEnv -> Hooks
hsc_hooks :: !Hooks
                -- ^ Hooks

        , HscEnv -> TmpFs
hsc_tmpfs :: !TmpFs
                -- ^ Temporary files

        , HscEnv -> LlvmConfigCache
hsc_llvm_config :: !LlvmConfigCache
                -- ^ LLVM configuration cache.
 }