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 TcMType ( zonkTcTyVarsAndFV )
45 import TcType ( Type, ThetaType,
46 tyVarsOfTypes, tcSplitDFunTy,
47 getDFunTyKey, tcTyConAppTyCon
49 import Id ( idName, mkSpecPragmaId, mkUserLocal, isDataConWrapId_maybe )
50 import IdInfo ( vanillaIdInfo )
51 import Var ( TyVar, Id, idType, lazySetIdInfo, idInfo )
53 import DataCon ( DataCon )
54 import TyCon ( TyCon )
55 import Class ( Class, ClassOpItem )
56 import Name ( Name, OccName, NamedThing(..),
57 nameOccName, getSrcLoc, mkLocalName, isLocalName,
60 import NameEnv ( NameEnv, lookupNameEnv, nameEnvElts, elemNameEnv,
61 extendNameEnvList, emptyNameEnv, plusNameEnv )
62 import OccName ( mkDFunOcc, occNameString )
63 import HscTypes ( DFunId,
64 PackageTypeEnv, TypeEnv,
65 extendTypeEnvList, extendTypeEnvWithIds,
66 typeEnvTyCons, typeEnvClasses, typeEnvIds,
69 import Module ( Module )
70 import InstEnv ( InstEnv, emptyInstEnv )
71 import HscTypes ( lookupType, TyThing(..) )
72 import Util ( zipEqual )
73 import SrcLoc ( SrcLoc )
74 import qualified PrelNames
77 import IOExts ( newIORef )
80 %************************************************************************
84 %************************************************************************
87 type TcId = Id -- Type may be a TcType
92 tcSyntaxMap :: PrelNames.SyntaxMap, -- The syntax map (usually the identity)
94 tcGST :: Name -> Maybe TyThing, -- The type environment at the moment we began this compilation
96 tcInsts :: InstEnv, -- All instances (both imported and in this module)
98 tcGEnv :: TypeEnv, -- The global type environment we've accumulated while
99 {- NameEnv TyThing-} -- compiling this module:
100 -- types and classes (both imported and local)
102 -- (Ids defined in this module start in the local envt,
103 -- though they move to the global envt during zonking)
105 tcLEnv :: NameEnv TcTyThing, -- The local type environment: Ids and TyVars
106 -- defined in this module
108 tcTyVars :: TcRef TcTyVarSet -- The "global tyvars"
109 -- Namely, the in-scope TyVars bound in tcLEnv, plus the tyvars
110 -- mentioned in the types of Ids bound in tcLEnv
111 -- Why mutable? see notes with tcGetGlobalTyVars
116 The Global-Env/Local-Env story
117 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
118 During type checking, we keep in the GlobalEnv
119 * All types and classes
120 * All Ids derived from types and classes (constructors, selectors)
123 At the end of type checking, we zonk the local bindings,
124 and as we do so we add to the GlobalEnv
125 * Locally defined top-level Ids
127 Why? Because they are now Ids not TcIds. This final GlobalEnv is
129 a) fed back (via the knot) to typechecking the
130 unfoldings of interface signatures
132 b) used to augment the GlobalSymbolTable
137 = AGlobal TyThing -- Used only in the return type of a lookup
138 | ATcId TcId -- Ids defined in this module
139 | ATyVar TyVar -- Type variables
140 | AThing TcKind -- Used temporarily, during kind checking
141 -- Here's an example of how the AThing guy is used
142 -- Suppose we are checking (forall a. T a Int):
143 -- 1. We first bind (a -> AThink kv), where kv is a kind variable.
144 -- 2. Then we kind-check the (T a Int) part.
145 -- 3. Then we zonk the kind variable.
146 -- 4. Now we know the kind for 'a', and we add (a -> ATyVar a::K) to the environment
148 initTcEnv :: PrelNames.SyntaxMap -> HomeSymbolTable -> PackageTypeEnv -> IO TcEnv
149 initTcEnv syntax_map hst pte
150 = do { gtv_var <- newIORef emptyVarSet ;
151 return (TcEnv { tcSyntaxMap = syntax_map,
153 tcGEnv = emptyNameEnv,
154 tcInsts = emptyInstEnv,
155 tcLEnv = emptyNameEnv,
159 lookup name | isLocalName name = Nothing
160 | otherwise = lookupType hst pte name
163 tcEnvClasses env = typeEnvClasses (tcGEnv env)
164 tcEnvTyCons env = typeEnvTyCons (tcGEnv env)
165 tcEnvIds env = typeEnvIds (tcGEnv env)
166 tcEnvTyVars env = [tv | ATyVar tv <- nameEnvElts (tcLEnv env)]
167 tcEnvTcIds env = [id | ATcId id <- nameEnvElts (tcLEnv env)]
169 getTcGEnv (TcEnv { tcGEnv = genv }) = genv
171 tcInLocalScope :: TcEnv -> Name -> Bool
172 tcInLocalScope env v = v `elemNameEnv` (tcLEnv env)
174 -- This data type is used to help tie the knot
175 -- when type checking type and class declarations
176 data TyThingDetails = SynTyDetails Type
177 | DataTyDetails ThetaType [DataCon] [Id]
178 | ClassDetails ThetaType [Id] [ClassOpItem] DataCon
179 | ForeignTyDetails -- Nothing yet
183 %************************************************************************
185 \subsection{Basic lookups}
187 %************************************************************************
190 lookup_global :: TcEnv -> Name -> Maybe TyThing
191 -- Try the global envt and then the global symbol table
192 lookup_global env name
193 = case lookupNameEnv (tcGEnv env) name of
194 Just thing -> Just thing
195 Nothing -> tcGST env name
197 lookup_local :: TcEnv -> Name -> Maybe TcTyThing
198 -- Try the local envt and then try the global
199 lookup_local env name
200 = case lookupNameEnv (tcLEnv env) name of
201 Just thing -> Just thing
202 Nothing -> case lookup_global env name of
203 Just thing -> Just (AGlobal thing)
208 type RecTcEnv = TcEnv
209 -- This environment is used for getting the 'right' IdInfo
210 -- on imported things and for looking up Ids in unfoldings
211 -- The environment doesn't have any local Ids in it
213 tcAddImportedIdInfo :: RecTcEnv -> Id -> Id
214 tcAddImportedIdInfo env id
215 = id `lazySetIdInfo` new_info
216 -- The Id must be returned without a data dependency on maybe_id
218 new_info = case tcLookupRecId_maybe env (idName id) of
219 Nothing -> pprTrace "tcAddIdInfo" (ppr id) vanillaIdInfo
220 Just imported_id -> idInfo imported_id
221 -- ToDo: could check that types are the same
223 tcLookupRecId_maybe :: RecTcEnv -> Name -> Maybe Id
224 tcLookupRecId_maybe env name = case lookup_global env name of
225 Just (AnId id) -> Just id
228 tcLookupRecId :: RecTcEnv -> Name -> Id
229 tcLookupRecId env name = case lookup_global env name of
231 Nothing -> pprPanic "tcLookupRecId" (ppr name)
234 %************************************************************************
236 \subsection{Making new Ids}
238 %************************************************************************
243 newLocalId :: OccName -> TcType -> SrcLoc -> NF_TcM TcId
244 newLocalId name ty loc
245 = tcGetUnique `thenNF_Tc` \ uniq ->
246 returnNF_Tc (mkUserLocal name uniq ty loc)
248 newSpecPragmaId :: Name -> TcType -> NF_TcM TcId
249 newSpecPragmaId name ty
250 = tcGetUnique `thenNF_Tc` \ uniq ->
251 returnNF_Tc (mkSpecPragmaId (nameOccName name) uniq ty (getSrcLoc name))
254 Make a name for the dict fun for an instance decl.
255 It's a *local* name for the moment. The CoreTidy pass
259 newDFunName :: Class -> [Type] -> SrcLoc -> NF_TcM Name
260 newDFunName clas (ty:_) loc
261 = tcGetUnique `thenNF_Tc` \ uniq ->
262 returnNF_Tc (mkLocalName uniq (mkDFunOcc dfun_string) loc)
264 -- Any string that is somewhat unique will do
265 dfun_string = occNameString (getOccName clas) ++ occNameString (getDFunTyKey ty)
267 newDFunName clas [] loc = pprPanic "newDFunName" (ppr clas <+> ppr loc)
271 isLocalThing :: NamedThing a => Module -> a -> Bool
272 isLocalThing mod thing = nameIsLocalOrFrom mod (getName thing)
275 %************************************************************************
277 \subsection{The global environment}
279 %************************************************************************
282 tcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r
283 tcExtendGlobalEnv things thing_inside
284 = tcGetEnv `thenNF_Tc` \ env ->
286 ge' = extendTypeEnvList (tcGEnv env) things
288 tcSetEnv (env {tcGEnv = ge'}) thing_inside
291 tcExtendGlobalTypeEnv :: TypeEnv -> TcM r -> TcM r
292 tcExtendGlobalTypeEnv extra_env thing_inside
293 = tcGetEnv `thenNF_Tc` \ env ->
295 ge' = tcGEnv env `plusNameEnv` extra_env
297 tcSetEnv (env {tcGEnv = ge'}) thing_inside
299 tcExtendGlobalValEnv :: [Id] -> TcM a -> TcM a
300 tcExtendGlobalValEnv ids thing_inside
301 = tcGetEnv `thenNF_Tc` \ env ->
303 ge' = extendTypeEnvWithIds (tcGEnv env) ids
305 tcSetEnv (env {tcGEnv = ge'}) thing_inside
310 tcLookupGlobal_maybe :: Name -> NF_TcM (Maybe TyThing)
311 tcLookupGlobal_maybe name
312 = tcGetEnv `thenNF_Tc` \ env ->
313 returnNF_Tc (lookup_global env name)
316 A variety of global lookups, when we know what we are looking for.
319 tcLookupGlobal :: Name -> NF_TcM TyThing
321 = tcLookupGlobal_maybe name `thenNF_Tc` \ maybe_thing ->
323 Just thing -> returnNF_Tc thing
324 other -> notFound "tcLookupGlobal" name
326 tcLookupGlobalId :: Name -> NF_TcM Id
327 tcLookupGlobalId name
328 = tcLookupGlobal_maybe name `thenNF_Tc` \ maybe_id ->
330 Just (AnId id) -> returnNF_Tc id
331 other -> notFound "tcLookupGlobalId" name
333 tcLookupDataCon :: Name -> TcM DataCon
334 tcLookupDataCon con_name
335 = tcLookupGlobalId con_name `thenNF_Tc` \ con_id ->
336 case isDataConWrapId_maybe con_id of
337 Just data_con -> returnTc data_con
338 Nothing -> failWithTc (badCon con_id)
341 tcLookupClass :: Name -> NF_TcM Class
343 = tcLookupGlobal_maybe name `thenNF_Tc` \ maybe_clas ->
345 Just (AClass clas) -> returnNF_Tc clas
346 other -> notFound "tcLookupClass" name
348 tcLookupTyCon :: Name -> NF_TcM TyCon
350 = tcLookupGlobal_maybe name `thenNF_Tc` \ maybe_tc ->
352 Just (ATyCon tc) -> returnNF_Tc tc
353 other -> notFound "tcLookupTyCon" name
355 tcLookupId :: Name -> NF_TcM Id
357 = tcLookup name `thenNF_Tc` \ thing ->
359 ATcId tc_id -> returnNF_Tc tc_id
360 AGlobal (AnId id) -> returnNF_Tc id
361 other -> pprPanic "tcLookupId" (ppr name)
363 tcLookupLocalIds :: [Name] -> NF_TcM [TcId]
365 = tcGetEnv `thenNF_Tc` \ env ->
366 returnNF_Tc (map (lookup (tcLEnv env)) ns)
368 lookup lenv name = case lookupNameEnv lenv name of
369 Just (ATcId id) -> id
370 other -> pprPanic "tcLookupLocalIds" (ppr name)
372 tcLookupSyntaxId :: Name -> NF_TcM Id
373 -- Lookup a name like PrelNum.fromInt, and return the corresponding Id,
374 -- after mapping through the SyntaxMap. This may give us the Id for
375 -- (say) MyPrelude.fromInteger
376 tcLookupSyntaxId name
377 = tcGetEnv `thenNF_Tc` \ env ->
378 returnNF_Tc (case lookup_global env (tcSyntaxMap env name) of
380 other -> pprPanic "tcLookupSyntaxId" (ppr name))
382 tcLookupSyntaxName :: Name -> NF_TcM Name
383 tcLookupSyntaxName name
384 = tcGetEnv `thenNF_Tc` \ env ->
385 returnNF_Tc (tcSyntaxMap env name)
389 %************************************************************************
391 \subsection{The local environment}
393 %************************************************************************
396 tcLookup_maybe :: Name -> NF_TcM (Maybe TcTyThing)
398 = tcGetEnv `thenNF_Tc` \ env ->
399 returnNF_Tc (lookup_local env name)
401 tcLookup :: Name -> NF_TcM TcTyThing
403 = tcLookup_maybe name `thenNF_Tc` \ maybe_thing ->
405 Just thing -> returnNF_Tc thing
406 other -> notFound "tcLookup" name
407 -- Extract the IdInfo from an IfaceSig imported from an interface file
412 tcExtendKindEnv :: [(Name,TcKind)] -> TcM r -> TcM r
413 tcExtendKindEnv pairs thing_inside
414 = tcGetEnv `thenNF_Tc` \ env ->
416 le' = extendNameEnvList (tcLEnv env) [(n, AThing k) | (n,k) <- pairs]
417 -- No need to extend global tyvars for kind checking
419 tcSetEnv (env {tcLEnv = le'}) thing_inside
421 tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
422 tcExtendTyVarEnv tyvars thing_inside
423 = tcGetEnv `thenNF_Tc` \ env@(TcEnv {tcLEnv = le, tcTyVars = gtvs}) ->
425 le' = extendNameEnvList le [ (getName tv, ATyVar tv) | tv <- tyvars]
426 new_tv_set = mkVarSet tyvars
428 -- It's important to add the in-scope tyvars to the global tyvar set
430 -- f (x::r) = let g y = y::r in ...
431 -- Here, g mustn't be generalised. This is also important during
432 -- class and instance decls, when we mustn't generalise the class tyvars
433 -- when typechecking the methods.
434 tc_extend_gtvs gtvs new_tv_set `thenNF_Tc` \ gtvs' ->
435 tcSetEnv (env {tcLEnv = le', tcTyVars = gtvs'}) thing_inside
437 -- This variant, tcExtendTyVarEnvForMeths, takes *two* bunches of tyvars:
438 -- the signature tyvars contain the original names
439 -- the instance tyvars are what those names should be mapped to
440 -- It's needed when typechecking the method bindings of class and instance decls
441 -- It does *not* extend the global tyvars; tcMethodBind does that for itself
443 tcExtendTyVarEnvForMeths :: [TyVar] -> [TcTyVar] -> TcM r -> TcM r
444 tcExtendTyVarEnvForMeths sig_tyvars inst_tyvars thing_inside
445 = tcGetEnv `thenNF_Tc` \ env ->
447 le' = extendNameEnvList (tcLEnv env) stuff
448 stuff = [ (getName sig_tv, ATyVar inst_tv)
449 | (sig_tv, inst_tv) <- zipEqual "tcMeth" sig_tyvars inst_tyvars
452 tcSetEnv (env {tcLEnv = le'}) thing_inside
457 tcExtendLocalValEnv :: [(Name,TcId)] -> TcM a -> TcM a
458 tcExtendLocalValEnv names_w_ids thing_inside
459 = tcGetEnv `thenNF_Tc` \ env ->
461 extra_global_tyvars = tyVarsOfTypes [idType id | (name,id) <- names_w_ids]
462 extra_env = [(name, ATcId id) | (name,id) <- names_w_ids]
463 le' = extendNameEnvList (tcLEnv env) extra_env
465 tc_extend_gtvs (tcTyVars env) extra_global_tyvars `thenNF_Tc` \ gtvs' ->
466 tcSetEnv (env {tcLEnv = le', tcTyVars = gtvs'}) thing_inside
470 %************************************************************************
472 \subsection{The global tyvars}
474 %************************************************************************
477 tcExtendGlobalTyVars extra_global_tvs thing_inside
478 = tcGetEnv `thenNF_Tc` \ env ->
479 tc_extend_gtvs (tcTyVars env) extra_global_tvs `thenNF_Tc` \ gtvs' ->
480 tcSetEnv (env {tcTyVars = gtvs'}) thing_inside
482 tc_extend_gtvs gtvs extra_global_tvs
483 = tcReadMutVar gtvs `thenNF_Tc` \ global_tvs ->
484 tcNewMutVar (global_tvs `unionVarSet` extra_global_tvs)
487 @tcGetGlobalTyVars@ returns a fully-zonked set of tyvars free in the environment.
488 To improve subsequent calls to the same function it writes the zonked set back into
492 tcGetGlobalTyVars :: NF_TcM TcTyVarSet
494 = tcGetEnv `thenNF_Tc` \ (TcEnv {tcTyVars = gtv_var}) ->
495 tcReadMutVar gtv_var `thenNF_Tc` \ gbl_tvs ->
496 zonkTcTyVarsAndFV (varSetElems gbl_tvs) `thenNF_Tc` \ gbl_tvs' ->
497 tcWriteMutVar gtv_var gbl_tvs' `thenNF_Tc_`
502 %************************************************************************
504 \subsection{The instance environment}
506 %************************************************************************
509 tcGetInstEnv :: NF_TcM InstEnv
510 tcGetInstEnv = tcGetEnv `thenNF_Tc` \ env ->
511 returnNF_Tc (tcInsts env)
513 tcSetInstEnv :: InstEnv -> TcM a -> TcM a
514 tcSetInstEnv ie thing_inside
515 = tcGetEnv `thenNF_Tc` \ env ->
516 tcSetEnv (env {tcInsts = ie}) thing_inside
520 %************************************************************************
522 \subsection{The InstInfo type}
524 %************************************************************************
526 The InstInfo type summarises the information in an instance declaration
528 instance c => k (t tvs) where b
533 iDFunId :: DFunId, -- The dfun id
534 iBinds :: RenamedMonoBinds, -- Bindings, b
535 iPrags :: [RenamedSig] -- User pragmas recorded for generating specialised instances
538 pprInstInfo info = vcat [ptext SLIT("InstInfo:") <+> ppr (idType (iDFunId info)),
539 nest 4 (ppr (iBinds info))]
541 simpleInstInfoTy :: InstInfo -> Type
542 simpleInstInfoTy info = case tcSplitDFunTy (idType (iDFunId info)) of
543 (_, _, _, [ty]) -> ty
545 simpleInstInfoTyCon :: InstInfo -> TyCon
546 -- Gets the type constructor for a simple instance declaration,
547 -- i.e. one of the form instance (...) => C (T a b c) where ...
548 simpleInstInfoTyCon inst = tcTyConAppTyCon (simpleInstInfoTy inst)
552 %************************************************************************
556 %************************************************************************
559 badCon con_id = quotes (ppr con_id) <+> ptext SLIT("is not a data constructor")
561 notFound wheRe name = failWithTc (text wheRe <> colon <+> quotes (ppr name) <+>
562 ptext SLIT("is not in scope"))