4 TyThing(..), TyThingDetails(..), TcTyThing(..),
6 -- Getting stuff from the environment
8 tcEnvTyCons, tcEnvClasses, tcEnvIds, tcLEnvElts,
11 -- Instance environment, and InstInfo type
12 tcGetInstEnv, tcSetInstEnv,
13 InstInfo(..), pprInstInfo,
14 simpleInstInfoTy, simpleInstInfoTyCon,
17 tcExtendGlobalEnv, tcExtendGlobalValEnv, tcExtendGlobalTypeEnv,
18 tcLookupTyCon, tcLookupClass, tcLookupGlobalId, tcLookupDataCon,
19 tcLookupGlobal_maybe, tcLookupGlobal,
22 tcExtendKindEnv, tcLookupLocalIds, tcInLocalScope,
23 tcExtendTyVarEnv, tcExtendTyVarEnvForMeths,
24 tcExtendLocalValEnv, tcLookup, tcLookup_maybe, tcLookupId,
26 -- Global type variables
27 tcGetGlobalTyVars, tcExtendGlobalTyVars,
29 -- Random useful things
30 RecTcEnv, tcLookupRecId, tcLookupRecId_maybe,
33 newLocalName, newDFunName,
36 isLocalThing, tcSetEnv
39 #include "HsVersions.h"
41 import RnHsSyn ( RenamedMonoBinds, RenamedSig )
43 import TcMType ( zonkTcTyVarsAndFV )
44 import TcType ( Type, ThetaType, TcKind, TcTyVar, TcTyVarSet,
45 tyVarsOfTypes, tcSplitDFunTy,
46 getDFunTyKey, tcTyConAppTyCon
48 import Id ( idName, isDataConWrapId_maybe )
49 import IdInfo ( vanillaIdInfo )
50 import Var ( TyVar, Id, idType, lazySetIdInfo, idInfo )
52 import DataCon ( DataCon )
53 import TyCon ( TyCon )
54 import Class ( Class, ClassOpItem )
55 import Name ( Name, NamedThing(..),
56 getSrcLoc, mkLocalName, isLocalName, nameIsLocalOrFrom
58 import NameEnv ( NameEnv, lookupNameEnv, nameEnvElts, elemNameEnv,
59 extendNameEnvList, emptyNameEnv, plusNameEnv )
60 import OccName ( mkDFunOcc, occNameString )
61 import HscTypes ( DFunId,
62 PackageTypeEnv, TypeEnv,
63 extendTypeEnvList, extendTypeEnvWithIds,
64 typeEnvTyCons, typeEnvClasses, typeEnvIds,
67 import Module ( Module )
68 import InstEnv ( InstEnv, emptyInstEnv )
69 import HscTypes ( lookupType, TyThing(..) )
70 import Util ( zipEqual )
71 import SrcLoc ( SrcLoc )
74 import IOExts ( newIORef )
77 %************************************************************************
81 %************************************************************************
84 type TcId = Id -- Type may be a TcType
89 tcGST :: Name -> Maybe TyThing, -- The type environment at the moment we began this compilation
91 tcInsts :: InstEnv, -- All instances (both imported and in this module)
93 tcGEnv :: TypeEnv, -- The global type environment we've accumulated while
94 {- NameEnv TyThing-} -- compiling this module:
95 -- types and classes (both imported and local)
97 -- (Ids defined in this module start in the local envt,
98 -- though they move to the global envt during zonking)
100 tcLEnv :: NameEnv TcTyThing, -- The local type environment: Ids and TyVars
101 -- defined in this module
103 tcTyVars :: TcRef TcTyVarSet -- The "global tyvars"
104 -- Namely, the in-scope TyVars bound in tcLEnv, plus the tyvars
105 -- mentioned in the types of Ids bound in tcLEnv
106 -- Why mutable? see notes with tcGetGlobalTyVars
111 The Global-Env/Local-Env story
112 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
113 During type checking, we keep in the GlobalEnv
114 * All types and classes
115 * All Ids derived from types and classes (constructors, selectors)
118 At the end of type checking, we zonk the local bindings,
119 and as we do so we add to the GlobalEnv
120 * Locally defined top-level Ids
122 Why? Because they are now Ids not TcIds. This final GlobalEnv is
124 a) fed back (via the knot) to typechecking the
125 unfoldings of interface signatures
127 b) used to augment the GlobalSymbolTable
131 initTcEnv :: HomeSymbolTable -> PackageTypeEnv -> IO TcEnv
133 = do { gtv_var <- newIORef emptyVarSet ;
134 return (TcEnv { tcGST = lookup,
135 tcGEnv = emptyNameEnv,
136 tcInsts = emptyInstEnv,
137 tcLEnv = emptyNameEnv,
141 lookup name | isLocalName name = Nothing
142 | otherwise = lookupType hst pte name
145 tcEnvClasses env = typeEnvClasses (tcGEnv env)
146 tcEnvTyCons env = typeEnvTyCons (tcGEnv env)
147 tcEnvIds env = typeEnvIds (tcGEnv env)
148 tcLEnvElts env = nameEnvElts (tcLEnv env)
150 getTcGEnv (TcEnv { tcGEnv = genv }) = genv
152 tcInLocalScope :: TcEnv -> Name -> Bool
153 tcInLocalScope env v = v `elemNameEnv` (tcLEnv env)
158 = AGlobal TyThing -- Used only in the return type of a lookup
159 | ATcId TcId -- Ids defined in this module
160 | ATyVar TyVar -- Type variables
161 | AThing TcKind -- Used temporarily, during kind checking
162 -- Here's an example of how the AThing guy is used
163 -- Suppose we are checking (forall a. T a Int):
164 -- 1. We first bind (a -> AThink kv), where kv is a kind variable.
165 -- 2. Then we kind-check the (T a Int) part.
166 -- 3. Then we zonk the kind variable.
167 -- 4. Now we know the kind for 'a', and we add (a -> ATyVar a::K) to the environment
171 This data type is used to help tie the knot
172 when type checking type and class declarations
175 data TyThingDetails = SynTyDetails Type
176 | DataTyDetails ThetaType [DataCon] [Id]
177 | ClassDetails ThetaType [Id] [ClassOpItem] DataCon
178 | ForeignTyDetails -- Nothing yet
181 %************************************************************************
183 \subsection{Basic lookups}
185 %************************************************************************
188 lookup_global :: TcEnv -> Name -> Maybe TyThing
189 -- Try the global envt and then the global symbol table
190 lookup_global env name
191 = case lookupNameEnv (tcGEnv env) name of
192 Just thing -> Just thing
193 Nothing -> tcGST env name
195 lookup_local :: TcEnv -> Name -> Maybe TcTyThing
196 -- Try the local envt and then try the global
197 lookup_local env name
198 = case lookupNameEnv (tcLEnv env) name of
199 Just thing -> Just thing
200 Nothing -> case lookup_global env name of
201 Just thing -> Just (AGlobal thing)
206 type RecTcEnv = TcEnv
207 -- This environment is used for getting the 'right' IdInfo
208 -- on imported things and for looking up Ids in unfoldings
209 -- The environment doesn't have any local Ids in it
211 tcLookupRecId_maybe :: RecTcEnv -> Name -> Maybe Id
212 tcLookupRecId_maybe env name = case lookup_global env name of
213 Just (AnId id) -> Just id
216 tcLookupRecId :: RecTcEnv -> Name -> Id
217 tcLookupRecId env name = case lookup_global env name of
219 Nothing -> pprPanic "tcLookupRecId" (ppr name)
222 %************************************************************************
224 \subsection{Making new Ids}
226 %************************************************************************
231 newLocalName :: Name -> NF_TcM Name
232 newLocalName name -- Make a clone
233 = tcGetUnique `thenNF_Tc` \ uniq ->
234 returnNF_Tc (mkLocalName uniq (getOccName name) (getSrcLoc name))
237 Make a name for the dict fun for an instance decl.
238 It's a *local* name for the moment. The CoreTidy pass
242 newDFunName :: Class -> [Type] -> SrcLoc -> NF_TcM Name
243 newDFunName clas (ty:_) loc
244 = tcGetUnique `thenNF_Tc` \ uniq ->
245 returnNF_Tc (mkLocalName uniq (mkDFunOcc dfun_string) loc)
247 -- Any string that is somewhat unique will do
248 dfun_string = occNameString (getOccName clas) ++ occNameString (getDFunTyKey ty)
250 newDFunName clas [] loc = pprPanic "newDFunName" (ppr clas <+> ppr loc)
254 isLocalThing :: NamedThing a => Module -> a -> Bool
255 isLocalThing mod thing = nameIsLocalOrFrom mod (getName thing)
258 %************************************************************************
260 \subsection{The global environment}
262 %************************************************************************
265 tcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r
266 tcExtendGlobalEnv things thing_inside
267 = tcGetEnv `thenNF_Tc` \ env ->
269 ge' = extendTypeEnvList (tcGEnv env) things
271 tcSetEnv (env {tcGEnv = ge'}) thing_inside
274 tcExtendGlobalTypeEnv :: TypeEnv -> TcM r -> TcM r
275 tcExtendGlobalTypeEnv extra_env thing_inside
276 = tcGetEnv `thenNF_Tc` \ env ->
278 ge' = tcGEnv env `plusNameEnv` extra_env
280 tcSetEnv (env {tcGEnv = ge'}) thing_inside
282 tcExtendGlobalValEnv :: [Id] -> TcM a -> TcM a
283 tcExtendGlobalValEnv ids thing_inside
284 = tcGetEnv `thenNF_Tc` \ env ->
286 ge' = extendTypeEnvWithIds (tcGEnv env) ids
288 tcSetEnv (env {tcGEnv = ge'}) thing_inside
293 tcLookupGlobal_maybe :: Name -> NF_TcM (Maybe TyThing)
294 tcLookupGlobal_maybe name
295 = tcGetEnv `thenNF_Tc` \ env ->
296 returnNF_Tc (lookup_global env name)
299 A variety of global lookups, when we know what we are looking for.
302 tcLookupGlobal :: Name -> NF_TcM TyThing
304 = tcLookupGlobal_maybe name `thenNF_Tc` \ maybe_thing ->
306 Just thing -> returnNF_Tc thing
307 other -> notFound "tcLookupGlobal" name
309 tcLookupGlobalId :: Name -> NF_TcM Id
310 tcLookupGlobalId name
311 = tcLookupGlobal_maybe name `thenNF_Tc` \ maybe_id ->
313 Just (AnId id) -> returnNF_Tc id
314 other -> notFound "tcLookupGlobalId" name
316 tcLookupDataCon :: Name -> TcM DataCon
317 tcLookupDataCon con_name
318 = tcLookupGlobalId con_name `thenNF_Tc` \ con_id ->
319 case isDataConWrapId_maybe con_id of
320 Just data_con -> returnTc data_con
321 Nothing -> failWithTc (badCon con_id)
324 tcLookupClass :: Name -> NF_TcM Class
326 = tcLookupGlobal_maybe name `thenNF_Tc` \ maybe_clas ->
328 Just (AClass clas) -> returnNF_Tc clas
329 other -> notFound "tcLookupClass" name
331 tcLookupTyCon :: Name -> NF_TcM TyCon
333 = tcLookupGlobal_maybe name `thenNF_Tc` \ maybe_tc ->
335 Just (ATyCon tc) -> returnNF_Tc tc
336 other -> notFound "tcLookupTyCon" name
338 tcLookupId :: Name -> NF_TcM Id
340 = tcLookup name `thenNF_Tc` \ thing ->
342 ATcId tc_id -> returnNF_Tc tc_id
343 AGlobal (AnId id) -> returnNF_Tc id
344 other -> pprPanic "tcLookupId" (ppr name)
346 tcLookupLocalIds :: [Name] -> NF_TcM [TcId]
348 = tcGetEnv `thenNF_Tc` \ env ->
349 returnNF_Tc (map (lookup (tcLEnv env)) ns)
351 lookup lenv name = case lookupNameEnv lenv name of
352 Just (ATcId id) -> id
353 other -> pprPanic "tcLookupLocalIds" (ppr name)
357 %************************************************************************
359 \subsection{The local environment}
361 %************************************************************************
364 tcLookup_maybe :: Name -> NF_TcM (Maybe TcTyThing)
366 = tcGetEnv `thenNF_Tc` \ env ->
367 returnNF_Tc (lookup_local env name)
369 tcLookup :: Name -> NF_TcM TcTyThing
371 = tcLookup_maybe name `thenNF_Tc` \ maybe_thing ->
373 Just thing -> returnNF_Tc thing
374 other -> notFound "tcLookup" name
375 -- Extract the IdInfo from an IfaceSig imported from an interface file
380 tcExtendKindEnv :: [(Name,TcKind)] -> TcM r -> TcM r
381 tcExtendKindEnv pairs thing_inside
382 = tcGetEnv `thenNF_Tc` \ env ->
384 le' = extendNameEnvList (tcLEnv env) [(n, AThing k) | (n,k) <- pairs]
385 -- No need to extend global tyvars for kind checking
387 tcSetEnv (env {tcLEnv = le'}) thing_inside
389 tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
390 tcExtendTyVarEnv tyvars thing_inside
391 = tcGetEnv `thenNF_Tc` \ env@(TcEnv {tcLEnv = le, tcTyVars = gtvs}) ->
393 le' = extendNameEnvList le [ (getName tv, ATyVar tv) | tv <- tyvars]
394 new_tv_set = mkVarSet tyvars
396 -- It's important to add the in-scope tyvars to the global tyvar set
398 -- f (x::r) = let g y = y::r in ...
399 -- Here, g mustn't be generalised. This is also important during
400 -- class and instance decls, when we mustn't generalise the class tyvars
401 -- when typechecking the methods.
402 tc_extend_gtvs gtvs new_tv_set `thenNF_Tc` \ gtvs' ->
403 tcSetEnv (env {tcLEnv = le', tcTyVars = gtvs'}) thing_inside
405 -- This variant, tcExtendTyVarEnvForMeths, takes *two* bunches of tyvars:
406 -- the signature tyvars contain the original names
407 -- the instance tyvars are what those names should be mapped to
408 -- It's needed when typechecking the method bindings of class and instance decls
409 -- It does *not* extend the global tyvars; tcMethodBind does that for itself
411 tcExtendTyVarEnvForMeths :: [TyVar] -> [TcTyVar] -> TcM r -> TcM r
412 tcExtendTyVarEnvForMeths sig_tyvars inst_tyvars thing_inside
413 = tcGetEnv `thenNF_Tc` \ env ->
415 le' = extendNameEnvList (tcLEnv env) stuff
416 stuff = [ (getName sig_tv, ATyVar inst_tv)
417 | (sig_tv, inst_tv) <- zipEqual "tcMeth" sig_tyvars inst_tyvars
420 tcSetEnv (env {tcLEnv = le'}) thing_inside
425 tcExtendLocalValEnv :: [(Name,TcId)] -> TcM a -> TcM a
426 tcExtendLocalValEnv names_w_ids thing_inside
427 = tcGetEnv `thenNF_Tc` \ env ->
429 extra_global_tyvars = tyVarsOfTypes [idType id | (name,id) <- names_w_ids]
430 extra_env = [(name, ATcId id) | (name,id) <- names_w_ids]
431 le' = extendNameEnvList (tcLEnv env) extra_env
433 tc_extend_gtvs (tcTyVars env) extra_global_tyvars `thenNF_Tc` \ gtvs' ->
434 tcSetEnv (env {tcLEnv = le', tcTyVars = gtvs'}) thing_inside
438 %************************************************************************
440 \subsection{The global tyvars}
442 %************************************************************************
445 tcExtendGlobalTyVars extra_global_tvs thing_inside
446 = tcGetEnv `thenNF_Tc` \ env ->
447 tc_extend_gtvs (tcTyVars env) extra_global_tvs `thenNF_Tc` \ gtvs' ->
448 tcSetEnv (env {tcTyVars = gtvs'}) thing_inside
450 tc_extend_gtvs gtvs extra_global_tvs
451 = tcReadMutVar gtvs `thenNF_Tc` \ global_tvs ->
452 tcNewMutVar (global_tvs `unionVarSet` extra_global_tvs)
455 @tcGetGlobalTyVars@ returns a fully-zonked set of tyvars free in the environment.
456 To improve subsequent calls to the same function it writes the zonked set back into
460 tcGetGlobalTyVars :: NF_TcM TcTyVarSet
462 = tcGetEnv `thenNF_Tc` \ (TcEnv {tcTyVars = gtv_var}) ->
463 tcReadMutVar gtv_var `thenNF_Tc` \ gbl_tvs ->
464 zonkTcTyVarsAndFV (varSetElems gbl_tvs) `thenNF_Tc` \ gbl_tvs' ->
465 tcWriteMutVar gtv_var gbl_tvs' `thenNF_Tc_`
470 %************************************************************************
472 \subsection{The instance environment}
474 %************************************************************************
477 tcGetInstEnv :: NF_TcM InstEnv
478 tcGetInstEnv = tcGetEnv `thenNF_Tc` \ env ->
479 returnNF_Tc (tcInsts env)
481 tcSetInstEnv :: InstEnv -> TcM a -> TcM a
482 tcSetInstEnv ie thing_inside
483 = tcGetEnv `thenNF_Tc` \ env ->
484 tcSetEnv (env {tcInsts = ie}) thing_inside
488 %************************************************************************
490 \subsection{The InstInfo type}
492 %************************************************************************
494 The InstInfo type summarises the information in an instance declaration
496 instance c => k (t tvs) where b
501 iDFunId :: DFunId, -- The dfun id
502 iBinds :: RenamedMonoBinds, -- Bindings, b
503 iPrags :: [RenamedSig] -- User pragmas recorded for generating specialised instances
506 pprInstInfo info = vcat [ptext SLIT("InstInfo:") <+> ppr (idType (iDFunId info)),
507 nest 4 (ppr (iBinds info))]
509 simpleInstInfoTy :: InstInfo -> Type
510 simpleInstInfoTy info = case tcSplitDFunTy (idType (iDFunId info)) of
511 (_, _, _, [ty]) -> ty
513 simpleInstInfoTyCon :: InstInfo -> TyCon
514 -- Gets the type constructor for a simple instance declaration,
515 -- i.e. one of the form instance (...) => C (T a b c) where ...
516 simpleInstInfoTyCon inst = tcTyConAppTyCon (simpleInstInfoTy inst)
520 %************************************************************************
524 %************************************************************************
527 badCon con_id = quotes (ppr con_id) <+> ptext SLIT("is not a data constructor")
529 notFound wheRe name = failWithTc (text wheRe <> colon <+> quotes (ppr name) <+>
530 ptext SLIT("is not in scope"))