4 TyThing(..), TyThingDetails(..), TcTyThing(..),
6 -- Getting stuff from the environment
8 tcEnvTyCons, tcEnvClasses, tcEnvIds, tcEnvTcIds, tcEnvTyVars,
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, tcLookupSyntaxId, tcLookupSyntaxName,
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, tcAddImportedIdInfo, tcLookupRecId, tcLookupRecId_maybe,
33 newLocalId, newSpecPragmaId,
37 isLocalThing, tcSetEnv
40 #include "HsVersions.h"
42 import RnHsSyn ( RenamedMonoBinds, RenamedSig )
44 import TcType ( TcKind, TcType, TcTyVar, TcTyVarSet,
47 import Id ( idName, mkSpecPragmaId, mkUserLocal, isDataConWrapId_maybe )
48 import IdInfo ( vanillaIdInfo )
49 import Var ( TyVar, Id, idType, lazySetIdInfo, idInfo )
51 import Type ( Type, ThetaType,
52 tyVarsOfTypes, splitDFunTy,
53 getDFunTyKey, tyConAppTyCon
55 import DataCon ( DataCon )
56 import TyCon ( TyCon )
57 import Class ( Class, ClassOpItem )
58 import Name ( Name, OccName, NamedThing(..),
59 nameOccName, getSrcLoc, mkLocalName, isLocalName,
62 import NameEnv ( NameEnv, lookupNameEnv, nameEnvElts, elemNameEnv,
63 extendNameEnvList, emptyNameEnv, plusNameEnv )
64 import OccName ( mkDFunOcc, occNameString )
65 import HscTypes ( DFunId,
66 PackageTypeEnv, TypeEnv,
67 extendTypeEnvList, extendTypeEnvWithIds,
68 typeEnvTyCons, typeEnvClasses, typeEnvIds,
71 import Module ( Module )
72 import InstEnv ( InstEnv, emptyInstEnv )
73 import HscTypes ( lookupType, TyThing(..) )
74 import Util ( zipEqual )
75 import SrcLoc ( SrcLoc )
76 import qualified PrelNames
79 import IOExts ( newIORef )
82 %************************************************************************
86 %************************************************************************
89 type TcId = Id -- Type may be a TcType
94 tcSyntaxMap :: PrelNames.SyntaxMap, -- The syntax map (usually the identity)
96 tcGST :: Name -> Maybe TyThing, -- The type environment at the moment we began this compilation
98 tcInsts :: InstEnv, -- All instances (both imported and in this module)
100 tcGEnv :: TypeEnv, -- The global type environment we've accumulated while
101 {- NameEnv TyThing-} -- compiling this module:
102 -- types and classes (both imported and local)
104 -- (Ids defined in this module start in the local envt,
105 -- though they move to the global envt during zonking)
107 tcLEnv :: NameEnv TcTyThing, -- The local type environment: Ids and TyVars
108 -- defined in this module
110 tcTyVars :: TcRef TcTyVarSet -- The "global tyvars"
111 -- Namely, the in-scope TyVars bound in tcLEnv, plus the tyvars
112 -- mentioned in the types of Ids bound in tcLEnv
113 -- Why mutable? see notes with tcGetGlobalTyVars
118 The Global-Env/Local-Env story
119 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
120 During type checking, we keep in the GlobalEnv
121 * All types and classes
122 * All Ids derived from types and classes (constructors, selectors)
125 At the end of type checking, we zonk the local bindings,
126 and as we do so we add to the GlobalEnv
127 * Locally defined top-level Ids
129 Why? Because they are now Ids not TcIds. This final GlobalEnv is
131 a) fed back (via the knot) to typechecking the
132 unfoldings of interface signatures
134 b) used to augment the GlobalSymbolTable
139 = AGlobal TyThing -- Used only in the return type of a lookup
140 | ATcId TcId -- Ids defined in this module
141 | ATyVar TyVar -- Type variables
142 | AThing TcKind -- Used temporarily, during kind checking
143 -- Here's an example of how the AThing guy is used
144 -- Suppose we are checking (forall a. T a Int):
145 -- 1. We first bind (a -> AThink kv), where kv is a kind variable.
146 -- 2. Then we kind-check the (T a Int) part.
147 -- 3. Then we zonk the kind variable.
148 -- 4. Now we know the kind for 'a', and we add (a -> ATyVar a::K) to the environment
150 initTcEnv :: PrelNames.SyntaxMap -> HomeSymbolTable -> PackageTypeEnv -> IO TcEnv
151 initTcEnv syntax_map hst pte
152 = do { gtv_var <- newIORef emptyVarSet ;
153 return (TcEnv { tcSyntaxMap = syntax_map,
155 tcGEnv = emptyNameEnv,
156 tcInsts = emptyInstEnv,
157 tcLEnv = emptyNameEnv,
161 lookup name | isLocalName name = Nothing
162 | otherwise = lookupType hst pte name
165 tcEnvClasses env = typeEnvClasses (tcGEnv env)
166 tcEnvTyCons env = typeEnvTyCons (tcGEnv env)
167 tcEnvIds env = typeEnvIds (tcGEnv env)
168 tcEnvTyVars env = [tv | ATyVar tv <- nameEnvElts (tcLEnv env)]
169 tcEnvTcIds env = [id | ATcId id <- nameEnvElts (tcLEnv env)]
171 getTcGEnv (TcEnv { tcGEnv = genv }) = genv
173 tcInLocalScope :: TcEnv -> Name -> Bool
174 tcInLocalScope env v = v `elemNameEnv` (tcLEnv env)
176 -- This data type is used to help tie the knot
177 -- when type checking type and class declarations
178 data TyThingDetails = SynTyDetails Type
179 | DataTyDetails ThetaType [DataCon] [Id]
180 | ClassDetails ThetaType [Id] [ClassOpItem] DataCon
184 %************************************************************************
186 \subsection{Basic lookups}
188 %************************************************************************
191 lookup_global :: TcEnv -> Name -> Maybe TyThing
192 -- Try the global envt and then the global symbol table
193 lookup_global env name
194 = case lookupNameEnv (tcGEnv env) name of
195 Just thing -> Just thing
196 Nothing -> tcGST env name
198 lookup_local :: TcEnv -> Name -> Maybe TcTyThing
199 -- Try the local envt and then try the global
200 lookup_local env name
201 = case lookupNameEnv (tcLEnv env) name of
202 Just thing -> Just thing
203 Nothing -> case lookup_global env name of
204 Just thing -> Just (AGlobal thing)
209 type RecTcEnv = TcEnv
210 -- This environment is used for getting the 'right' IdInfo
211 -- on imported things and for looking up Ids in unfoldings
212 -- The environment doesn't have any local Ids in it
214 tcAddImportedIdInfo :: RecTcEnv -> Id -> Id
215 tcAddImportedIdInfo env id
216 = id `lazySetIdInfo` new_info
217 -- The Id must be returned without a data dependency on maybe_id
219 new_info = case tcLookupRecId_maybe env (idName id) of
220 Nothing -> pprTrace "tcAddIdInfo" (ppr id) vanillaIdInfo
221 Just imported_id -> idInfo imported_id
222 -- ToDo: could check that types are the same
224 tcLookupRecId_maybe :: RecTcEnv -> Name -> Maybe Id
225 tcLookupRecId_maybe env name = case lookup_global env name of
226 Just (AnId id) -> Just id
229 tcLookupRecId :: RecTcEnv -> Name -> Id
230 tcLookupRecId env name = case lookup_global env name of
232 Nothing -> pprPanic "tcLookupRecId" (ppr name)
235 %************************************************************************
237 \subsection{Making new Ids}
239 %************************************************************************
244 newLocalId :: OccName -> TcType -> SrcLoc -> NF_TcM TcId
245 newLocalId name ty loc
246 = tcGetUnique `thenNF_Tc` \ uniq ->
247 returnNF_Tc (mkUserLocal name uniq ty loc)
249 newSpecPragmaId :: Name -> TcType -> NF_TcM TcId
250 newSpecPragmaId name ty
251 = tcGetUnique `thenNF_Tc` \ uniq ->
252 returnNF_Tc (mkSpecPragmaId (nameOccName name) uniq ty (getSrcLoc name))
255 Make a name for the dict fun for an instance decl.
256 It's a *local* name for the moment. The CoreTidy pass
260 newDFunName :: Class -> [Type] -> SrcLoc -> NF_TcM Name
261 newDFunName clas (ty:_) loc
262 = tcGetUnique `thenNF_Tc` \ uniq ->
263 returnNF_Tc (mkLocalName uniq (mkDFunOcc dfun_string) loc)
265 -- Any string that is somewhat unique will do
266 dfun_string = occNameString (getOccName clas) ++ occNameString (getDFunTyKey ty)
268 newDFunName clas [] loc = pprPanic "newDFunName" (ppr clas <+> ppr loc)
272 isLocalThing :: NamedThing a => Module -> a -> Bool
273 isLocalThing mod thing = nameIsLocalOrFrom mod (getName thing)
276 %************************************************************************
278 \subsection{The global environment}
280 %************************************************************************
283 tcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r
284 tcExtendGlobalEnv things thing_inside
285 = tcGetEnv `thenNF_Tc` \ env ->
287 ge' = extendTypeEnvList (tcGEnv env) things
289 tcSetEnv (env {tcGEnv = ge'}) thing_inside
292 tcExtendGlobalTypeEnv :: TypeEnv -> TcM r -> TcM r
293 tcExtendGlobalTypeEnv extra_env thing_inside
294 = tcGetEnv `thenNF_Tc` \ env ->
296 ge' = tcGEnv env `plusNameEnv` extra_env
298 tcSetEnv (env {tcGEnv = ge'}) thing_inside
300 tcExtendGlobalValEnv :: [Id] -> TcM a -> TcM a
301 tcExtendGlobalValEnv ids thing_inside
302 = tcGetEnv `thenNF_Tc` \ env ->
304 ge' = extendTypeEnvWithIds (tcGEnv env) ids
306 tcSetEnv (env {tcGEnv = ge'}) thing_inside
311 tcLookupGlobal_maybe :: Name -> NF_TcM (Maybe TyThing)
312 tcLookupGlobal_maybe name
313 = tcGetEnv `thenNF_Tc` \ env ->
314 returnNF_Tc (lookup_global env name)
317 A variety of global lookups, when we know what we are looking for.
320 tcLookupGlobal :: Name -> NF_TcM TyThing
322 = tcLookupGlobal_maybe name `thenNF_Tc` \ maybe_thing ->
324 Just thing -> returnNF_Tc thing
325 other -> notFound "tcLookupGlobal" name
327 tcLookupGlobalId :: Name -> NF_TcM Id
328 tcLookupGlobalId name
329 = tcLookupGlobal_maybe name `thenNF_Tc` \ maybe_id ->
331 Just (AnId id) -> returnNF_Tc id
332 other -> notFound "tcLookupGlobalId" name
334 tcLookupDataCon :: Name -> TcM DataCon
335 tcLookupDataCon con_name
336 = tcLookupGlobalId con_name `thenNF_Tc` \ con_id ->
337 case isDataConWrapId_maybe con_id of
338 Just data_con -> returnTc data_con
339 Nothing -> failWithTc (badCon con_id)
342 tcLookupClass :: Name -> NF_TcM Class
344 = tcLookupGlobal_maybe name `thenNF_Tc` \ maybe_clas ->
346 Just (AClass clas) -> returnNF_Tc clas
347 other -> notFound "tcLookupClass" name
349 tcLookupTyCon :: Name -> NF_TcM TyCon
351 = tcLookupGlobal_maybe name `thenNF_Tc` \ maybe_tc ->
353 Just (ATyCon tc) -> returnNF_Tc tc
354 other -> notFound "tcLookupTyCon" name
356 tcLookupId :: Name -> NF_TcM Id
358 = tcLookup name `thenNF_Tc` \ thing ->
360 ATcId tc_id -> returnNF_Tc tc_id
361 AGlobal (AnId id) -> returnNF_Tc id
362 other -> pprPanic "tcLookupId" (ppr name)
364 tcLookupLocalIds :: [Name] -> NF_TcM [TcId]
366 = tcGetEnv `thenNF_Tc` \ env ->
367 returnNF_Tc (map (lookup (tcLEnv env)) ns)
369 lookup lenv name = case lookupNameEnv lenv name of
370 Just (ATcId id) -> id
371 other -> pprPanic "tcLookupLocalIds" (ppr name)
373 tcLookupSyntaxId :: Name -> NF_TcM Id
374 -- Lookup a name like PrelNum.fromInt, and return the corresponding Id,
375 -- after mapping through the SyntaxMap. This may give us the Id for
376 -- (say) MyPrelude.fromInteger
377 tcLookupSyntaxId name
378 = tcGetEnv `thenNF_Tc` \ env ->
379 returnNF_Tc (case lookup_global env (tcSyntaxMap env name) of
381 other -> pprPanic "tcLookupSyntaxId" (ppr name))
383 tcLookupSyntaxName :: Name -> NF_TcM Name
384 tcLookupSyntaxName name
385 = tcGetEnv `thenNF_Tc` \ env ->
386 returnNF_Tc (tcSyntaxMap env name)
390 %************************************************************************
392 \subsection{The local environment}
394 %************************************************************************
397 tcLookup_maybe :: Name -> NF_TcM (Maybe TcTyThing)
399 = tcGetEnv `thenNF_Tc` \ env ->
400 returnNF_Tc (lookup_local env name)
402 tcLookup :: Name -> NF_TcM TcTyThing
404 = tcLookup_maybe name `thenNF_Tc` \ maybe_thing ->
406 Just thing -> returnNF_Tc thing
407 other -> notFound "tcLookup" name
408 -- Extract the IdInfo from an IfaceSig imported from an interface file
413 tcExtendKindEnv :: [(Name,TcKind)] -> TcM r -> TcM r
414 tcExtendKindEnv pairs thing_inside
415 = tcGetEnv `thenNF_Tc` \ env ->
417 le' = extendNameEnvList (tcLEnv env) [(n, AThing k) | (n,k) <- pairs]
418 -- No need to extend global tyvars for kind checking
420 tcSetEnv (env {tcLEnv = le'}) thing_inside
422 tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
423 tcExtendTyVarEnv tyvars thing_inside
424 = tcGetEnv `thenNF_Tc` \ env@(TcEnv {tcLEnv = le, tcTyVars = gtvs}) ->
426 le' = extendNameEnvList le [ (getName tv, ATyVar tv) | tv <- tyvars]
427 new_tv_set = mkVarSet tyvars
429 -- It's important to add the in-scope tyvars to the global tyvar set
431 -- f (x::r) = let g y = y::r in ...
432 -- Here, g mustn't be generalised. This is also important during
433 -- class and instance decls, when we mustn't generalise the class tyvars
434 -- when typechecking the methods.
435 tc_extend_gtvs gtvs new_tv_set `thenNF_Tc` \ gtvs' ->
436 tcSetEnv (env {tcLEnv = le', tcTyVars = gtvs'}) thing_inside
438 -- This variant, tcExtendTyVarEnvForMeths, takes *two* bunches of tyvars:
439 -- the signature tyvars contain the original names
440 -- the instance tyvars are what those names should be mapped to
441 -- It's needed when typechecking the method bindings of class and instance decls
442 -- It does *not* extend the global tyvars; tcMethodBind does that for itself
444 tcExtendTyVarEnvForMeths :: [TyVar] -> [TcTyVar] -> TcM r -> TcM r
445 tcExtendTyVarEnvForMeths sig_tyvars inst_tyvars thing_inside
446 = tcGetEnv `thenNF_Tc` \ env ->
448 le' = extendNameEnvList (tcLEnv env) stuff
449 stuff = [ (getName sig_tv, ATyVar inst_tv)
450 | (sig_tv, inst_tv) <- zipEqual "tcMeth" sig_tyvars inst_tyvars
453 tcSetEnv (env {tcLEnv = le'}) thing_inside
458 tcExtendLocalValEnv :: [(Name,TcId)] -> TcM a -> TcM a
459 tcExtendLocalValEnv names_w_ids thing_inside
460 = tcGetEnv `thenNF_Tc` \ env ->
462 extra_global_tyvars = tyVarsOfTypes [idType id | (name,id) <- names_w_ids]
463 extra_env = [(name, ATcId id) | (name,id) <- names_w_ids]
464 le' = extendNameEnvList (tcLEnv env) extra_env
466 tc_extend_gtvs (tcTyVars env) extra_global_tyvars `thenNF_Tc` \ gtvs' ->
467 tcSetEnv (env {tcLEnv = le', tcTyVars = gtvs'}) thing_inside
471 %************************************************************************
473 \subsection{The global tyvars}
475 %************************************************************************
478 tcExtendGlobalTyVars extra_global_tvs thing_inside
479 = tcGetEnv `thenNF_Tc` \ env ->
480 tc_extend_gtvs (tcTyVars env) extra_global_tvs `thenNF_Tc` \ gtvs' ->
481 tcSetEnv (env {tcTyVars = gtvs'}) thing_inside
483 tc_extend_gtvs gtvs extra_global_tvs
484 = tcReadMutVar gtvs `thenNF_Tc` \ global_tvs ->
485 tcNewMutVar (global_tvs `unionVarSet` extra_global_tvs)
488 @tcGetGlobalTyVars@ returns a fully-zonked set of tyvars free in the environment.
489 To improve subsequent calls to the same function it writes the zonked set back into
493 tcGetGlobalTyVars :: NF_TcM TcTyVarSet
495 = tcGetEnv `thenNF_Tc` \ (TcEnv {tcTyVars = gtv_var}) ->
496 tcReadMutVar gtv_var `thenNF_Tc` \ gbl_tvs ->
497 zonkTcTyVarsAndFV (varSetElems gbl_tvs) `thenNF_Tc` \ gbl_tvs' ->
498 tcWriteMutVar gtv_var gbl_tvs' `thenNF_Tc_`
503 %************************************************************************
505 \subsection{The instance environment}
507 %************************************************************************
510 tcGetInstEnv :: NF_TcM InstEnv
511 tcGetInstEnv = tcGetEnv `thenNF_Tc` \ env ->
512 returnNF_Tc (tcInsts env)
514 tcSetInstEnv :: InstEnv -> TcM a -> TcM a
515 tcSetInstEnv ie thing_inside
516 = tcGetEnv `thenNF_Tc` \ env ->
517 tcSetEnv (env {tcInsts = ie}) thing_inside
521 %************************************************************************
523 \subsection{The InstInfo type}
525 %************************************************************************
527 The InstInfo type summarises the information in an instance declaration
529 instance c => k (t tvs) where b
534 iDFunId :: DFunId, -- The dfun id
535 iBinds :: RenamedMonoBinds, -- Bindings, b
536 iPrags :: [RenamedSig] -- User pragmas recorded for generating specialised instances
539 pprInstInfo info = vcat [ptext SLIT("InstInfo:") <+> ppr (idType (iDFunId info)),
540 nest 4 (ppr (iBinds info))]
542 simpleInstInfoTy :: InstInfo -> Type
543 simpleInstInfoTy info = case splitDFunTy (idType (iDFunId info)) of
544 (_, _, _, [ty]) -> ty
546 simpleInstInfoTyCon :: InstInfo -> TyCon
547 -- Gets the type constructor for a simple instance declaration,
548 -- i.e. one of the form instance (...) => C (T a b c) where ...
549 simpleInstInfoTyCon inst = tyConAppTyCon (simpleInstInfoTy inst)
553 %************************************************************************
557 %************************************************************************
560 badCon con_id = quotes (ppr con_id) <+> ptext SLIT("is not a data constructor")
562 notFound wheRe name = failWithTc (text wheRe <> colon <+> quotes (ppr name) <+>
563 ptext SLIT("is not in scope"))