0ef74a1f5ac96cdea1c4498914efca0eb268cc57
[ghc.git] / compiler / typecheck / TcEnv.lhs
1 %
2 % (c) The University of Glasgow 2006
3 %
4
5 \begin{code}
6 {-# LANGUAGE CPP, FlexibleInstances #-}
7 {-# OPTIONS_GHC -fno-warn-orphans #-}
8
9 module TcEnv(
10         TyThing(..), TcTyThing(..), TcId,
11
12         -- Instance environment, and InstInfo type
13         InstInfo(..), iDFunId, pprInstInfoDetails,
14         simpleInstInfoClsTy, simpleInstInfoTy, simpleInstInfoTyCon, 
15         InstBindings(..),
16
17         -- Global environment
18         tcExtendGlobalEnv, tcExtendGlobalEnvImplicit, setGlobalTypeEnv,
19         tcExtendGlobalValEnv,
20         tcLookupLocatedGlobal, tcLookupGlobal, 
21         tcLookupField, tcLookupTyCon, tcLookupClass,
22         tcLookupDataCon, tcLookupPatSyn, tcLookupConLike,
23         tcLookupLocatedGlobalId, tcLookupLocatedTyCon,
24         tcLookupLocatedClass, tcLookupInstance, tcLookupAxiom,
25         
26         -- Local environment
27         tcExtendKindEnv, tcExtendKindEnv2,
28         tcExtendTyVarEnv, tcExtendTyVarEnv2, 
29         tcExtendLetEnv,
30         tcExtendIdEnv, tcExtendIdEnv1, tcExtendIdEnv2, 
31         tcExtendIdBndrs, tcExtendGhciIdEnv,
32
33         tcLookup, tcLookupLocated, tcLookupLocalIds, 
34         tcLookupId, tcLookupTyVar, 
35         tcLookupLcl_maybe, 
36         getScopedTyVarBinds, getInLocalScope,
37         wrongThingErr, pprBinders,
38
39         tcExtendRecEnv,         -- For knot-tying
40
41         -- Rules
42          tcExtendRules,
43
44         -- Defaults
45         tcGetDefaultTys,
46
47         -- Global type variables
48         tcGetGlobalTyVars, zapLclTypeEnv,
49
50         -- Template Haskell stuff
51         checkWellStaged, tcMetaTy, thLevel, 
52         topIdLvl, isBrackStage,
53
54         -- New Ids
55         newLocalName, newDFunName, newFamInstTyConName, newFamInstAxiomName,
56         mkStableIdFromString, mkStableIdFromName,
57         mkWrapperName
58   ) where
59
60 #include "HsVersions.h"
61
62 import HsSyn
63 import IfaceEnv
64 import TcRnMonad
65 import TcMType
66 import TcType
67 import TcIface  
68 import PrelNames
69 import TysWiredIn
70 import Id
71 import IdInfo( IdDetails(VanillaId) )
72 import Var
73 import VarSet
74 import RdrName
75 import InstEnv
76 import DataCon ( DataCon )
77 import PatSyn  ( PatSyn )
78 import ConLike
79 import TyCon
80 import CoAxiom
81 import TypeRep
82 import Class
83 import Name
84 import NameEnv
85 import VarEnv
86 import HscTypes
87 import DynFlags
88 import SrcLoc
89 import BasicTypes hiding( SuccessFlag(..) )
90 import Module
91 import Outputable
92 import Encoding
93 import FastString
94 import ListSetOps
95 import Util
96 import Maybes( MaybeErr(..) )
97 import Data.IORef
98 import Data.List
99 \end{code}
100
101
102 %************************************************************************
103 %*                                                                      *
104 %*                      tcLookupGlobal                                  *
105 %*                                                                      *
106 %************************************************************************
107
108 Using the Located versions (eg. tcLookupLocatedGlobal) is preferred,
109 unless you know that the SrcSpan in the monad is already set to the
110 span of the Name.
111
112 \begin{code}
113 tcLookupLocatedGlobal :: Located Name -> TcM TyThing
114 -- c.f. IfaceEnvEnv.tcIfaceGlobal
115 tcLookupLocatedGlobal name
116   = addLocM tcLookupGlobal name
117
118 tcLookupGlobal :: Name -> TcM TyThing
119 -- The Name is almost always an ExternalName, but not always
120 -- In GHCi, we may make command-line bindings (ghci> let x = True)
121 -- that bind a GlobalId, but with an InternalName
122 tcLookupGlobal name
123   = do  {    -- Try local envt
124           env <- getGblEnv
125         ; case lookupNameEnv (tcg_type_env env) name of {
126                 Just thing -> return thing ;
127                 Nothing    ->
128
129                 -- Should it have been in the local envt?
130           if nameIsLocalOrFrom (tcg_mod env) name
131           then notFound name  -- Internal names can happen in GHCi
132           else
133
134            -- Try home package table and external package table
135     do  { mb_thing <- tcLookupImported_maybe name
136         ; case mb_thing of
137             Succeeded thing -> return thing
138             Failed msg      -> failWithTc msg
139         }}}
140
141 tcLookupField :: Name -> TcM Id         -- Returns the selector Id
142 tcLookupField name
143   = tcLookupId name     -- Note [Record field lookup]
144
145 {- Note [Record field lookup]
146    ~~~~~~~~~~~~~~~~~~~~~~~~~~
147 You might think we should have tcLookupGlobal here, since record fields
148 are always top level.  But consider
149         f = e { f = True }
150 Then the renamer (which does not keep track of what is a record selector
151 and what is not) will rename the definition thus
152         f_7 = e { f_7 = True }
153 Now the type checker will find f_7 in the *local* type environment, not
154 the global (imported) one. It's wrong, of course, but we want to report a tidy
155 error, not in TcEnv.notFound.  -}
156
157 tcLookupDataCon :: Name -> TcM DataCon
158 tcLookupDataCon name = do
159     thing <- tcLookupGlobal name
160     case thing of
161         AConLike (RealDataCon con) -> return con
162         _                          -> wrongThingErr "data constructor" (AGlobal thing) name
163
164 tcLookupPatSyn :: Name -> TcM PatSyn
165 tcLookupPatSyn name = do
166     thing <- tcLookupGlobal name
167     case thing of
168         AConLike (PatSynCon ps) -> return ps
169         _                       -> wrongThingErr "pattern synonym" (AGlobal thing) name
170
171 tcLookupConLike :: Name -> TcM ConLike
172 tcLookupConLike name = do
173     thing <- tcLookupGlobal name
174     case thing of
175         AConLike cl -> return cl
176         _           -> wrongThingErr "constructor-like thing" (AGlobal thing) name
177
178 tcLookupClass :: Name -> TcM Class
179 tcLookupClass name = do
180     thing <- tcLookupGlobal name
181     case thing of
182         ATyCon tc | Just cls <- tyConClass_maybe tc -> return cls
183         _                                           -> wrongThingErr "class" (AGlobal thing) name
184
185 tcLookupTyCon :: Name -> TcM TyCon
186 tcLookupTyCon name = do
187     thing <- tcLookupGlobal name
188     case thing of
189         ATyCon tc -> return tc
190         _         -> wrongThingErr "type constructor" (AGlobal thing) name
191
192 tcLookupAxiom :: Name -> TcM (CoAxiom Branched)
193 tcLookupAxiom name = do
194     thing <- tcLookupGlobal name
195     case thing of
196         ACoAxiom ax -> return ax
197         _           -> wrongThingErr "axiom" (AGlobal thing) name
198
199 tcLookupLocatedGlobalId :: Located Name -> TcM Id
200 tcLookupLocatedGlobalId = addLocM tcLookupId
201
202 tcLookupLocatedClass :: Located Name -> TcM Class
203 tcLookupLocatedClass = addLocM tcLookupClass
204
205 tcLookupLocatedTyCon :: Located Name -> TcM TyCon
206 tcLookupLocatedTyCon = addLocM tcLookupTyCon
207
208 -- Find the instance that exactly matches a type class application.  The class arguments must be precisely
209 -- the same as in the instance declaration (modulo renaming).
210 --
211 tcLookupInstance :: Class -> [Type] -> TcM ClsInst
212 tcLookupInstance cls tys
213   = do { instEnv <- tcGetInstEnvs
214        ; case lookupUniqueInstEnv instEnv cls tys of
215            Left err             -> failWithTc $ ptext (sLit "Couldn't match instance:") <+> err 
216            Right (inst, tys) 
217              | uniqueTyVars tys -> return inst
218              | otherwise        -> failWithTc errNotExact
219        }
220   where
221     errNotExact = ptext (sLit "Not an exact match (i.e., some variables get instantiated)")
222     
223     uniqueTyVars tys = all isTyVarTy tys && hasNoDups (map extractTyVar tys)
224       where
225         extractTyVar (TyVarTy tv) = tv
226         extractTyVar _            = panic "TcEnv.tcLookupInstance: extractTyVar"
227
228     -- NB: duplicated to prevent circular dependence on Inst
229     tcGetInstEnvs = do { eps <- getEps; env <- getGblEnv;
230                        ; return (eps_inst_env eps, tcg_inst_env env) 
231                        }
232 \end{code}
233
234 \begin{code}
235 instance MonadThings (IOEnv (Env TcGblEnv TcLclEnv)) where
236     lookupThing = tcLookupGlobal
237 \end{code}
238
239 %************************************************************************
240 %*                                                                      *
241                 Extending the global environment
242 %*                                                                      *
243 %************************************************************************
244
245
246 \begin{code}
247 setGlobalTypeEnv :: TcGblEnv -> TypeEnv -> TcM TcGblEnv
248 -- Use this to update the global type env 
249 -- It updates both  * the normal tcg_type_env field
250 --                  * the tcg_type_env_var field seen by interface files
251 setGlobalTypeEnv tcg_env new_type_env
252   = do  {     -- Sync the type-envt variable seen by interface files
253            writeMutVar (tcg_type_env_var tcg_env) new_type_env
254          ; return (tcg_env { tcg_type_env = new_type_env }) }
255
256
257 tcExtendGlobalEnvImplicit :: [TyThing] -> TcM r -> TcM r
258   -- Extend the global environment with some TyThings that can be obtained
259   -- via implicitTyThings from other entities in the environment.  Examples
260   -- are dfuns, famInstTyCons, data cons, etc.
261   -- These TyThings are not added to tcg_tcs.
262 tcExtendGlobalEnvImplicit things thing_inside
263    = do { tcg_env <- getGblEnv
264         ; let ge'  = extendTypeEnvList (tcg_type_env tcg_env) things
265         ; tcg_env' <- setGlobalTypeEnv tcg_env ge'
266         ; setGblEnv tcg_env' thing_inside }
267
268 tcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r
269   -- Given a mixture of Ids, TyCons, Classes, all defined in the
270   -- module being compiled, extend the global environment
271 tcExtendGlobalEnv things thing_inside
272   = do { env <- getGblEnv
273        ; let env' = env { tcg_tcs = [tc | ATyCon tc <- things] ++ tcg_tcs env,
274                           tcg_patsyns = [ps | AConLike (PatSynCon ps) <- things] ++ tcg_patsyns env }
275        ; setGblEnv env' $
276             tcExtendGlobalEnvImplicit things thing_inside
277        }
278
279 tcExtendGlobalValEnv :: [Id] -> TcM a -> TcM a
280   -- Same deal as tcExtendGlobalEnv, but for Ids
281 tcExtendGlobalValEnv ids thing_inside 
282   = tcExtendGlobalEnvImplicit [AnId id | id <- ids] thing_inside
283
284 tcExtendRecEnv :: [(Name,TyThing)] -> TcM r -> TcM r
285 -- Extend the global environments for the type/class knot tying game
286 -- Just like tcExtendGlobalEnv, except the argument is a list of pairs
287 tcExtendRecEnv gbl_stuff thing_inside
288  = do  { tcg_env <- getGblEnv
289        ; let ge' = extendNameEnvList (tcg_type_env tcg_env) gbl_stuff 
290        ; tcg_env' <- setGlobalTypeEnv tcg_env ge'
291        ; setGblEnv tcg_env' thing_inside }
292 \end{code}
293
294
295 %************************************************************************
296 %*                                                                      *
297 \subsection{The local environment}
298 %*                                                                      *
299 %************************************************************************
300
301 \begin{code}
302 tcLookupLocated :: Located Name -> TcM TcTyThing
303 tcLookupLocated = addLocM tcLookup
304
305 tcLookupLcl_maybe :: Name -> TcM (Maybe TcTyThing)
306 tcLookupLcl_maybe name
307   = do { local_env <- getLclTypeEnv
308        ; return (lookupNameEnv local_env name) }
309
310 tcLookup :: Name -> TcM TcTyThing
311 tcLookup name = do
312     local_env <- getLclTypeEnv
313     case lookupNameEnv local_env name of
314         Just thing -> return thing
315         Nothing    -> AGlobal <$> tcLookupGlobal name
316
317 tcLookupTyVar :: Name -> TcM TcTyVar
318 tcLookupTyVar name
319   = do { thing <- tcLookup name
320        ; case thing of
321            ATyVar _ tv -> return tv
322            _           -> pprPanic "tcLookupTyVar" (ppr name) }
323
324 tcLookupId :: Name -> TcM Id
325 -- Used when we aren't interested in the binding level, nor refinement. 
326 -- The "no refinement" part means that we return the un-refined Id regardless
327 -- 
328 -- The Id is never a DataCon. (Why does that matter? see TcExpr.tcId)
329 tcLookupId name = do
330     thing <- tcLookup name
331     case thing of
332         ATcId { tct_id = id} -> return id
333         AGlobal (AnId id)    -> return id
334         _                    -> pprPanic "tcLookupId" (ppr name)
335
336 tcLookupLocalIds :: [Name] -> TcM [TcId]
337 -- We expect the variables to all be bound, and all at
338 -- the same level as the lookup.  Only used in one place...
339 tcLookupLocalIds ns 
340   = do { env <- getLclEnv
341        ; return (map (lookup (tcl_env env)) ns) }
342   where
343     lookup lenv name 
344         = case lookupNameEnv lenv name of
345                 Just (ATcId { tct_id = id }) ->  id
346                 _ -> pprPanic "tcLookupLocalIds" (ppr name)
347
348 getInLocalScope :: TcM (Name -> Bool)
349   -- Ids only
350 getInLocalScope = do { lcl_env <- getLclTypeEnv
351                      ; return (`elemNameEnv` lcl_env) }
352 \end{code}
353
354 \begin{code}
355 tcExtendKindEnv2 :: [(Name, TcTyThing)] -> TcM r -> TcM r
356 -- Used only during kind checking, for TcThings that are
357 --      AThing or APromotionErr
358 -- No need to update the global tyvars, or tcl_th_bndrs, or tcl_rdr
359 tcExtendKindEnv2 things thing_inside
360   = updLclEnv upd_env thing_inside
361   where
362     upd_env env = env { tcl_env = extendNameEnvList (tcl_env env) things }
363
364 tcExtendKindEnv :: [(Name, TcKind)] -> TcM r -> TcM r
365 tcExtendKindEnv name_kind_prs
366   = tcExtendKindEnv2 [(n, AThing k) | (n,k) <- name_kind_prs]
367
368 -----------------------
369 -- Scoped type and kind variables
370 tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
371 tcExtendTyVarEnv tvs thing_inside
372   = tcExtendTyVarEnv2 [(tyVarName tv, tv) | tv <- tvs] thing_inside
373
374 tcExtendTyVarEnv2 :: [(Name,TcTyVar)] -> TcM r -> TcM r
375 tcExtendTyVarEnv2 binds thing_inside
376   = do { stage <- getStage
377        ; tc_extend_local_env (NotTopLevel, thLevel stage)
378                     [(name, ATyVar name tv) | (name, tv) <- binds] $
379          do { env <- getLclEnv
380             ; let env' = env { tcl_tidy = add_tidy_tvs (tcl_tidy env) }
381             ; setLclEnv env' thing_inside }}
382   where
383     add_tidy_tvs env = foldl add env binds
384
385     -- We initialise the "tidy-env", used for tidying types before printing,
386     -- by building a reverse map from the in-scope type variables to the
387     -- OccName that the programmer originally used for them
388     add :: TidyEnv -> (Name, TcTyVar) -> TidyEnv
389     add (env,subst) (name, tyvar)
390         = case tidyOccName env (nameOccName name) of
391             (env', occ') ->  (env', extendVarEnv subst tyvar tyvar')
392                 where
393                   tyvar' = setTyVarName tyvar name'
394                   name'  = tidyNameOcc name occ'
395
396 getScopedTyVarBinds :: TcM [(Name, TcTyVar)]
397 getScopedTyVarBinds
398   = do  { lcl_env <- getLclEnv
399         ; return [(name, tv) | ATyVar name tv <- nameEnvElts (tcl_env lcl_env)] }
400 \end{code}
401
402 Note [Initialising the type environment for GHCi]
403 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
404 tcExtendGhciIdEnv extends the local type environemnt with GHCi
405 identifiers (from ic_tythings), bound earlier in the interaction.
406 They may have free type variables (RuntimeUnk things), and if we don't
407 register these free TyVars as global TyVars then the typechecker will
408 try to quantify over them and fall over in zonkQuantifiedTyVar.
409 So we must add any free TyVars to the typechecker's global
410 TyVar set.  That is most conveniently done here, using the local function
411 tcExtendLocalTypeEnv.
412
413 Note especially that
414
415  * tcExtendGhciIdEnv extends the local type env, tcl_env
416    That's important because some are not closed (ie have free tyvars)
417    and the compiler assumes that the global type env (tcg_type_env) has
418    no free tyvars.  Actually, only ones with Internal names can be non-closed
419    so we jsut add those
420
421  * The tct_closed flag depends on whether the thing has free (RuntimeUnk)
422    type variables
423
424  * It will also does tcExtendGlobalTyVars; this is important
425    because of those RuntimeUnk variables
426
427  * It does not extend the local RdrEnv (tcl_rdr), because the things are
428    already in the GlobalRdrEnv.  Extending the local RdrEnv isn't terrible,
429    but it means there is an entry for the same Name in both global and local
430    RdrEnvs, and that lead to duplicate "perhaps you meant..." suggestions
431    (e.g. T5564).
432
433    We don't bother with the tcl_th_bndrs environment either.
434
435  * NB: all these TcTyThings will be in the global type envt (tcg_type_env) as
436        well.  We are just shadowing them here to deal with the global tyvar
437        stuff.  That's why we can simply drop the External-Name ones; they
438        will be found in the global envt
439
440 \begin{code}
441 tcExtendGhciIdEnv :: [TyThing] -> TcM a -> TcM a
442 -- Used to bind Ids for GHCi identifiers bound earlier in the user interaction
443 -- See Note [Initialising the type environment for GHCi]
444 tcExtendGhciIdEnv ids thing_inside
445   = do { lcl_env <- tcExtendLocalTypeEnv tc_ty_things
446        ; setLclEnv lcl_env thing_inside }
447   where
448     tc_ty_things =  [ (name, ATcId { tct_id     = id
449                                    , tct_closed = is_top id })
450                     | AnId id <- ids
451                     , let name = idName id
452                     , isInternalName name ]
453     is_top id | isEmptyVarSet (tyVarsOfType (idType id)) = TopLevel
454               | otherwise                                = NotTopLevel
455
456 tcExtendLetEnv :: TopLevelFlag -> TopLevelFlag -> [TcId] -> TcM a -> TcM a
457 -- Used for both top-level value bindings and and nested let/where-bindings
458 tcExtendLetEnv top_lvl closed ids thing_inside
459   = do  { stage <- getStage
460         ; tc_extend_local_env (top_lvl, thLevel stage)
461                               [ (idName id, ATcId { tct_id = id
462                                                   , tct_closed = closed })
463                               | id <- ids] $
464           tcExtendIdBndrs [TcIdBndr id top_lvl | id <- ids] thing_inside }
465
466 tcExtendIdEnv :: [TcId] -> TcM a -> TcM a
467 tcExtendIdEnv ids thing_inside 
468   = tcExtendIdEnv2 [(idName id, id) | id <- ids] $
469     tcExtendIdBndrs [TcIdBndr id NotTopLevel | id <- ids] 
470     thing_inside
471
472 tcExtendIdEnv1 :: Name -> TcId -> TcM a -> TcM a
473 tcExtendIdEnv1 name id thing_inside 
474   = tcExtendIdEnv2 [(name,id)] $
475     tcExtendIdBndrs [TcIdBndr id NotTopLevel]
476     thing_inside
477
478 tcExtendIdEnv2 :: [(Name,TcId)] -> TcM a -> TcM a
479 -- Do *not* extend the tcl_bndrs stack
480 -- The tct_closed flag really doesn't matter
481 -- Invariant: the TcIds are fully zonked (see tcExtendIdEnv above)
482 tcExtendIdEnv2 names_w_ids thing_inside
483   = do  { stage <- getStage
484         ; tc_extend_local_env (NotTopLevel, thLevel stage)
485                               [ (name, ATcId { tct_id = id 
486                                              , tct_closed = NotTopLevel })
487                               | (name,id) <- names_w_ids] $
488           thing_inside }
489
490 tcExtendIdBndrs :: [TcIdBinder] -> TcM a -> TcM a
491 tcExtendIdBndrs bndrs = updLclEnv (\env -> env { tcl_bndrs = bndrs ++ tcl_bndrs env })
492
493 tc_extend_local_env :: (TopLevelFlag, ThLevel) -> [(Name, TcTyThing)] -> TcM a -> TcM a
494 -- Precondition: the argument list extra_env has TcTyThings
495 --               that ATcId or ATyVar, but nothing else
496 --
497 -- Invariant: the ATcIds are fully zonked. Reasons:
498 --      (a) The kinds of the forall'd type variables are defaulted
499 --          (see Kind.defaultKind, done in zonkQuantifiedTyVar)
500 --      (b) There are no via-Indirect occurrences of the bound variables
501 --          in the types, because instantiation does not look through such things
502 --      (c) The call to tyVarsOfTypes is ok without looking through refs
503
504 tc_extend_local_env thlvl extra_env thing_inside
505   = do  { traceTc "env2" (ppr extra_env)
506         ; env1 <- tcExtendLocalTypeEnv extra_env
507         ; let env2 = extend_local_env thlvl extra_env env1
508         ; setLclEnv env2 thing_inside }
509   where
510     extend_local_env :: (TopLevelFlag, ThLevel) -> [(Name, TcTyThing)] -> TcLclEnv -> TcLclEnv
511     -- Extend the local LocalRdrEnv and Template Haskell staging env simultaneously
512     -- Reason for extending LocalRdrEnv: after running a TH splice we need
513     -- to do renaming.
514     extend_local_env thlvl pairs env@(TcLclEnv { tcl_rdr = rdr_env
515                                                , tcl_th_bndrs = th_bndrs })
516       = env { tcl_rdr      = extendLocalRdrEnvList rdr_env
517                                 [ n | (n, _) <- pairs, isInternalName n ]
518                                 -- The LocalRdrEnv contains only non-top-level names
519                                 -- (GlobalRdrEnv handles the top level)
520             , tcl_th_bndrs = extendNameEnvList th_bndrs  -- We only track Ids in tcl_th_bndrs
521                                  [(n, thlvl) | (n, ATcId {}) <- pairs] }
522
523 tcExtendLocalTypeEnv :: [(Name, TcTyThing)] -> TcM TcLclEnv
524 tcExtendLocalTypeEnv tc_ty_things
525   | isEmptyVarSet extra_tvs
526   = do { lcl_env@(TcLclEnv { tcl_env = lcl_type_env }) <- getLclEnv
527        ; return (lcl_env { tcl_env = extendNameEnvList lcl_type_env tc_ty_things } ) }
528   | otherwise
529   = do { lcl_env@(TcLclEnv { tcl_env = lcl_type_env }) <- getLclEnv
530        ; global_tvs <- readMutVar (tcl_tyvars lcl_env)
531        ; new_g_var  <- newMutVar (global_tvs `unionVarSet` extra_tvs)
532        ; return (lcl_env { tcl_tyvars = new_g_var
533                          , tcl_env = extendNameEnvList lcl_type_env tc_ty_things } ) }
534   where
535     extra_tvs = foldr get_tvs emptyVarSet tc_ty_things
536
537     get_tvs (_, ATcId { tct_id = id, tct_closed = closed }) tvs
538       = case closed of
539           TopLevel    -> ASSERT2( isEmptyVarSet (tyVarsOfType (idType id)), ppr id $$ ppr (idType id) )
540                          tvs
541           NotTopLevel -> tvs `unionVarSet` tyVarsOfType (idType id)
542
543     get_tvs (_, ATyVar _ tv) tvs          -- See Note [Global TyVars]
544       = tvs `unionVarSet` tyVarsOfType (tyVarKind tv) `extendVarSet` tv
545
546     get_tvs (_, AThing k) tvs = tvs `unionVarSet` tyVarsOfType k
547
548     get_tvs (_, AGlobal {})       tvs = tvs
549     get_tvs (_, APromotionErr {}) tvs = tvs
550
551         -- Note [Global TyVars]
552         -- It's important to add the in-scope tyvars to the global tyvar set
553         -- as well.  Consider
554         --      f (_::r) = let g y = y::r in ...
555         -- Here, g mustn't be generalised.  This is also important during
556         -- class and instance decls, when we mustn't generalise the class tyvars
557         -- when typechecking the methods.
558         --
559         -- Nor must we generalise g over any kind variables free in r's kind
560
561 zapLclTypeEnv :: TcM a -> TcM a
562 zapLclTypeEnv thing_inside
563   = do { tvs_var <- newTcRef emptyVarSet
564        ; let upd env = env { tcl_env = emptyNameEnv
565                            , tcl_rdr = emptyLocalRdrEnv
566                            , tcl_tyvars = tvs_var }
567        ; updLclEnv upd thing_inside }
568 \end{code}
569
570
571 %************************************************************************
572 %*                                                                      *
573 \subsection{Rules}
574 %*                                                                      *
575 %************************************************************************
576
577 \begin{code}
578 tcExtendRules :: [LRuleDecl Id] -> TcM a -> TcM a
579         -- Just pop the new rules into the EPS and envt resp
580         -- All the rules come from an interface file, not source
581         -- Nevertheless, some may be for this module, if we read
582         -- its interface instead of its source code
583 tcExtendRules lcl_rules thing_inside
584  = do { env <- getGblEnv
585       ; let
586           env' = env { tcg_rules = lcl_rules ++ tcg_rules env }
587       ; setGblEnv env' thing_inside }
588 \end{code}
589
590
591 %************************************************************************
592 %*                                                                      *
593                 Meta level
594 %*                                                                      *
595 %************************************************************************
596
597 \begin{code}
598 checkWellStaged :: SDoc         -- What the stage check is for
599                 -> ThLevel      -- Binding level (increases inside brackets)
600                 -> ThLevel      -- Use stage
601                 -> TcM ()       -- Fail if badly staged, adding an error
602 checkWellStaged pp_thing bind_lvl use_lvl
603   | use_lvl >= bind_lvl         -- OK! Used later than bound
604   = return ()                   -- E.g.  \x -> [| $(f x) |]
605
606   | bind_lvl == outerLevel      -- GHC restriction on top level splices
607   = stageRestrictionError pp_thing
608
609   | otherwise                   -- Badly staged
610   = failWithTc $                -- E.g.  \x -> $(f x)
611     ptext (sLit "Stage error:") <+> pp_thing <+> 
612         hsep   [ptext (sLit "is bound at stage") <+> ppr bind_lvl,
613                 ptext (sLit "but used at stage") <+> ppr use_lvl]
614
615 stageRestrictionError :: SDoc -> TcM a
616 stageRestrictionError pp_thing
617   = failWithTc $ 
618     sep [ ptext (sLit "GHC stage restriction:")
619         , nest 2 (vcat [ pp_thing <+> ptext (sLit "is used in a top-level splice or annotation,")
620                        , ptext (sLit "and must be imported, not defined locally")])]
621
622 topIdLvl :: Id -> ThLevel
623 -- Globals may either be imported, or may be from an earlier "chunk" 
624 -- (separated by declaration splices) of this module.  The former
625 --  *can* be used inside a top-level splice, but the latter cannot.
626 -- Hence we give the former impLevel, but the latter topLevel
627 -- E.g. this is bad:
628 --      x = [| foo |]
629 --      $( f x )
630 -- By the time we are prcessing the $(f x), the binding for "x" 
631 -- will be in the global env, not the local one.
632 topIdLvl id | isLocalId id = outerLevel
633             | otherwise    = impLevel
634
635 tcMetaTy :: Name -> TcM Type
636 -- Given the name of a Template Haskell data type, 
637 -- return the type
638 -- E.g. given the name "Expr" return the type "Expr"
639 tcMetaTy tc_name = do
640     t <- tcLookupTyCon tc_name
641     return (mkTyConApp t [])
642
643 isBrackStage :: ThStage -> Bool
644 isBrackStage (Brack {}) = True
645 isBrackStage _other     = False
646 \end{code}
647
648
649 %************************************************************************
650 %*                                                                      *
651                  getDefaultTys                                                                          
652 %*                                                                      *
653 %************************************************************************
654
655 \begin{code}
656 tcGetDefaultTys :: TcM ([Type], -- Default types
657                         (Bool,  -- True <=> Use overloaded strings
658                          Bool)) -- True <=> Use extended defaulting rules
659 tcGetDefaultTys
660   = do  { dflags <- getDynFlags
661         ; let ovl_strings = xopt Opt_OverloadedStrings dflags
662               extended_defaults = xopt Opt_ExtendedDefaultRules dflags
663                                         -- See also Trac #1974 
664               flags = (ovl_strings, extended_defaults)
665     
666         ; mb_defaults <- getDeclaredDefaultTys
667         ; case mb_defaults of {
668            Just tys -> return (tys, flags) ;
669                                 -- User-supplied defaults
670            Nothing  -> do
671
672         -- No use-supplied default
673         -- Use [Integer, Double], plus modifications
674         { integer_ty <- tcMetaTy integerTyConName
675         ; checkWiredInTyCon doubleTyCon
676         ; string_ty <- tcMetaTy stringTyConName
677         ; let deflt_tys = opt_deflt extended_defaults unitTy  -- Note [Default unitTy]
678                           ++ [integer_ty, doubleTy]
679                           ++ opt_deflt ovl_strings string_ty
680         ; return (deflt_tys, flags) } } }
681   where
682     opt_deflt True  ty = [ty]
683     opt_deflt False _  = []
684 \end{code}
685
686 Note [Default unitTy]
687 ~~~~~~~~~~~~~~~~~~~~~
688 In interative mode (or with -XExtendedDefaultRules) we add () as the first type we
689 try when defaulting.  This has very little real impact, except in the following case.
690 Consider: 
691         Text.Printf.printf "hello"
692 This has type (forall a. IO a); it prints "hello", and returns 'undefined'.  We don't
693 want the GHCi repl loop to try to print that 'undefined'.  The neatest thing is to
694 default the 'a' to (), rather than to Integer (which is what would otherwise happen;
695 and then GHCi doesn't attempt to print the ().  So in interactive mode, we add
696 () to the list of defaulting types.  See Trac #1200.
697
698
699 %************************************************************************
700 %*                                                                      *
701 \subsection{The InstInfo type}
702 %*                                                                      *
703 %************************************************************************
704
705 The InstInfo type summarises the information in an instance declaration
706
707     instance c => k (t tvs) where b
708
709 It is used just for *local* instance decls (not ones from interface files).
710 But local instance decls includes
711         - derived ones
712         - generic ones
713 as well as explicit user written ones.
714
715 \begin{code}
716 data InstInfo a
717   = InstInfo {
718       iSpec   :: ClsInst,        -- Includes the dfun id.  Its forall'd type
719       iBinds  :: InstBindings a   -- variables scope over the stuff in InstBindings!
720     }
721
722 iDFunId :: InstInfo a -> DFunId
723 iDFunId info = instanceDFunId (iSpec info)
724
725 data InstBindings a
726   = InstBindings
727       { ib_tyvars  :: [Name]        -- Names of the tyvars from the instance head
728                                     -- that are lexically in scope in the bindings
729
730       , ib_binds   :: (LHsBinds a)  -- Bindings for the instance methods
731
732       , ib_pragmas :: [LSig a]      -- User pragmas recorded for generating
733                                     -- specialised instances
734
735       , ib_extensions :: [ExtensionFlag] -- Any extra extensions that should
736                                          -- be enabled when type-checking this
737                                          -- instance; needed for
738                                          -- GeneralizedNewtypeDeriving
739
740       , ib_derived :: Bool
741            -- True <=> This code was generated by GHC from a deriving clause
742            --          or standalone deriving declaration
743            -- Used only to improve error messages
744       }
745
746 instance OutputableBndr a => Outputable (InstInfo a) where
747     ppr = pprInstInfoDetails
748
749 pprInstInfoDetails :: OutputableBndr a => InstInfo a -> SDoc
750 pprInstInfoDetails info
751    = hang (pprInstanceHdr (iSpec info) <+> ptext (sLit "where"))
752         2 (details (iBinds info))
753   where
754     details (InstBindings { ib_binds = b }) = pprLHsBinds b
755
756 simpleInstInfoClsTy :: InstInfo a -> (Class, Type)
757 simpleInstInfoClsTy info = case instanceHead (iSpec info) of
758                            (_, cls, [ty]) -> (cls, ty)
759                            _ -> panic "simpleInstInfoClsTy"
760
761 simpleInstInfoTy :: InstInfo a -> Type
762 simpleInstInfoTy info = snd (simpleInstInfoClsTy info)
763
764 simpleInstInfoTyCon :: InstInfo a -> TyCon
765   -- Gets the type constructor for a simple instance declaration,
766   -- i.e. one of the form       instance (...) => C (T a b c) where ...
767 simpleInstInfoTyCon inst = tcTyConAppTyCon (simpleInstInfoTy inst)
768 \end{code}
769
770 Make a name for the dict fun for an instance decl.  It's an *external*
771 name, like otber top-level names, and hence must be made with newGlobalBinder.
772
773 \begin{code}
774 newDFunName :: Class -> [Type] -> SrcSpan -> TcM Name
775 newDFunName clas tys loc
776   = do  { is_boot <- tcIsHsBootOrSig
777         ; mod     <- getModule
778         ; let info_string = occNameString (getOccName clas) ++ 
779                             concatMap (occNameString.getDFunTyKey) tys
780         ; dfun_occ <- chooseUniqueOccTc (mkDFunOcc info_string is_boot)
781         ; newGlobalBinder mod dfun_occ loc }
782 \end{code}
783
784 Make a name for the representation tycon of a family instance.  It's an
785 *external* name, like other top-level names, and hence must be made with
786 newGlobalBinder.
787
788 \begin{code}
789 newFamInstTyConName :: Located Name -> [Type] -> TcM Name
790 newFamInstTyConName (L loc name) tys = mk_fam_inst_name id loc name [tys]
791
792 newFamInstAxiomName :: SrcSpan -> Name -> [CoAxBranch] -> TcM Name
793 newFamInstAxiomName loc name branches
794   = mk_fam_inst_name mkInstTyCoOcc loc name (map coAxBranchLHS branches)
795
796 mk_fam_inst_name :: (OccName -> OccName) -> SrcSpan -> Name -> [[Type]] -> TcM Name
797 mk_fam_inst_name adaptOcc loc tc_name tyss
798   = do  { mod   <- getModule
799         ; let info_string = occNameString (getOccName tc_name) ++ 
800                             intercalate "|" ty_strings
801         ; occ   <- chooseUniqueOccTc (mkInstTyTcOcc info_string)
802         ; newGlobalBinder mod (adaptOcc occ) loc }
803   where
804     ty_strings = map (concatMap (occNameString . getDFunTyKey)) tyss
805 \end{code}
806
807 Stable names used for foreign exports and annotations.
808 For stable names, the name must be unique (see #1533).  If the
809 same thing has several stable Ids based on it, the
810 top-level bindings generated must not have the same name.
811 Hence we create an External name (doesn't change), and we
812 append a Unique to the string right here.
813
814 \begin{code}
815 mkStableIdFromString :: String -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
816 mkStableIdFromString str sig_ty loc occ_wrapper = do
817     uniq <- newUnique
818     mod <- getModule
819     name <- mkWrapperName "stable" str
820     let occ = mkVarOccFS name :: OccName
821         gnm = mkExternalName uniq mod (occ_wrapper occ) loc :: Name
822         id  = mkExportedLocalId VanillaId gnm sig_ty :: Id
823     return id
824
825 mkStableIdFromName :: Name -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
826 mkStableIdFromName nm = mkStableIdFromString (getOccString nm)
827 \end{code}
828
829 \begin{code}
830 mkWrapperName :: (MonadIO m, HasDynFlags m, HasModule m)
831               => String -> String -> m FastString
832 mkWrapperName what nameBase
833     = do dflags <- getDynFlags
834          thisMod <- getModule
835          let -- Note [Generating fresh names for ccall wrapper]
836              wrapperRef = nextWrapperNum dflags
837              pkg = packageKeyString  (modulePackageKey thisMod)
838              mod = moduleNameString (moduleName      thisMod)
839          wrapperNum <- liftIO $ atomicModifyIORef wrapperRef $ \mod_env ->
840              let num = lookupWithDefaultModuleEnv mod_env 0 thisMod
841                  mod_env' = extendModuleEnv mod_env thisMod (num+1)
842              in (mod_env', num)
843          let components = [what, show wrapperNum, pkg, mod, nameBase]
844          return $ mkFastString $ zEncodeString $ intercalate ":" components
845
846 {-
847 Note [Generating fresh names for FFI wrappers]
848
849 We used to use a unique, rather than nextWrapperNum, to distinguish
850 between FFI wrapper functions. However, the wrapper names that we
851 generate are external names. This means that if a call to them ends up
852 in an unfolding, then we can't alpha-rename them, and thus if the
853 unique randomly changes from one compile to another then we get a
854 spurious ABI change (#4012).
855
856 The wrapper counter has to be per-module, not global, so that the number we end
857 up using is not dependent on the modules compiled before the current one.
858 -}
859 \end{code}
860
861 %************************************************************************
862 %*                                                                      *
863 \subsection{Errors}
864 %*                                                                      *
865 %************************************************************************
866
867 \begin{code}
868 pprBinders :: [Name] -> SDoc
869 -- Used in error messages
870 -- Use quotes for a single one; they look a bit "busy" for several
871 pprBinders [bndr] = quotes (ppr bndr)
872 pprBinders bndrs  = pprWithCommas ppr bndrs
873
874 notFound :: Name -> TcM TyThing
875 notFound name 
876   = do { lcl_env <- getLclEnv
877        ; let stage = tcl_th_ctxt lcl_env
878        ; case stage of   -- See Note [Out of scope might be a staging error]
879            Splice {} -> stageRestrictionError (quotes (ppr name))
880            _ -> failWithTc $
881                 vcat[ptext (sLit "GHC internal error:") <+> quotes (ppr name) <+> 
882                      ptext (sLit "is not in scope during type checking, but it passed the renamer"),
883                      ptext (sLit "tcl_env of environment:") <+> ppr (tcl_env lcl_env)]
884                        -- Take case: printing the whole gbl env can
885                        -- cause an infinite loop, in the case where we
886                        -- are in the middle of a recursive TyCon/Class group;
887                        -- so let's just not print it!  Getting a loop here is
888                        -- very unhelpful, because it hides one compiler bug with another
889        }
890
891 wrongThingErr :: String -> TcTyThing -> Name -> TcM a
892 -- It's important that this only calls pprTcTyThingCategory, which in 
893 -- turn does not look at the details of the TcTyThing.
894 -- See Note [Placeholder PatSyn kinds] in TcBinds
895 wrongThingErr expected thing name
896   = failWithTc (pprTcTyThingCategory thing <+> quotes (ppr name) <+> 
897                 ptext (sLit "used as a") <+> text expected)
898 \end{code}
899
900 Note [Out of scope might be a staging error]
901 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
902 Consider
903   x = 3
904   data T = MkT $(foo x)
905
906 This is really a staging error, because we can't run code involving 'x'.
907 But in fact the type checker processes types first, so 'x' won't even be
908 in the type envt when we look for it in $(foo x).  So inside splices we
909 report something missing from the type env as a staging error.
910 See Trac #5752 and #5795.