never executed always true always false

    1 module GHC.Types.TypeEnv
    2    ( TypeEnv
    3    , emptyTypeEnv
    4    , lookupTypeEnv
    5    , mkTypeEnv
    6    , typeEnvFromEntities
    7    , mkTypeEnvWithImplicits
    8    , extendTypeEnv
    9    , extendTypeEnvList
   10    , extendTypeEnvWithIds
   11    , plusTypeEnv
   12    , typeEnvElts
   13    , typeEnvTyCons
   14    , typeEnvIds
   15    , typeEnvPatSyns
   16    , typeEnvDataCons
   17    , typeEnvCoAxioms
   18    , typeEnvClasses
   19    )
   20 where
   21 
   22 import GHC.Prelude
   23 
   24 import GHC.Core.Class
   25 import GHC.Core.Coercion.Axiom
   26 import GHC.Core.ConLike
   27 import GHC.Core.DataCon
   28 import GHC.Core.FamInstEnv
   29 import GHC.Core.PatSyn
   30 import GHC.Core.TyCon
   31 
   32 import GHC.Types.Name
   33 import GHC.Types.Name.Env
   34 import GHC.Types.Var
   35 import GHC.Types.TyThing
   36 
   37 -- | A map from 'Name's to 'TyThing's, constructed by typechecking
   38 -- local declarations or interface files
   39 type TypeEnv = NameEnv TyThing
   40 
   41 emptyTypeEnv    :: TypeEnv
   42 typeEnvElts     :: TypeEnv -> [TyThing]
   43 typeEnvTyCons   :: TypeEnv -> [TyCon]
   44 typeEnvCoAxioms :: TypeEnv -> [CoAxiom Branched]
   45 typeEnvIds      :: TypeEnv -> [Id]
   46 typeEnvPatSyns  :: TypeEnv -> [PatSyn]
   47 typeEnvDataCons :: TypeEnv -> [DataCon]
   48 typeEnvClasses  :: TypeEnv -> [Class]
   49 lookupTypeEnv   :: TypeEnv -> Name -> Maybe TyThing
   50 
   51 emptyTypeEnv        = emptyNameEnv
   52 typeEnvElts     env = nonDetNameEnvElts env
   53 typeEnvTyCons   env = [tc | ATyCon tc   <- typeEnvElts env]
   54 typeEnvCoAxioms env = [ax | ACoAxiom ax <- typeEnvElts env]
   55 typeEnvIds      env = [id | AnId id     <- typeEnvElts env]
   56 typeEnvPatSyns  env = [ps | AConLike (PatSynCon ps) <- typeEnvElts env]
   57 typeEnvDataCons env = [dc | AConLike (RealDataCon dc) <- typeEnvElts env]
   58 typeEnvClasses  env = [cl | tc <- typeEnvTyCons env,
   59                             Just cl <- [tyConClass_maybe tc]]
   60 
   61 mkTypeEnv :: [TyThing] -> TypeEnv
   62 mkTypeEnv things = extendTypeEnvList emptyTypeEnv things
   63 
   64 mkTypeEnvWithImplicits :: [TyThing] -> TypeEnv
   65 mkTypeEnvWithImplicits things =
   66   mkTypeEnv things
   67     `plusNameEnv`
   68   mkTypeEnv (concatMap implicitTyThings things)
   69 
   70 typeEnvFromEntities :: [Id] -> [TyCon] -> [PatSyn] -> [FamInst] -> TypeEnv
   71 typeEnvFromEntities ids tcs patsyns famInsts =
   72   mkTypeEnv (   map AnId ids
   73              ++ map ATyCon all_tcs
   74              ++ concatMap implicitTyConThings all_tcs
   75              ++ map (ACoAxiom . toBranchedAxiom . famInstAxiom) famInsts
   76              ++ map (AConLike . PatSynCon) patsyns
   77             )
   78  where
   79   all_tcs = tcs ++ famInstsRepTyCons famInsts
   80 
   81 lookupTypeEnv = lookupNameEnv
   82 
   83 -- Extend the type environment
   84 extendTypeEnv :: TypeEnv -> TyThing -> TypeEnv
   85 extendTypeEnv env thing = extendNameEnv env (getName thing) thing
   86 
   87 extendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv
   88 extendTypeEnvList env things = foldl' extendTypeEnv env things
   89 
   90 extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
   91 extendTypeEnvWithIds env ids
   92   = extendNameEnvList env [(getName id, AnId id) | id <- ids]
   93 
   94 plusTypeEnv :: TypeEnv -> TypeEnv -> TypeEnv
   95 plusTypeEnv env1 env2 = plusNameEnv env1 env2
   96