module GHC.Runtime.Context
   ( InteractiveContext (..)
   , InteractiveImport (..)
   , emptyInteractiveContext
   , extendInteractiveContext
   , extendInteractiveContextWithIds
   , setInteractivePrintName
   , substInteractiveContext
   , replaceImportEnv
   , icReaderEnv
   , icExtendGblRdrEnv
   , icInteractiveModule
   , icInScopeTTs
   , icNamePprCtx
   )
where
import GHC.Prelude
import GHC.Hs
import GHC.Driver.DynFlags
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.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
forall info. GlobalRdrEnvX info
emptyGlobalRdrEnv
    , igre_prompt_env :: GlobalRdrEnv
igre_prompt_env = GlobalRdrEnv
forall info. GlobalRdrEnvX info
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 })
  = FilePath -> Module
mkInteractiveModule (Int -> FilePath
forall a. Show a => a -> FilePath
show 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
        [ GlobalRdrEltX GREInfo -> Bool
forall info. GlobalRdrEltX info -> Bool
unQualOK GlobalRdrEltX GREInfo
gre
        | GlobalRdrEltX GREInfo
gre <- TyThing -> [GlobalRdrEltX GREInfo]
tyThingLocalGREs TyThing
thing
        , let name :: Name
name = GlobalRdrEltX GREInfo -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrEltX GREInfo
gre
        , Just GlobalRdrEltX GREInfo
gre <- [GlobalRdrEnv -> Name -> Maybe (GlobalRdrEltX GREInfo)
forall info.
Outputable info =>
GlobalRdrEnvX info -> Name -> Maybe (GlobalRdrEltX info)
lookupGRE_Name (InteractiveContext -> GlobalRdrEnv
icReaderEnv InteractiveContext
ictxt) Name
name]
        ]
icNamePprCtx :: UnitEnv -> InteractiveContext -> NamePprCtx
icNamePprCtx :: UnitEnv -> InteractiveContext -> NamePprCtx
icNamePprCtx UnitEnv
unit_env InteractiveContext
ictxt = PromotionTickContext -> UnitEnv -> GlobalRdrEnv -> NamePprCtx
forall info.
Outputable info =>
PromotionTickContext -> UnitEnv -> GlobalRdrEnvX info -> NamePprCtx
mkNamePprCtx PromotionTickContext
ptc UnitEnv
unit_env (InteractiveContext -> GlobalRdrEnv
icReaderEnv InteractiveContext
ictxt)
  where ptc :: PromotionTickContext
ptc = DynFlags -> PromotionTickContext
initPromotionTickContext (InteractiveContext -> DynFlags
ic_dflags 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  = ic_mod_index ictxt + 1
                            
                            
          , ic_tythings   = new_tythings ++ ic_tythings ictxt
          , ic_gre_cache  = ic_gre_cache ictxt `icExtendIcGblRdrEnv` new_tythings
          , ic_instances  = ( new_cls_insts `unionInstEnv` old_cls_insts
                            , new_fam_insts ++ fam_insts )
                            
                            
          , ic_default    = defaults
          , ic_fix_env    = 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  = ic_mod_index ictxt + 1
          , ic_tythings   = new_tythings ++ ic_tythings ictxt
          , ic_gre_cache  = ic_gre_cache ictxt `icExtendIcGblRdrEnv` 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 = n}
icExtendIcGblRdrEnv :: IcGlobalRdrEnv -> [TyThing] -> IcGlobalRdrEnv
icExtendIcGblRdrEnv :: IcGlobalRdrEnv -> [TyThing] -> IcGlobalRdrEnv
icExtendIcGblRdrEnv IcGlobalRdrEnv
igre [TyThing]
tythings = IcGlobalRdrEnv
    { igre_env :: GlobalRdrEnv
igre_env        = Bool -> GlobalRdrEnv -> [TyThing] -> GlobalRdrEnv
icExtendGblRdrEnv Bool
False (IcGlobalRdrEnv -> GlobalRdrEnv
igre_env IcGlobalRdrEnv
igre)        [TyThing]
tythings
    , igre_prompt_env :: GlobalRdrEnv
igre_prompt_env = Bool -> GlobalRdrEnv -> [TyThing] -> GlobalRdrEnv
icExtendGblRdrEnv Bool
True  (IcGlobalRdrEnv -> GlobalRdrEnv
igre_prompt_env IcGlobalRdrEnv
igre) [TyThing]
tythings
        
        
        
    }
replaceImportEnv :: IcGlobalRdrEnv -> GlobalRdrEnv -> IcGlobalRdrEnv
replaceImportEnv :: IcGlobalRdrEnv -> GlobalRdrEnv -> IcGlobalRdrEnv
replaceImportEnv IcGlobalRdrEnv
igre GlobalRdrEnv
import_env = IcGlobalRdrEnv
igre { igre_env = new_env }
  where
    import_env_shadowed :: GlobalRdrEnv
import_env_shadowed = Bool -> GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
shadowNames Bool
False GlobalRdrEnv
import_env (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 :: Bool 
                  -> GlobalRdrEnv -> [TyThing] -> GlobalRdrEnv
icExtendGblRdrEnv :: Bool -> GlobalRdrEnv -> [TyThing] -> GlobalRdrEnv
icExtendGblRdrEnv Bool
drop_only_qualified 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 -> GlobalRdrEltX GREInfo -> GlobalRdrEnv)
-> GlobalRdrEnv -> [GlobalRdrEltX GREInfo] -> 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 -> GlobalRdrEltX GREInfo -> GlobalRdrEnv
extendGlobalRdrEnv GlobalRdrEnv
env1 [GlobalRdrEltX GREInfo]
new_gres
       where
          new_gres :: [GlobalRdrEltX GREInfo]
new_gres = TyThing -> [GlobalRdrEltX GREInfo]
tyThingLocalGREs TyThing
thing
          env1 :: GlobalRdrEnv
env1     = Bool -> GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
shadowNames Bool
drop_only_qualified GlobalRdrEnv
env (GlobalRdrEnv -> GlobalRdrEnv) -> GlobalRdrEnv -> GlobalRdrEnv
forall a b. (a -> b) -> a -> b
$ [GlobalRdrEltX GREInfo] -> GlobalRdrEnv
mkGlobalRdrEnv [GlobalRdrEltX GREInfo]
new_gres
    
    
    
    
    
    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 -> Subst -> InteractiveContext
substInteractiveContext :: InteractiveContext -> Subst -> InteractiveContext
substInteractiveContext ictxt :: InteractiveContext
ictxt@InteractiveContext{ ic_tythings :: InteractiveContext -> [TyThing]
ic_tythings = [TyThing]
tts } Subst
subst
  | Subst -> Bool
isEmptyTCvSubst Subst
subst = InteractiveContext
ictxt
  | Bool
otherwise             = InteractiveContext
ictxt { ic_tythings = map subst_ty 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 (Subst -> Type -> Type
substTyAddInScope Subst
subst) Id
id
      
      
      
    subst_ty TyThing
tt
      = TyThing
tt
instance Outputable InteractiveImport where
  ppr :: InteractiveImport -> SDoc
ppr (IIModule ModuleName
m) = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'*' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> 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