module GHC.Types.TypeEnv
   ( TypeEnv
   , emptyTypeEnv
   , lookupTypeEnv
   , mkTypeEnv
   , typeEnvFromEntities
   , mkTypeEnvWithImplicits
   , extendTypeEnv
   , extendTypeEnvList
   , extendTypeEnvWithIds
   , plusTypeEnv
   , typeEnvElts
   , typeEnvTyCons
   , typeEnvIds
   , typeEnvPatSyns
   , typeEnvDataCons
   , typeEnvCoAxioms
   , typeEnvClasses
   )
where

import GHC.Prelude

import GHC.Core.Class
import GHC.Core.Coercion.Axiom
import GHC.Core.ConLike
import GHC.Core.DataCon
import GHC.Core.FamInstEnv
import GHC.Core.PatSyn
import GHC.Core.TyCon

import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Var
import GHC.Types.TyThing

-- | A map from 'Name's to 'TyThing's, constructed by typechecking
-- local declarations or interface files
type TypeEnv = NameEnv TyThing

emptyTypeEnv    :: TypeEnv
typeEnvElts     :: TypeEnv -> [TyThing]
typeEnvTyCons   :: TypeEnv -> [TyCon]
typeEnvCoAxioms :: TypeEnv -> [CoAxiom Branched]
typeEnvIds      :: TypeEnv -> [Id]
typeEnvPatSyns  :: TypeEnv -> [PatSyn]
typeEnvDataCons :: TypeEnv -> [DataCon]
typeEnvClasses  :: TypeEnv -> [Class]
lookupTypeEnv   :: TypeEnv -> Name -> Maybe TyThing

emptyTypeEnv :: TypeEnv
emptyTypeEnv        = TypeEnv
forall a. NameEnv a
emptyNameEnv
typeEnvElts :: TypeEnv -> [TyThing]
typeEnvElts     TypeEnv
env = TypeEnv -> [TyThing]
forall a. NameEnv a -> [a]
nameEnvElts TypeEnv
env
typeEnvTyCons :: TypeEnv -> [TyCon]
typeEnvTyCons   TypeEnv
env = [TyCon
tc | ATyCon TyCon
tc   <- TypeEnv -> [TyThing]
typeEnvElts TypeEnv
env]
typeEnvCoAxioms :: TypeEnv -> [CoAxiom Branched]
typeEnvCoAxioms TypeEnv
env = [CoAxiom Branched
ax | ACoAxiom CoAxiom Branched
ax <- TypeEnv -> [TyThing]
typeEnvElts TypeEnv
env]
typeEnvIds :: TypeEnv -> [Id]
typeEnvIds      TypeEnv
env = [Id
id | AnId Id
id     <- TypeEnv -> [TyThing]
typeEnvElts TypeEnv
env]
typeEnvPatSyns :: TypeEnv -> [PatSyn]
typeEnvPatSyns  TypeEnv
env = [PatSyn
ps | AConLike (PatSynCon PatSyn
ps) <- TypeEnv -> [TyThing]
typeEnvElts TypeEnv
env]
typeEnvDataCons :: TypeEnv -> [DataCon]
typeEnvDataCons TypeEnv
env = [DataCon
dc | AConLike (RealDataCon DataCon
dc) <- TypeEnv -> [TyThing]
typeEnvElts TypeEnv
env]
typeEnvClasses :: TypeEnv -> [Class]
typeEnvClasses  TypeEnv
env = [Class
cl | TyCon
tc <- TypeEnv -> [TyCon]
typeEnvTyCons TypeEnv
env,
                            Just Class
cl <- [TyCon -> Maybe Class
tyConClass_maybe TyCon
tc]]

mkTypeEnv :: [TyThing] -> TypeEnv
mkTypeEnv :: [TyThing] -> TypeEnv
mkTypeEnv [TyThing]
things = TypeEnv -> [TyThing] -> TypeEnv
extendTypeEnvList TypeEnv
emptyTypeEnv [TyThing]
things

mkTypeEnvWithImplicits :: [TyThing] -> TypeEnv
mkTypeEnvWithImplicits :: [TyThing] -> TypeEnv
mkTypeEnvWithImplicits [TyThing]
things =
  [TyThing] -> TypeEnv
mkTypeEnv [TyThing]
things
    TypeEnv -> TypeEnv -> TypeEnv
forall a. NameEnv a -> NameEnv a -> NameEnv a
`plusNameEnv`
  [TyThing] -> TypeEnv
mkTypeEnv ((TyThing -> [TyThing]) -> [TyThing] -> [TyThing]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TyThing -> [TyThing]
implicitTyThings [TyThing]
things)

typeEnvFromEntities :: [Id] -> [TyCon] -> [PatSyn] -> [FamInst] -> TypeEnv
typeEnvFromEntities :: [Id] -> [TyCon] -> [PatSyn] -> [FamInst] -> TypeEnv
typeEnvFromEntities [Id]
ids [TyCon]
tcs [PatSyn]
patsyns [FamInst]
famInsts =
  [TyThing] -> TypeEnv
mkTypeEnv (   (Id -> TyThing) -> [Id] -> [TyThing]
forall a b. (a -> b) -> [a] -> [b]
map Id -> TyThing
AnId [Id]
ids
             [TyThing] -> [TyThing] -> [TyThing]
forall a. [a] -> [a] -> [a]
++ (TyCon -> TyThing) -> [TyCon] -> [TyThing]
forall a b. (a -> b) -> [a] -> [b]
map TyCon -> TyThing
ATyCon [TyCon]
all_tcs
             [TyThing] -> [TyThing] -> [TyThing]
forall a. [a] -> [a] -> [a]
++ (TyCon -> [TyThing]) -> [TyCon] -> [TyThing]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TyCon -> [TyThing]
implicitTyConThings [TyCon]
all_tcs
             [TyThing] -> [TyThing] -> [TyThing]
forall a. [a] -> [a] -> [a]
++ (FamInst -> TyThing) -> [FamInst] -> [TyThing]
forall a b. (a -> b) -> [a] -> [b]
map (CoAxiom Branched -> TyThing
ACoAxiom (CoAxiom Branched -> TyThing)
-> (FamInst -> CoAxiom Branched) -> FamInst -> TyThing
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoAxiom Unbranched -> CoAxiom Branched
forall (br :: BranchFlag). CoAxiom br -> CoAxiom Branched
toBranchedAxiom (CoAxiom Unbranched -> CoAxiom Branched)
-> (FamInst -> CoAxiom Unbranched) -> FamInst -> CoAxiom Branched
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FamInst -> CoAxiom Unbranched
famInstAxiom) [FamInst]
famInsts
             [TyThing] -> [TyThing] -> [TyThing]
forall a. [a] -> [a] -> [a]
++ (PatSyn -> TyThing) -> [PatSyn] -> [TyThing]
forall a b. (a -> b) -> [a] -> [b]
map (ConLike -> TyThing
AConLike (ConLike -> TyThing) -> (PatSyn -> ConLike) -> PatSyn -> TyThing
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatSyn -> ConLike
PatSynCon) [PatSyn]
patsyns
            )
 where
  all_tcs :: [TyCon]
all_tcs = [TyCon]
tcs [TyCon] -> [TyCon] -> [TyCon]
forall a. [a] -> [a] -> [a]
++ [FamInst] -> [TyCon]
famInstsRepTyCons [FamInst]
famInsts

lookupTypeEnv :: TypeEnv -> Name -> Maybe TyThing
lookupTypeEnv = TypeEnv -> Name -> Maybe TyThing
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv

-- Extend the type environment
extendTypeEnv :: TypeEnv -> TyThing -> TypeEnv
extendTypeEnv :: TypeEnv -> TyThing -> TypeEnv
extendTypeEnv TypeEnv
env TyThing
thing = TypeEnv -> Name -> TyThing -> TypeEnv
forall a. NameEnv a -> Name -> a -> NameEnv a
extendNameEnv TypeEnv
env (TyThing -> Name
forall a. NamedThing a => a -> Name
getName TyThing
thing) TyThing
thing

extendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv
extendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv
extendTypeEnvList TypeEnv
env [TyThing]
things = (TypeEnv -> TyThing -> TypeEnv) -> TypeEnv -> [TyThing] -> TypeEnv
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' TypeEnv -> TyThing -> TypeEnv
extendTypeEnv TypeEnv
env [TyThing]
things

extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
extendTypeEnvWithIds TypeEnv
env [Id]
ids
  = TypeEnv -> [(Name, TyThing)] -> TypeEnv
forall a. NameEnv a -> [(Name, a)] -> NameEnv a
extendNameEnvList TypeEnv
env [(Id -> Name
forall a. NamedThing a => a -> Name
getName Id
id, Id -> TyThing
AnId Id
id) | Id
id <- [Id]
ids]

plusTypeEnv :: TypeEnv -> TypeEnv -> TypeEnv
plusTypeEnv :: TypeEnv -> TypeEnv -> TypeEnv
plusTypeEnv TypeEnv
env1 TypeEnv
env2 = TypeEnv -> TypeEnv -> TypeEnv
forall a. NameEnv a -> NameEnv a -> NameEnv a
plusNameEnv TypeEnv
env1 TypeEnv
env2