-tcTyVarScopeGivenKinds
- :: [Name] -- Names of some type variables
- -> [TcKind s]
- -> ([TyVar] -> TcM s a) -- Thing to type check in their scope
- -> TcM s a -- Result
-
-tcTyVarScopeGivenKinds names kinds thing_inside
- = fixTc (\ ~(rec_tyvars, _) ->
- -- Ok to look at names, kinds, but not tyvars!
-
- tcGetEnv `thenNF_Tc` \ (TcEnv tve tce ce gve lve gtvs) ->
- let
- tve' = addListToUFM tve (zipEqual "tcTyVarScopeGivenKinds" names (kinds `zipLazy` rec_tyvars))
- in
- tcSetEnv (TcEnv tve' tce ce gve lve gtvs)
- (thing_inside rec_tyvars) `thenTc` \ result ->
-
- -- Get the tyvar's Kinds from their TcKinds
- mapNF_Tc tcDefaultKind kinds `thenNF_Tc` \ kinds' ->
-
- -- Construct the real TyVars
- let
- tyvars = zipWithEqual "tcTyVarScopeGivenKinds" mk_tyvar names kinds'
- mk_tyvar name kind = mkTyVar name (uniqueOf name) kind
- in
- returnTc (tyvars, result)
- ) `thenTc` \ (_,result) ->
- returnTc result
-
-tcTyVarScope names thing_inside
- = newKindVars (length names) `thenNF_Tc` \ kinds ->
- tcTyVarScopeGivenKinds names kinds thing_inside
+data TcTyThing
+ = AGlobal TyThing -- Used only in the return type of a lookup
+ | ATcId TcId -- Ids defined in this module
+ | ATyVar TyVar -- Type variables
+ | AThing TcKind -- Used temporarily, during kind checking
+-- Here's an example of how the AThing guy is used
+-- Suppose we are checking (forall a. T a Int):
+-- 1. We first bind (a -> AThink kv), where kv is a kind variable.
+-- 2. Then we kind-check the (T a Int) part.
+-- 3. Then we zonk the kind variable.
+-- 4. Now we know the kind for 'a', and we add (a -> ATyVar a::K) to the environment
+
+initTcEnv :: PrelNames.SyntaxMap -> HomeSymbolTable -> PackageTypeEnv -> IO TcEnv
+initTcEnv syntax_map hst pte
+ = do { gtv_var <- newIORef emptyVarSet ;
+ return (TcEnv { tcSyntaxMap = syntax_map,
+ tcGST = lookup,
+ tcGEnv = emptyNameEnv,
+ tcInsts = emptyInstEnv,
+ tcLEnv = emptyNameEnv,
+ tcTyVars = gtv_var
+ })}
+ where
+ lookup name | isLocalName name = Nothing
+ | otherwise = lookupType hst pte name
+
+
+tcEnvClasses env = typeEnvClasses (tcGEnv env)
+tcEnvTyCons env = typeEnvTyCons (tcGEnv env)
+tcEnvIds env = typeEnvIds (tcGEnv env)
+tcEnvTyVars env = [tv | ATyVar tv <- nameEnvElts (tcLEnv env)]
+tcEnvTcIds env = [id | ATcId id <- nameEnvElts (tcLEnv env)]
+
+getTcGEnv (TcEnv { tcGEnv = genv }) = genv
+
+-- 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
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Basic lookups}
+%* *
+%************************************************************************
+
+\begin{code}
+lookup_global :: TcEnv -> Name -> Maybe TyThing
+ -- Try the global envt and then the global symbol table
+lookup_global env name
+ = case lookupNameEnv (tcGEnv env) name of
+ Just thing -> Just thing
+ Nothing -> tcGST env name
+
+lookup_local :: TcEnv -> Name -> Maybe TcTyThing
+ -- Try the local envt and then try the global
+lookup_local env name
+ = case lookupNameEnv (tcLEnv env) name of
+ Just thing -> Just thing
+ Nothing -> case lookup_global env name of
+ Just thing -> Just (AGlobal thing)
+ Nothing -> Nothing
+\end{code}
+
+\begin{code}
+type RecTcEnv = TcEnv
+-- This environment is used for getting the 'right' IdInfo
+-- on imported things and for looking up Ids in unfoldings
+-- The environment doesn't have any local Ids in it
+
+tcAddImportedIdInfo :: RecTcEnv -> Id -> Id
+tcAddImportedIdInfo env id
+ = id `lazySetIdInfo` new_info
+ -- 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
+ Just imported_id -> idInfo imported_id
+ -- ToDo: could check that types are the same
+
+tcLookupRecId_maybe :: RecTcEnv -> Name -> Maybe Id
+tcLookupRecId_maybe env name = case lookup_global env name of
+ Just (AnId id) -> Just id
+ other -> Nothing
+
+tcLookupRecId :: RecTcEnv -> Name -> Id
+tcLookupRecId env name = case lookup_global env name of
+ Just (AnId id) -> id
+ Nothing -> pprPanic "tcLookupRecId" (ppr name)