simpleInstInfoTy, simpleInstInfoTyCon,
-- Global environment
- tcExtendGlobalEnv, tcExtendGlobalValEnv,
+ tcExtendGlobalEnv, tcExtendGlobalValEnv, tcExtendGlobalTypeEnv,
tcLookupTyCon, tcLookupClass, tcLookupGlobalId, tcLookupDataCon,
tcLookupGlobal_maybe, tcLookupGlobal, tcLookupSyntaxId, tcLookupSyntaxName,
-- Local environment
tcExtendKindEnv, tcLookupLocalIds,
tcExtendTyVarEnv, tcExtendTyVarEnvForMeths,
- tcExtendLocalValEnv, tcLookup, tcLookup_maybe,
+ tcExtendLocalValEnv, tcLookup, tcLookup_maybe, tcLookupId,
-- Global type variables
tcGetGlobalTyVars, tcExtendGlobalTyVars,
import TcType ( TcKind, TcType, TcTyVar, TcTyVarSet,
zonkTcTyVarsAndFV
)
-import Id ( idName, mkUserLocal, isDataConWrapId_maybe )
-import IdInfo ( constantIdInfo )
-import MkId ( mkSpecPragmaId )
+import Id ( idName, mkSpecPragmaId, mkUserLocal, isDataConWrapId_maybe )
+import IdInfo ( vanillaIdInfo )
import Var ( TyVar, Id, idType, lazySetIdInfo, idInfo )
import VarSet
-import Type ( Type,
+import Type ( Type, ThetaType,
tyVarsOfTypes, splitDFunTy,
getDFunTyKey, tyConAppTyCon
)
import DataCon ( DataCon )
import TyCon ( TyCon )
-import Class ( Class, ClassOpItem, ClassContext )
+import Class ( Class, ClassOpItem )
import Name ( Name, OccName, NamedThing(..),
nameOccName, getSrcLoc, mkLocalName, isLocalName,
- nameIsLocalOrFrom, nameModule_maybe
+ nameIsLocalOrFrom
)
-import Name ( NameEnv, lookupNameEnv, nameEnvElts, extendNameEnvList, emptyNameEnv )
+import NameEnv ( NameEnv, lookupNameEnv, nameEnvElts,
+ extendNameEnvList, emptyNameEnv, plusNameEnv )
import OccName ( mkDFunOcc, occNameString )
-import HscTypes ( DFunId, TypeEnv, HomeSymbolTable, PackageTypeEnv,
- typeEnvTyCons, typeEnvClasses, typeEnvIds
+import HscTypes ( DFunId,
+ PackageTypeEnv, TypeEnv,
+ extendTypeEnvList, extendTypeEnvWithIds,
+ typeEnvTyCons, typeEnvClasses, typeEnvIds,
+ HomeSymbolTable
)
import Module ( Module )
import InstEnv ( InstEnv, emptyInstEnv )
{- NameEnv TyThing-} -- compiling this module:
-- types and classes (both imported and local)
-- imported Ids
- -- (Ids defined in this module are in the local envt)
+ -- (Ids defined in this module start in the local envt,
+ -- though they move to the global envt during zonking)
tcLEnv :: NameEnv TcTyThing, -- The local type environment: Ids and TyVars
-- defined in this module
-- This data type is used to help tie the knot
-- when type checking type and class declarations
data TyThingDetails = SynTyDetails Type
- | DataTyDetails ClassContext [DataCon] [Id]
- | ClassDetails ClassContext [Id] [ClassOpItem] DataCon
+ | DataTyDetails ThetaType [DataCon] [Id]
+ | ClassDetails ThetaType [Id] [ClassOpItem] DataCon
\end{code}
-- The Id must be returned without a data dependency on maybe_id
where
new_info = case tcLookupRecId_maybe env (idName id) of
- Nothing -> pprTrace "tcAddIdInfo" (ppr id) constantIdInfo
+ Nothing -> pprTrace "tcAddIdInfo" (ppr id) vanillaIdInfo
Just imported_id -> idInfo imported_id
-- ToDo: could check that types are the same
tcExtendGlobalEnv things thing_inside
= tcGetEnv `thenNF_Tc` \ env ->
let
- ge' = extendNameEnvList (tcGEnv env) [(getName thing, thing) | thing <- things]
+ ge' = extendTypeEnvList (tcGEnv env) things
+ in
+ tcSetEnv (env {tcGEnv = ge'}) thing_inside
+
+
+tcExtendGlobalTypeEnv :: TypeEnv -> TcM r -> TcM r
+tcExtendGlobalTypeEnv extra_env thing_inside
+ = tcGetEnv `thenNF_Tc` \ env ->
+ let
+ ge' = tcGEnv env `plusNameEnv` extra_env
in
tcSetEnv (env {tcGEnv = ge'}) thing_inside
tcExtendGlobalValEnv ids thing_inside
= tcGetEnv `thenNF_Tc` \ env ->
let
- ge' = extendNameEnvList (tcGEnv env) [(getName id, AnId id) | id <- ids]
+ ge' = extendTypeEnvWithIds (tcGEnv env) ids
in
tcSetEnv (env {tcGEnv = ge'}) thing_inside
\end{code}
Just (ATyCon tc) -> returnNF_Tc tc
other -> notFound "tcLookupTyCon" name
+tcLookupId :: Name -> NF_TcM Id
+tcLookupId name
+ = tcLookup name `thenNF_Tc` \ thing ->
+ case thing of
+ ATcId tc_id -> returnNF_Tc tc_id
+ AGlobal (AnId id) -> returnNF_Tc id
+ other -> pprPanic "tcLookupId" (ppr name)
+
tcLookupLocalIds :: [Name] -> NF_TcM [TcId]
tcLookupLocalIds ns
= tcGetEnv `thenNF_Tc` \ env ->