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