module GHC.Runtime.Context
( InteractiveContext (..)
, InteractiveImport (..)
, emptyInteractiveContext
, extendInteractiveContext
, extendInteractiveContextWithIds
, setInteractivePrintName
, substInteractiveContext
, replaceImportEnv
, icReaderEnv
, icInteractiveModule
, icInScopeTTs
, icPrintUnqual
)
where
import GHC.Prelude
import GHC.Hs
import GHC.Driver.Session
import {-# SOURCE #-} GHC.Driver.Plugins
import GHC.Runtime.Eval.Types ( IcGlobalRdrEnv(..), Resume )
import GHC.Unit
import GHC.Unit.Env
import GHC.Core.FamInstEnv
import GHC.Core.InstEnv
import GHC.Core.Type
import GHC.Types.Avail
import GHC.Types.Fixity.Env
import GHC.Types.Id.Info ( IdDetails(..) )
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Name.Reader
import GHC.Types.Name.Ppr
import GHC.Types.TyThing
import GHC.Types.Var
import GHC.Builtin.Names ( ioTyConName, printName, mkInteractiveModule )
import GHC.Utils.Outputable
data InteractiveContext
= InteractiveContext {
InteractiveContext -> DynFlags
ic_dflags :: DynFlags,
InteractiveContext -> Int
ic_mod_index :: Int,
InteractiveContext -> [InteractiveImport]
ic_imports :: [InteractiveImport],
InteractiveContext -> [TyThing]
ic_tythings :: [TyThing],
InteractiveContext -> IcGlobalRdrEnv
ic_gre_cache :: IcGlobalRdrEnv,
InteractiveContext -> (InstEnv, [FamInst])
ic_instances :: (InstEnv, [FamInst]),
InteractiveContext -> FixityEnv
ic_fix_env :: FixityEnv,
InteractiveContext -> Maybe [Type]
ic_default :: Maybe [Type],
InteractiveContext -> [Resume]
ic_resume :: [Resume],
InteractiveContext -> Name
ic_monad :: Name,
InteractiveContext -> Name
ic_int_print :: Name,
InteractiveContext -> Maybe FilePath
ic_cwd :: Maybe FilePath,
InteractiveContext -> Plugins
ic_plugins :: !Plugins
}
data InteractiveImport
= IIDecl (ImportDecl GhcPs)
| IIModule ModuleName
emptyIcGlobalRdrEnv :: IcGlobalRdrEnv
emptyIcGlobalRdrEnv :: IcGlobalRdrEnv
emptyIcGlobalRdrEnv = IcGlobalRdrEnv
{ igre_env :: GlobalRdrEnv
igre_env = GlobalRdrEnv
emptyGlobalRdrEnv
, igre_prompt_env :: GlobalRdrEnv
igre_prompt_env = GlobalRdrEnv
emptyGlobalRdrEnv
}
emptyInteractiveContext :: DynFlags -> InteractiveContext
emptyInteractiveContext :: DynFlags -> InteractiveContext
emptyInteractiveContext DynFlags
dflags
= InteractiveContext {
ic_dflags :: DynFlags
ic_dflags = DynFlags
dflags,
ic_imports :: [InteractiveImport]
ic_imports = [],
ic_gre_cache :: IcGlobalRdrEnv
ic_gre_cache = IcGlobalRdrEnv
emptyIcGlobalRdrEnv,
ic_mod_index :: Int
ic_mod_index = Int
1,
ic_tythings :: [TyThing]
ic_tythings = [],
ic_instances :: (InstEnv, [FamInst])
ic_instances = (InstEnv
emptyInstEnv,[]),
ic_fix_env :: FixityEnv
ic_fix_env = FixityEnv
forall a. NameEnv a
emptyNameEnv,
ic_monad :: Name
ic_monad = Name
ioTyConName,
ic_int_print :: Name
ic_int_print = Name
printName,
ic_default :: Maybe [Type]
ic_default = Maybe [Type]
forall a. Maybe a
Nothing,
ic_resume :: [Resume]
ic_resume = [],
ic_cwd :: Maybe FilePath
ic_cwd = Maybe FilePath
forall a. Maybe a
Nothing,
ic_plugins :: Plugins
ic_plugins = Plugins
emptyPlugins
}
icReaderEnv :: InteractiveContext -> GlobalRdrEnv
icReaderEnv :: InteractiveContext -> GlobalRdrEnv
icReaderEnv = IcGlobalRdrEnv -> GlobalRdrEnv
igre_env (IcGlobalRdrEnv -> GlobalRdrEnv)
-> (InteractiveContext -> IcGlobalRdrEnv)
-> InteractiveContext
-> GlobalRdrEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InteractiveContext -> IcGlobalRdrEnv
ic_gre_cache
icInteractiveModule :: InteractiveContext -> Module
icInteractiveModule :: InteractiveContext -> Module
icInteractiveModule (InteractiveContext { ic_mod_index :: InteractiveContext -> Int
ic_mod_index = Int
index })
= Int -> Module
mkInteractiveModule Int
index
icInScopeTTs :: InteractiveContext -> [TyThing]
icInScopeTTs :: InteractiveContext -> [TyThing]
icInScopeTTs InteractiveContext
ictxt = (TyThing -> Bool) -> [TyThing] -> [TyThing]
forall a. (a -> Bool) -> [a] -> [a]
filter TyThing -> Bool
in_scope_unqualified (InteractiveContext -> [TyThing]
ic_tythings InteractiveContext
ictxt)
where
in_scope_unqualified :: TyThing -> Bool
in_scope_unqualified TyThing
thing = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
[ GlobalRdrElt -> Bool
unQualOK GlobalRdrElt
gre
| AvailInfo
avail <- TyThing -> [AvailInfo]
tyThingAvailInfo TyThing
thing
, Name
name <- AvailInfo -> [Name]
availNames AvailInfo
avail
, Just GlobalRdrElt
gre <- [GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
lookupGRE_Name (InteractiveContext -> GlobalRdrEnv
icReaderEnv InteractiveContext
ictxt) Name
name]
]
icPrintUnqual :: UnitEnv -> InteractiveContext -> PrintUnqualified
icPrintUnqual :: UnitEnv -> InteractiveContext -> PrintUnqualified
icPrintUnqual UnitEnv
unit_env InteractiveContext
ictxt = UnitEnv -> GlobalRdrEnv -> PrintUnqualified
mkPrintUnqualified UnitEnv
unit_env (InteractiveContext -> GlobalRdrEnv
icReaderEnv InteractiveContext
ictxt)
extendInteractiveContext :: InteractiveContext
-> [TyThing]
-> InstEnv -> [FamInst]
-> Maybe [Type]
-> FixityEnv
-> InteractiveContext
extendInteractiveContext :: InteractiveContext
-> [TyThing]
-> InstEnv
-> [FamInst]
-> Maybe [Type]
-> FixityEnv
-> InteractiveContext
extendInteractiveContext InteractiveContext
ictxt [TyThing]
new_tythings InstEnv
new_cls_insts [FamInst]
new_fam_insts Maybe [Type]
defaults FixityEnv
fix_env
= InteractiveContext
ictxt { ic_mod_index :: Int
ic_mod_index = InteractiveContext -> Int
ic_mod_index InteractiveContext
ictxt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
, ic_tythings :: [TyThing]
ic_tythings = [TyThing]
new_tythings [TyThing] -> [TyThing] -> [TyThing]
forall a. [a] -> [a] -> [a]
++ InteractiveContext -> [TyThing]
ic_tythings InteractiveContext
ictxt
, ic_gre_cache :: IcGlobalRdrEnv
ic_gre_cache = InteractiveContext -> IcGlobalRdrEnv
ic_gre_cache InteractiveContext
ictxt IcGlobalRdrEnv -> [TyThing] -> IcGlobalRdrEnv
`icExtendIcGblRdrEnv` [TyThing]
new_tythings
, ic_instances :: (InstEnv, [FamInst])
ic_instances = ( InstEnv
new_cls_insts InstEnv -> InstEnv -> InstEnv
`unionInstEnv` InstEnv
old_cls_insts
, [FamInst]
new_fam_insts [FamInst] -> [FamInst] -> [FamInst]
forall a. [a] -> [a] -> [a]
++ [FamInst]
fam_insts )
, ic_default :: Maybe [Type]
ic_default = Maybe [Type]
defaults
, ic_fix_env :: FixityEnv
ic_fix_env = FixityEnv
fix_env
}
where
(InstEnv
cls_insts, [FamInst]
fam_insts) = InteractiveContext -> (InstEnv, [FamInst])
ic_instances InteractiveContext
ictxt
old_cls_insts :: InstEnv
old_cls_insts = (ClsInst -> Bool) -> InstEnv -> InstEnv
filterInstEnv (\ClsInst
i -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (ClsInst -> Bool) -> InstEnv -> Bool
anyInstEnv (ClsInst -> ClsInst -> Bool
identicalClsInstHead ClsInst
i) InstEnv
new_cls_insts) InstEnv
cls_insts
extendInteractiveContextWithIds :: InteractiveContext -> [Id] -> InteractiveContext
extendInteractiveContextWithIds :: InteractiveContext -> [Id] -> InteractiveContext
extendInteractiveContextWithIds InteractiveContext
ictxt [Id]
new_ids
| [Id] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Id]
new_ids = InteractiveContext
ictxt
| Bool
otherwise
= InteractiveContext
ictxt { ic_mod_index :: Int
ic_mod_index = InteractiveContext -> Int
ic_mod_index InteractiveContext
ictxt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
, ic_tythings :: [TyThing]
ic_tythings = [TyThing]
new_tythings [TyThing] -> [TyThing] -> [TyThing]
forall a. [a] -> [a] -> [a]
++ InteractiveContext -> [TyThing]
ic_tythings InteractiveContext
ictxt
, ic_gre_cache :: IcGlobalRdrEnv
ic_gre_cache = InteractiveContext -> IcGlobalRdrEnv
ic_gre_cache InteractiveContext
ictxt IcGlobalRdrEnv -> [TyThing] -> IcGlobalRdrEnv
`icExtendIcGblRdrEnv` [TyThing]
new_tythings
}
where
new_tythings :: [TyThing]
new_tythings = (Id -> TyThing) -> [Id] -> [TyThing]
forall a b. (a -> b) -> [a] -> [b]
map Id -> TyThing
AnId [Id]
new_ids
setInteractivePrintName :: InteractiveContext -> Name -> InteractiveContext
setInteractivePrintName :: InteractiveContext -> Name -> InteractiveContext
setInteractivePrintName InteractiveContext
ic Name
n = InteractiveContext
ic{ic_int_print :: Name
ic_int_print = Name
n}
icExtendIcGblRdrEnv :: IcGlobalRdrEnv -> [TyThing] -> IcGlobalRdrEnv
icExtendIcGblRdrEnv :: IcGlobalRdrEnv -> [TyThing] -> IcGlobalRdrEnv
icExtendIcGblRdrEnv IcGlobalRdrEnv
igre [TyThing]
tythings = IcGlobalRdrEnv
{ igre_env :: GlobalRdrEnv
igre_env = IcGlobalRdrEnv -> GlobalRdrEnv
igre_env IcGlobalRdrEnv
igre GlobalRdrEnv -> [TyThing] -> GlobalRdrEnv
`icExtendGblRdrEnv` [TyThing]
tythings
, igre_prompt_env :: GlobalRdrEnv
igre_prompt_env = IcGlobalRdrEnv -> GlobalRdrEnv
igre_prompt_env IcGlobalRdrEnv
igre GlobalRdrEnv -> [TyThing] -> GlobalRdrEnv
`icExtendGblRdrEnv` [TyThing]
tythings
}
replaceImportEnv :: IcGlobalRdrEnv -> GlobalRdrEnv -> IcGlobalRdrEnv
replaceImportEnv :: IcGlobalRdrEnv -> GlobalRdrEnv -> IcGlobalRdrEnv
replaceImportEnv IcGlobalRdrEnv
igre GlobalRdrEnv
import_env = IcGlobalRdrEnv
igre { igre_env :: GlobalRdrEnv
igre_env = GlobalRdrEnv
new_env }
where
import_env_shadowed :: GlobalRdrEnv
import_env_shadowed = GlobalRdrEnv
import_env GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
forall a. GlobalRdrEnv -> OccEnv a -> GlobalRdrEnv
`shadowNames` IcGlobalRdrEnv -> GlobalRdrEnv
igre_prompt_env IcGlobalRdrEnv
igre
new_env :: GlobalRdrEnv
new_env = GlobalRdrEnv
import_env_shadowed GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
`plusGlobalRdrEnv` IcGlobalRdrEnv -> GlobalRdrEnv
igre_prompt_env IcGlobalRdrEnv
igre
icExtendGblRdrEnv :: GlobalRdrEnv -> [TyThing] -> GlobalRdrEnv
icExtendGblRdrEnv :: GlobalRdrEnv -> [TyThing] -> GlobalRdrEnv
icExtendGblRdrEnv GlobalRdrEnv
env [TyThing]
tythings
= (TyThing -> GlobalRdrEnv -> GlobalRdrEnv)
-> GlobalRdrEnv -> [TyThing] -> GlobalRdrEnv
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr TyThing -> GlobalRdrEnv -> GlobalRdrEnv
add GlobalRdrEnv
env [TyThing]
tythings
where
add :: TyThing -> GlobalRdrEnv -> GlobalRdrEnv
add TyThing
thing GlobalRdrEnv
env
| TyThing -> Bool
is_sub_bndr TyThing
thing
= GlobalRdrEnv
env
| Bool
otherwise
= (GlobalRdrEnv -> GlobalRdrElt -> GlobalRdrEnv)
-> GlobalRdrEnv -> [GlobalRdrElt] -> GlobalRdrEnv
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' GlobalRdrEnv -> GlobalRdrElt -> GlobalRdrEnv
extendGlobalRdrEnv GlobalRdrEnv
env1 ((AvailInfo -> [GlobalRdrElt]) -> [AvailInfo] -> [GlobalRdrElt]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AvailInfo -> [GlobalRdrElt]
localGREsFromAvail [AvailInfo]
avail)
where
new_gres :: [GreName]
new_gres = (AvailInfo -> [GreName]) -> [AvailInfo] -> [GreName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AvailInfo -> [GreName]
availGreNames [AvailInfo]
avail
new_occs :: OccEnv OccName
new_occs = OccSet -> OccEnv OccName
occSetToEnv ([OccName] -> OccSet
mkOccSet ((GreName -> OccName) -> [GreName] -> [OccName]
forall a b. (a -> b) -> [a] -> [b]
map GreName -> OccName
forall name. HasOccName name => name -> OccName
occName [GreName]
new_gres))
env1 :: GlobalRdrEnv
env1 = GlobalRdrEnv -> OccEnv OccName -> GlobalRdrEnv
forall a. GlobalRdrEnv -> OccEnv a -> GlobalRdrEnv
shadowNames GlobalRdrEnv
env OccEnv OccName
new_occs
avail :: [AvailInfo]
avail = TyThing -> [AvailInfo]
tyThingAvailInfo TyThing
thing
is_sub_bndr :: TyThing -> Bool
is_sub_bndr (AnId Id
f) = case Id -> IdDetails
idDetails Id
f of
RecSelId {} -> Bool
True
ClassOpId {} -> Bool
True
IdDetails
_ -> Bool
False
is_sub_bndr TyThing
_ = Bool
False
substInteractiveContext :: InteractiveContext -> TCvSubst -> InteractiveContext
substInteractiveContext :: InteractiveContext -> TCvSubst -> InteractiveContext
substInteractiveContext ictxt :: InteractiveContext
ictxt@InteractiveContext{ ic_tythings :: InteractiveContext -> [TyThing]
ic_tythings = [TyThing]
tts } TCvSubst
subst
| TCvSubst -> Bool
isEmptyTCvSubst TCvSubst
subst = InteractiveContext
ictxt
| Bool
otherwise = InteractiveContext
ictxt { ic_tythings :: [TyThing]
ic_tythings = (TyThing -> TyThing) -> [TyThing] -> [TyThing]
forall a b. (a -> b) -> [a] -> [b]
map TyThing -> TyThing
subst_ty [TyThing]
tts }
where
subst_ty :: TyThing -> TyThing
subst_ty (AnId Id
id)
= Id -> TyThing
AnId (Id -> TyThing) -> Id -> TyThing
forall a b. (a -> b) -> a -> b
$ (Type -> Type) -> Id -> Id
updateIdTypeAndMult (TCvSubst -> Type -> Type
substTyAddInScope TCvSubst
subst) Id
id
subst_ty TyThing
tt
= TyThing
tt
instance Outputable InteractiveImport where
ppr :: InteractiveImport -> SDoc
ppr (IIModule ModuleName
m) = Char -> SDoc
char Char
'*' SDoc -> SDoc -> SDoc
<> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
m
ppr (IIDecl ImportDecl GhcPs
d) = ImportDecl GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr ImportDecl GhcPs
d