-data TcEnv s = TcEnv
- (TyVarEnv s)
- (TyConEnv s)
- (ClassEnv s)
- GlobalValueEnv
- (ValueEnv (TcIdBndr s)) -- Locals
- (TcRef s (TcTyVarSet s)) -- Free type variables of locals
- -- ...why mutable? see notes with tcGetGlobalTyVars
-
-type TyVarEnv s = UniqFM (TcKind s, TyVar)
-type TyConEnv s = UniqFM (TcKind s, Maybe Arity, TyCon) -- Arity present for Synonyms only
-type ClassEnv s = UniqFM ([TcKind s], Class) -- The kinds are the kinds of the args
- -- to the class
-type ValueEnv id = UniqFM id
-type GlobalValueEnv = ValueEnv Id -- Globals
-
-initEnv :: TcRef s (TcTyVarSet s) -> TcEnv s
-initEnv mut = TcEnv emptyUFM emptyUFM emptyUFM emptyUFM emptyUFM mut
-
-getEnv_LocalIds (TcEnv _ _ _ _ ls _) = eltsUFM ls
-getEnv_TyCons (TcEnv _ ts _ _ _ _) = [tycon | (_, _, tycon) <- eltsUFM ts]
-getEnv_Classes (TcEnv _ _ cs _ _ _) = [clas | (_, clas) <- eltsUFM cs]
+tcLookupLocated :: Located Name -> TcM TcTyThing
+tcLookupLocated = addLocM tcLookup
+
+tcLookup :: Name -> TcM TcTyThing
+tcLookup name
+ = getLclEnv `thenM` \ local_env ->
+ case lookupNameEnv (tcl_env local_env) name of
+ Just thing -> returnM thing
+ Nothing -> tcLookupGlobal name `thenM` \ thing ->
+ returnM (AGlobal thing)
+
+tcLookupTyVar :: Name -> TcM Id
+tcLookupTyVar name
+ = tcLookup name `thenM` \ thing ->
+ case thing of
+ ATyVar tv -> returnM tv
+ other -> pprPanic "tcLookupTyVar" (ppr name)
+
+tcLookupId :: Name -> TcM Id
+-- Used when we aren't interested in the binding level
+-- Never a DataCon. (Why does that matter? see TcExpr.tcId)
+tcLookupId name
+ = tcLookup name `thenM` \ thing ->
+ case thing of
+ ATcId tc_id _ _ -> returnM tc_id
+ AGlobal (AnId id) -> returnM id
+ other -> pprPanic "tcLookupId" (ppr name)
+
+tcLookupLocalIds :: [Name] -> TcM [TcId]
+-- We expect the variables to all be bound, and all at
+-- the same level as the lookup. Only used in one place...
+tcLookupLocalIds ns
+ = getLclEnv `thenM` \ env ->
+ returnM (map (lookup (tcl_env env) (thLevel (tcl_th_ctxt env))) ns)
+ where
+ lookup lenv lvl name
+ = case lookupNameEnv lenv name of
+ Just (ATcId id lvl1 _) -> ASSERT( lvl == lvl1 ) id
+ other -> pprPanic "tcLookupLocalIds" (ppr name)
+
+lclEnvElts :: TcLclEnv -> [TcTyThing]
+lclEnvElts env = nameEnvElts (tcl_env env)
+
+getInLocalScope :: TcM (Name -> Bool)
+ -- Ids only
+getInLocalScope = getLclEnv `thenM` \ env ->
+ let
+ lcl_env = tcl_env env
+ in
+ return (`elemNameEnv` lcl_env)