module GHC.Tc.Types.LclEnv (
TcLclEnv(..)
, TcLclCtxt(..)
, modifyLclCtxt
, getLclEnvArrowCtxt
, getLclEnvThBndrs
, getLclEnvTypeEnv
, getLclEnvBinderStack
, getLclEnvErrCtxt
, getLclEnvLoc
, getLclEnvRdrEnv
, getLclEnvTcLevel
, getLclEnvThStage
, setLclEnvTcLevel
, setLclEnvLoc
, setLclEnvRdrEnv
, setLclEnvBinderStack
, setLclEnvErrCtxt
, setLclEnvThStage
, setLclEnvTypeEnv
, modifyLclEnvTcLevel
, lclEnvInGeneratedCode
, addLclEnvErrCtxt
, ArrowCtxt(..)
, ThBindEnv
, TcTypeEnv
) where
import GHC.Prelude
import GHC.Tc.Utils.TcType ( TcLevel )
import GHC.Tc.Errors.Types ( TcRnMessage )
import GHC.Core.UsageEnv ( UsageEnv )
import GHC.Types.Name.Reader ( LocalRdrEnv )
import GHC.Types.Name.Env ( NameEnv )
import GHC.Types.SrcLoc ( RealSrcSpan )
import GHC.Types.Basic ( TopLevelFlag )
import GHC.Types.Error ( Messages )
import GHC.Tc.Types.BasicTypes
import GHC.Tc.Types.TH
import GHC.Tc.Types.TcRef
import GHC.Tc.Types.ErrCtxt
import GHC.Tc.Types.Constraint ( WantedConstraints )
data TcLclEnv
= TcLclEnv {
TcLclEnv -> TcLclCtxt
tcl_lcl_ctxt :: !TcLclCtxt,
TcLclEnv -> TcRef UsageEnv
tcl_usage :: TcRef UsageEnv,
TcLclEnv -> TcRef WantedConstraints
tcl_lie :: TcRef WantedConstraints,
TcLclEnv -> TcRef (Messages TcRnMessage)
tcl_errs :: TcRef (Messages TcRnMessage)
}
data TcLclCtxt
= TcLclCtxt {
TcLclCtxt -> RealSrcSpan
tcl_loc :: RealSrcSpan,
TcLclCtxt -> [ErrCtxt]
tcl_ctxt :: [ErrCtxt],
TcLclCtxt -> Bool
tcl_in_gen_code :: Bool,
TcLclCtxt -> TcLevel
tcl_tclvl :: TcLevel,
TcLclCtxt -> TcBinderStack
tcl_bndrs :: TcBinderStack,
TcLclCtxt -> LocalRdrEnv
tcl_rdr :: LocalRdrEnv,
TcLclCtxt -> ThStage
tcl_th_ctxt :: ThStage,
TcLclCtxt -> ThBindEnv
tcl_th_bndrs :: ThBindEnv,
TcLclCtxt -> ArrowCtxt
tcl_arrow_ctxt :: ArrowCtxt,
TcLclCtxt -> TcTypeEnv
tcl_env :: TcTypeEnv
}
getLclEnvThStage :: TcLclEnv -> ThStage
getLclEnvThStage :: TcLclEnv -> ThStage
getLclEnvThStage = TcLclCtxt -> ThStage
tcl_th_ctxt (TcLclCtxt -> ThStage)
-> (TcLclEnv -> TcLclCtxt) -> TcLclEnv -> ThStage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcLclEnv -> TcLclCtxt
tcl_lcl_ctxt
setLclEnvThStage :: ThStage -> TcLclEnv -> TcLclEnv
setLclEnvThStage :: ThStage -> TcLclEnv -> TcLclEnv
setLclEnvThStage ThStage
s = (TcLclCtxt -> TcLclCtxt) -> TcLclEnv -> TcLclEnv
modifyLclCtxt (\TcLclCtxt
env -> TcLclCtxt
env { tcl_th_ctxt = s })
getLclEnvThBndrs :: TcLclEnv -> ThBindEnv
getLclEnvThBndrs :: TcLclEnv -> ThBindEnv
getLclEnvThBndrs = TcLclCtxt -> ThBindEnv
tcl_th_bndrs (TcLclCtxt -> ThBindEnv)
-> (TcLclEnv -> TcLclCtxt) -> TcLclEnv -> ThBindEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcLclEnv -> TcLclCtxt
tcl_lcl_ctxt
getLclEnvArrowCtxt :: TcLclEnv -> ArrowCtxt
getLclEnvArrowCtxt :: TcLclEnv -> ArrowCtxt
getLclEnvArrowCtxt = TcLclCtxt -> ArrowCtxt
tcl_arrow_ctxt (TcLclCtxt -> ArrowCtxt)
-> (TcLclEnv -> TcLclCtxt) -> TcLclEnv -> ArrowCtxt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcLclEnv -> TcLclCtxt
tcl_lcl_ctxt
getLclEnvTypeEnv :: TcLclEnv -> TcTypeEnv
getLclEnvTypeEnv :: TcLclEnv -> TcTypeEnv
getLclEnvTypeEnv = TcLclCtxt -> TcTypeEnv
tcl_env (TcLclCtxt -> TcTypeEnv)
-> (TcLclEnv -> TcLclCtxt) -> TcLclEnv -> TcTypeEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcLclEnv -> TcLclCtxt
tcl_lcl_ctxt
setLclEnvTypeEnv :: TcTypeEnv -> TcLclEnv -> TcLclEnv
setLclEnvTypeEnv :: TcTypeEnv -> TcLclEnv -> TcLclEnv
setLclEnvTypeEnv TcTypeEnv
ty_env = (TcLclCtxt -> TcLclCtxt) -> TcLclEnv -> TcLclEnv
modifyLclCtxt (\TcLclCtxt
env -> TcLclCtxt
env { tcl_env = ty_env})
setLclEnvTcLevel :: TcLevel -> TcLclEnv -> TcLclEnv
setLclEnvTcLevel :: TcLevel -> TcLclEnv -> TcLclEnv
setLclEnvTcLevel TcLevel
lvl = (TcLclCtxt -> TcLclCtxt) -> TcLclEnv -> TcLclEnv
modifyLclCtxt (\TcLclCtxt
env -> TcLclCtxt
env {tcl_tclvl = lvl })
modifyLclEnvTcLevel :: (TcLevel -> TcLevel) -> TcLclEnv -> TcLclEnv
modifyLclEnvTcLevel :: (TcLevel -> TcLevel) -> TcLclEnv -> TcLclEnv
modifyLclEnvTcLevel TcLevel -> TcLevel
f = (TcLclCtxt -> TcLclCtxt) -> TcLclEnv -> TcLclEnv
modifyLclCtxt (\TcLclCtxt
env -> TcLclCtxt
env { tcl_tclvl = f (tcl_tclvl env)})
getLclEnvTcLevel :: TcLclEnv -> TcLevel
getLclEnvTcLevel :: TcLclEnv -> TcLevel
getLclEnvTcLevel = TcLclCtxt -> TcLevel
tcl_tclvl (TcLclCtxt -> TcLevel)
-> (TcLclEnv -> TcLclCtxt) -> TcLclEnv -> TcLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcLclEnv -> TcLclCtxt
tcl_lcl_ctxt
setLclEnvLoc :: RealSrcSpan -> TcLclEnv -> TcLclEnv
setLclEnvLoc :: RealSrcSpan -> TcLclEnv -> TcLclEnv
setLclEnvLoc RealSrcSpan
loc = (TcLclCtxt -> TcLclCtxt) -> TcLclEnv -> TcLclEnv
modifyLclCtxt (\TcLclCtxt
lenv -> TcLclCtxt
lenv { tcl_loc = loc })
getLclEnvLoc :: TcLclEnv -> RealSrcSpan
getLclEnvLoc :: TcLclEnv -> RealSrcSpan
getLclEnvLoc = TcLclCtxt -> RealSrcSpan
tcl_loc (TcLclCtxt -> RealSrcSpan)
-> (TcLclEnv -> TcLclCtxt) -> TcLclEnv -> RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcLclEnv -> TcLclCtxt
tcl_lcl_ctxt
getLclEnvErrCtxt :: TcLclEnv -> [ErrCtxt]
getLclEnvErrCtxt :: TcLclEnv -> [ErrCtxt]
getLclEnvErrCtxt = TcLclCtxt -> [ErrCtxt]
tcl_ctxt (TcLclCtxt -> [ErrCtxt])
-> (TcLclEnv -> TcLclCtxt) -> TcLclEnv -> [ErrCtxt]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcLclEnv -> TcLclCtxt
tcl_lcl_ctxt
setLclEnvErrCtxt :: [ErrCtxt] -> TcLclEnv -> TcLclEnv
setLclEnvErrCtxt :: [ErrCtxt] -> TcLclEnv -> TcLclEnv
setLclEnvErrCtxt [ErrCtxt]
ctxt = (TcLclCtxt -> TcLclCtxt) -> TcLclEnv -> TcLclEnv
modifyLclCtxt (\TcLclCtxt
env -> TcLclCtxt
env { tcl_ctxt = ctxt })
addLclEnvErrCtxt :: ErrCtxt -> TcLclEnv -> TcLclEnv
addLclEnvErrCtxt :: ErrCtxt -> TcLclEnv -> TcLclEnv
addLclEnvErrCtxt ErrCtxt
ctxt = (TcLclCtxt -> TcLclCtxt) -> TcLclEnv -> TcLclEnv
modifyLclCtxt (\TcLclCtxt
env -> TcLclCtxt
env { tcl_ctxt = ctxt : (tcl_ctxt env) })
lclEnvInGeneratedCode :: TcLclEnv -> Bool
lclEnvInGeneratedCode :: TcLclEnv -> Bool
lclEnvInGeneratedCode = TcLclCtxt -> Bool
tcl_in_gen_code (TcLclCtxt -> Bool) -> (TcLclEnv -> TcLclCtxt) -> TcLclEnv -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcLclEnv -> TcLclCtxt
tcl_lcl_ctxt
getLclEnvBinderStack :: TcLclEnv -> TcBinderStack
getLclEnvBinderStack :: TcLclEnv -> TcBinderStack
getLclEnvBinderStack = TcLclCtxt -> TcBinderStack
tcl_bndrs (TcLclCtxt -> TcBinderStack)
-> (TcLclEnv -> TcLclCtxt) -> TcLclEnv -> TcBinderStack
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcLclEnv -> TcLclCtxt
tcl_lcl_ctxt
setLclEnvBinderStack :: TcBinderStack -> TcLclEnv -> TcLclEnv
setLclEnvBinderStack :: TcBinderStack -> TcLclEnv -> TcLclEnv
setLclEnvBinderStack TcBinderStack
stack = (TcLclCtxt -> TcLclCtxt) -> TcLclEnv -> TcLclEnv
modifyLclCtxt (\TcLclCtxt
env -> TcLclCtxt
env { tcl_bndrs = stack })
getLclEnvRdrEnv :: TcLclEnv -> LocalRdrEnv
getLclEnvRdrEnv :: TcLclEnv -> LocalRdrEnv
getLclEnvRdrEnv = TcLclCtxt -> LocalRdrEnv
tcl_rdr (TcLclCtxt -> LocalRdrEnv)
-> (TcLclEnv -> TcLclCtxt) -> TcLclEnv -> LocalRdrEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcLclEnv -> TcLclCtxt
tcl_lcl_ctxt
setLclEnvRdrEnv :: LocalRdrEnv -> TcLclEnv -> TcLclEnv
setLclEnvRdrEnv :: LocalRdrEnv -> TcLclEnv -> TcLclEnv
setLclEnvRdrEnv LocalRdrEnv
rdr_env = (TcLclCtxt -> TcLclCtxt) -> TcLclEnv -> TcLclEnv
modifyLclCtxt (\TcLclCtxt
env -> TcLclCtxt
env { tcl_rdr = rdr_env })
modifyLclCtxt :: (TcLclCtxt -> TcLclCtxt) -> TcLclEnv -> TcLclEnv
modifyLclCtxt :: (TcLclCtxt -> TcLclCtxt) -> TcLclEnv -> TcLclEnv
modifyLclCtxt TcLclCtxt -> TcLclCtxt
upd TcLclEnv
env =
let !res :: TcLclCtxt
res = TcLclCtxt -> TcLclCtxt
upd (TcLclEnv -> TcLclCtxt
tcl_lcl_ctxt TcLclEnv
env)
in TcLclEnv
env { tcl_lcl_ctxt = res }
type TcTypeEnv = NameEnv TcTyThing
type ThBindEnv = NameEnv (TopLevelFlag, ThLevel)
data ArrowCtxt
= NoArrowCtxt
| ArrowCtxt LocalRdrEnv (TcRef WantedConstraints)