Implement Partial Type Signatures
[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, tcExtendIdEnv3,
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 emptyVarSet
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   = tcExtendIdEnv3 names_w_ids emptyVarSet thing_inside
484
485 -- | 'tcExtendIdEnv2', but don't bind the 'TcId's in the 'TyVarSet' argument.
486 tcExtendIdEnv3 :: [(Name,TcId)] -> TyVarSet -> TcM a -> TcM a
487 -- Invariant: the TcIds are fully zonked (see tcExtendIdEnv above)
488 tcExtendIdEnv3 names_w_ids not_actually_free thing_inside
489   = do  { stage <- getStage
490         ; tc_extend_local_env2 (NotTopLevel, thLevel stage)
491                               [ (name, ATcId { tct_id = id
492                                              , tct_closed = NotTopLevel })
493                               | (name,id) <- names_w_ids] not_actually_free $
494           thing_inside }
495
496 tcExtendIdBndrs :: [TcIdBinder] -> TcM a -> TcM a
497 tcExtendIdBndrs bndrs = updLclEnv (\env -> env { tcl_bndrs = bndrs ++ tcl_bndrs env })
498
499 tc_extend_local_env :: (TopLevelFlag, ThLevel) -> [(Name, TcTyThing)] -> TcM a -> TcM a
500 tc_extend_local_env thlvl extra_env thing_inside =
501   tc_extend_local_env2 thlvl extra_env emptyVarSet thing_inside
502
503 tc_extend_local_env2 :: (TopLevelFlag, ThLevel) -> [(Name, TcTyThing)]
504                      -> TyVarSet -> TcM a -> TcM a
505 tc_extend_local_env2 thlvl extra_env not_actually_free thing_inside
506 -- Precondition: the argument list extra_env has TcTyThings
507 --               that ATcId or ATyVar, but nothing else
508 --
509 -- Invariant: the ATcIds are fully zonked. Reasons:
510 --      (a) The kinds of the forall'd type variables are defaulted
511 --          (see Kind.defaultKind, done in zonkQuantifiedTyVar)
512 --      (b) There are no via-Indirect occurrences of the bound variables
513 --          in the types, because instantiation does not look through such things
514 --      (c) The call to tyVarsOfTypes is ok without looking through refs
515
516 -- The second argument of type TyVarSet is a set of type variables
517 -- that are bound together with extra_env and should not be regarded
518 -- as free in the types of extra_env.
519   = do  { traceTc "env2" (ppr extra_env)
520         ; env1 <- tcExtendLocalTypeEnv extra_env not_actually_free
521         ; let env2 = extend_local_env thlvl extra_env env1
522         ; setLclEnv env2 thing_inside }
523   where
524     extend_local_env :: (TopLevelFlag, ThLevel) -> [(Name, TcTyThing)] -> TcLclEnv -> TcLclEnv
525     -- Extend the local LocalRdrEnv and Template Haskell staging env simultaneously
526     -- Reason for extending LocalRdrEnv: after running a TH splice we need
527     -- to do renaming.
528     extend_local_env thlvl pairs env@(TcLclEnv { tcl_rdr = rdr_env
529                                                , tcl_th_bndrs = th_bndrs })
530       = env { tcl_rdr      = extendLocalRdrEnvList rdr_env
531                                 [ n | (n, _) <- pairs, isInternalName n ]
532                                 -- The LocalRdrEnv contains only non-top-level names
533                                 -- (GlobalRdrEnv handles the top level)
534             , tcl_th_bndrs = extendNameEnvList th_bndrs  -- We only track Ids in tcl_th_bndrs
535                                  [(n, thlvl) | (n, ATcId {}) <- pairs] }
536
537 tcExtendLocalTypeEnv :: [(Name, TcTyThing)] -> TyVarSet -> TcM TcLclEnv
538 tcExtendLocalTypeEnv tc_ty_things not_actually_free
539   | isEmptyVarSet extra_tvs
540   = do { lcl_env@(TcLclEnv { tcl_env = lcl_type_env }) <- getLclEnv
541        ; return (lcl_env { tcl_env = extendNameEnvList lcl_type_env tc_ty_things } ) }
542   | otherwise
543   = do { lcl_env@(TcLclEnv { tcl_env = lcl_type_env }) <- getLclEnv
544        ; global_tvs <- readMutVar (tcl_tyvars lcl_env)
545        ; new_g_var  <- newMutVar (global_tvs `unionVarSet` extra_tvs)
546        ; return (lcl_env { tcl_tyvars = new_g_var
547                          , tcl_env = extendNameEnvList lcl_type_env tc_ty_things } ) }
548   where
549     extra_tvs = foldr get_tvs emptyVarSet tc_ty_things `minusVarSet` not_actually_free
550
551     get_tvs (_, ATcId { tct_id = id, tct_closed = closed }) tvs
552       = case closed of
553           TopLevel    -> ASSERT2( isEmptyVarSet id_tvs, ppr id $$ ppr (idType id) )
554                          tvs
555           NotTopLevel -> tvs `unionVarSet` id_tvs
556         where id_tvs = tyVarsOfType (idType id)
557
558     get_tvs (_, ATyVar _ tv) tvs          -- See Note [Global TyVars]
559       = tvs `unionVarSet` tyVarsOfType (tyVarKind tv) `extendVarSet` tv
560
561     get_tvs (_, AThing k) tvs = tvs `unionVarSet` tyVarsOfType k
562
563     get_tvs (_, AGlobal {})       tvs = tvs
564     get_tvs (_, APromotionErr {}) tvs = tvs
565
566         -- Note [Global TyVars]
567         -- It's important to add the in-scope tyvars to the global tyvar set
568         -- as well.  Consider
569         --      f (_::r) = let g y = y::r in ...
570         -- Here, g mustn't be generalised.  This is also important during
571         -- class and instance decls, when we mustn't generalise the class tyvars
572         -- when typechecking the methods.
573         --
574         -- Nor must we generalise g over any kind variables free in r's kind
575
576 zapLclTypeEnv :: TcM a -> TcM a
577 zapLclTypeEnv thing_inside
578   = do { tvs_var <- newTcRef emptyVarSet
579        ; let upd env = env { tcl_env = emptyNameEnv
580                            , tcl_rdr = emptyLocalRdrEnv
581                            , tcl_tyvars = tvs_var }
582        ; updLclEnv upd thing_inside }
583 \end{code}
584
585
586 %************************************************************************
587 %*                                                                      *
588 \subsection{Rules}
589 %*                                                                      *
590 %************************************************************************
591
592 \begin{code}
593 tcExtendRules :: [LRuleDecl Id] -> TcM a -> TcM a
594         -- Just pop the new rules into the EPS and envt resp
595         -- All the rules come from an interface file, not source
596         -- Nevertheless, some may be for this module, if we read
597         -- its interface instead of its source code
598 tcExtendRules lcl_rules thing_inside
599  = do { env <- getGblEnv
600       ; let
601           env' = env { tcg_rules = lcl_rules ++ tcg_rules env }
602       ; setGblEnv env' thing_inside }
603 \end{code}
604
605
606 %************************************************************************
607 %*                                                                      *
608                 Meta level
609 %*                                                                      *
610 %************************************************************************
611
612 \begin{code}
613 checkWellStaged :: SDoc         -- What the stage check is for
614                 -> ThLevel      -- Binding level (increases inside brackets)
615                 -> ThLevel      -- Use stage
616                 -> TcM ()       -- Fail if badly staged, adding an error
617 checkWellStaged pp_thing bind_lvl use_lvl
618   | use_lvl >= bind_lvl         -- OK! Used later than bound
619   = return ()                   -- E.g.  \x -> [| $(f x) |]
620
621   | bind_lvl == outerLevel      -- GHC restriction on top level splices
622   = stageRestrictionError pp_thing
623
624   | otherwise                   -- Badly staged
625   = failWithTc $                -- E.g.  \x -> $(f x)
626     ptext (sLit "Stage error:") <+> pp_thing <+> 
627         hsep   [ptext (sLit "is bound at stage") <+> ppr bind_lvl,
628                 ptext (sLit "but used at stage") <+> ppr use_lvl]
629
630 stageRestrictionError :: SDoc -> TcM a
631 stageRestrictionError pp_thing
632   = failWithTc $ 
633     sep [ ptext (sLit "GHC stage restriction:")
634         , nest 2 (vcat [ pp_thing <+> ptext (sLit "is used in a top-level splice or annotation,")
635                        , ptext (sLit "and must be imported, not defined locally")])]
636
637 topIdLvl :: Id -> ThLevel
638 -- Globals may either be imported, or may be from an earlier "chunk" 
639 -- (separated by declaration splices) of this module.  The former
640 --  *can* be used inside a top-level splice, but the latter cannot.
641 -- Hence we give the former impLevel, but the latter topLevel
642 -- E.g. this is bad:
643 --      x = [| foo |]
644 --      $( f x )
645 -- By the time we are prcessing the $(f x), the binding for "x" 
646 -- will be in the global env, not the local one.
647 topIdLvl id | isLocalId id = outerLevel
648             | otherwise    = impLevel
649
650 tcMetaTy :: Name -> TcM Type
651 -- Given the name of a Template Haskell data type, 
652 -- return the type
653 -- E.g. given the name "Expr" return the type "Expr"
654 tcMetaTy tc_name = do
655     t <- tcLookupTyCon tc_name
656     return (mkTyConApp t [])
657
658 isBrackStage :: ThStage -> Bool
659 isBrackStage (Brack {}) = True
660 isBrackStage _other     = False
661 \end{code}
662
663
664 %************************************************************************
665 %*                                                                      *
666                  getDefaultTys                                                                          
667 %*                                                                      *
668 %************************************************************************
669
670 \begin{code}
671 tcGetDefaultTys :: TcM ([Type], -- Default types
672                         (Bool,  -- True <=> Use overloaded strings
673                          Bool)) -- True <=> Use extended defaulting rules
674 tcGetDefaultTys
675   = do  { dflags <- getDynFlags
676         ; let ovl_strings = xopt Opt_OverloadedStrings dflags
677               extended_defaults = xopt Opt_ExtendedDefaultRules dflags
678                                         -- See also Trac #1974 
679               flags = (ovl_strings, extended_defaults)
680     
681         ; mb_defaults <- getDeclaredDefaultTys
682         ; case mb_defaults of {
683            Just tys -> return (tys, flags) ;
684                                 -- User-supplied defaults
685            Nothing  -> do
686
687         -- No use-supplied default
688         -- Use [Integer, Double], plus modifications
689         { integer_ty <- tcMetaTy integerTyConName
690         ; checkWiredInTyCon doubleTyCon
691         ; string_ty <- tcMetaTy stringTyConName
692         ; let deflt_tys = opt_deflt extended_defaults unitTy  -- Note [Default unitTy]
693                           ++ [integer_ty, doubleTy]
694                           ++ opt_deflt ovl_strings string_ty
695         ; return (deflt_tys, flags) } } }
696   where
697     opt_deflt True  ty = [ty]
698     opt_deflt False _  = []
699 \end{code}
700
701 Note [Default unitTy]
702 ~~~~~~~~~~~~~~~~~~~~~
703 In interative mode (or with -XExtendedDefaultRules) we add () as the first type we
704 try when defaulting.  This has very little real impact, except in the following case.
705 Consider: 
706         Text.Printf.printf "hello"
707 This has type (forall a. IO a); it prints "hello", and returns 'undefined'.  We don't
708 want the GHCi repl loop to try to print that 'undefined'.  The neatest thing is to
709 default the 'a' to (), rather than to Integer (which is what would otherwise happen;
710 and then GHCi doesn't attempt to print the ().  So in interactive mode, we add
711 () to the list of defaulting types.  See Trac #1200.
712
713
714 %************************************************************************
715 %*                                                                      *
716 \subsection{The InstInfo type}
717 %*                                                                      *
718 %************************************************************************
719
720 The InstInfo type summarises the information in an instance declaration
721
722     instance c => k (t tvs) where b
723
724 It is used just for *local* instance decls (not ones from interface files).
725 But local instance decls includes
726         - derived ones
727         - generic ones
728 as well as explicit user written ones.
729
730 \begin{code}
731 data InstInfo a
732   = InstInfo {
733       iSpec   :: ClsInst,        -- Includes the dfun id.  Its forall'd type
734       iBinds  :: InstBindings a   -- variables scope over the stuff in InstBindings!
735     }
736
737 iDFunId :: InstInfo a -> DFunId
738 iDFunId info = instanceDFunId (iSpec info)
739
740 data InstBindings a
741   = InstBindings
742       { ib_tyvars  :: [Name]        -- Names of the tyvars from the instance head
743                                     -- that are lexically in scope in the bindings
744
745       , ib_binds   :: (LHsBinds a)  -- Bindings for the instance methods
746
747       , ib_pragmas :: [LSig a]      -- User pragmas recorded for generating
748                                     -- specialised instances
749
750       , ib_extensions :: [ExtensionFlag] -- Any extra extensions that should
751                                          -- be enabled when type-checking this
752                                          -- instance; needed for
753                                          -- GeneralizedNewtypeDeriving
754
755       , ib_derived :: Bool
756            -- True <=> This code was generated by GHC from a deriving clause
757            --          or standalone deriving declaration
758            -- Used only to improve error messages
759       }
760
761 instance OutputableBndr a => Outputable (InstInfo a) where
762     ppr = pprInstInfoDetails
763
764 pprInstInfoDetails :: OutputableBndr a => InstInfo a -> SDoc
765 pprInstInfoDetails info
766    = hang (pprInstanceHdr (iSpec info) <+> ptext (sLit "where"))
767         2 (details (iBinds info))
768   where
769     details (InstBindings { ib_binds = b }) = pprLHsBinds b
770
771 simpleInstInfoClsTy :: InstInfo a -> (Class, Type)
772 simpleInstInfoClsTy info = case instanceHead (iSpec info) of
773                            (_, cls, [ty]) -> (cls, ty)
774                            _ -> panic "simpleInstInfoClsTy"
775
776 simpleInstInfoTy :: InstInfo a -> Type
777 simpleInstInfoTy info = snd (simpleInstInfoClsTy info)
778
779 simpleInstInfoTyCon :: InstInfo a -> TyCon
780   -- Gets the type constructor for a simple instance declaration,
781   -- i.e. one of the form       instance (...) => C (T a b c) where ...
782 simpleInstInfoTyCon inst = tcTyConAppTyCon (simpleInstInfoTy inst)
783 \end{code}
784
785 Make a name for the dict fun for an instance decl.  It's an *external*
786 name, like otber top-level names, and hence must be made with newGlobalBinder.
787
788 \begin{code}
789 newDFunName :: Class -> [Type] -> SrcSpan -> TcM Name
790 newDFunName clas tys loc
791   = do  { is_boot <- tcIsHsBootOrSig
792         ; mod     <- getModule
793         ; let info_string = occNameString (getOccName clas) ++ 
794                             concatMap (occNameString.getDFunTyKey) tys
795         ; dfun_occ <- chooseUniqueOccTc (mkDFunOcc info_string is_boot)
796         ; newGlobalBinder mod dfun_occ loc }
797 \end{code}
798
799 Make a name for the representation tycon of a family instance.  It's an
800 *external* name, like other top-level names, and hence must be made with
801 newGlobalBinder.
802
803 \begin{code}
804 newFamInstTyConName :: Located Name -> [Type] -> TcM Name
805 newFamInstTyConName (L loc name) tys = mk_fam_inst_name id loc name [tys]
806
807 newFamInstAxiomName :: SrcSpan -> Name -> [CoAxBranch] -> TcM Name
808 newFamInstAxiomName loc name branches
809   = mk_fam_inst_name mkInstTyCoOcc loc name (map coAxBranchLHS branches)
810
811 mk_fam_inst_name :: (OccName -> OccName) -> SrcSpan -> Name -> [[Type]] -> TcM Name
812 mk_fam_inst_name adaptOcc loc tc_name tyss
813   = do  { mod   <- getModule
814         ; let info_string = occNameString (getOccName tc_name) ++ 
815                             intercalate "|" ty_strings
816         ; occ   <- chooseUniqueOccTc (mkInstTyTcOcc info_string)
817         ; newGlobalBinder mod (adaptOcc occ) loc }
818   where
819     ty_strings = map (concatMap (occNameString . getDFunTyKey)) tyss
820 \end{code}
821
822 Stable names used for foreign exports and annotations.
823 For stable names, the name must be unique (see #1533).  If the
824 same thing has several stable Ids based on it, the
825 top-level bindings generated must not have the same name.
826 Hence we create an External name (doesn't change), and we
827 append a Unique to the string right here.
828
829 \begin{code}
830 mkStableIdFromString :: String -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
831 mkStableIdFromString str sig_ty loc occ_wrapper = do
832     uniq <- newUnique
833     mod <- getModule
834     name <- mkWrapperName "stable" str
835     let occ = mkVarOccFS name :: OccName
836         gnm = mkExternalName uniq mod (occ_wrapper occ) loc :: Name
837         id  = mkExportedLocalId VanillaId gnm sig_ty :: Id
838     return id
839
840 mkStableIdFromName :: Name -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
841 mkStableIdFromName nm = mkStableIdFromString (getOccString nm)
842 \end{code}
843
844 \begin{code}
845 mkWrapperName :: (MonadIO m, HasDynFlags m, HasModule m)
846               => String -> String -> m FastString
847 mkWrapperName what nameBase
848     = do dflags <- getDynFlags
849          thisMod <- getModule
850          let -- Note [Generating fresh names for ccall wrapper]
851              wrapperRef = nextWrapperNum dflags
852              pkg = packageKeyString  (modulePackageKey thisMod)
853              mod = moduleNameString (moduleName      thisMod)
854          wrapperNum <- liftIO $ atomicModifyIORef wrapperRef $ \mod_env ->
855              let num = lookupWithDefaultModuleEnv mod_env 0 thisMod
856                  mod_env' = extendModuleEnv mod_env thisMod (num+1)
857              in (mod_env', num)
858          let components = [what, show wrapperNum, pkg, mod, nameBase]
859          return $ mkFastString $ zEncodeString $ intercalate ":" components
860
861 {-
862 Note [Generating fresh names for FFI wrappers]
863
864 We used to use a unique, rather than nextWrapperNum, to distinguish
865 between FFI wrapper functions. However, the wrapper names that we
866 generate are external names. This means that if a call to them ends up
867 in an unfolding, then we can't alpha-rename them, and thus if the
868 unique randomly changes from one compile to another then we get a
869 spurious ABI change (#4012).
870
871 The wrapper counter has to be per-module, not global, so that the number we end
872 up using is not dependent on the modules compiled before the current one.
873 -}
874 \end{code}
875
876 %************************************************************************
877 %*                                                                      *
878 \subsection{Errors}
879 %*                                                                      *
880 %************************************************************************
881
882 \begin{code}
883 pprBinders :: [Name] -> SDoc
884 -- Used in error messages
885 -- Use quotes for a single one; they look a bit "busy" for several
886 pprBinders [bndr] = quotes (ppr bndr)
887 pprBinders bndrs  = pprWithCommas ppr bndrs
888
889 notFound :: Name -> TcM TyThing
890 notFound name 
891   = do { lcl_env <- getLclEnv
892        ; let stage = tcl_th_ctxt lcl_env
893        ; case stage of   -- See Note [Out of scope might be a staging error]
894            Splice {} -> stageRestrictionError (quotes (ppr name))
895            _ -> failWithTc $
896                 vcat[ptext (sLit "GHC internal error:") <+> quotes (ppr name) <+> 
897                      ptext (sLit "is not in scope during type checking, but it passed the renamer"),
898                      ptext (sLit "tcl_env of environment:") <+> ppr (tcl_env lcl_env)]
899                        -- Take case: printing the whole gbl env can
900                        -- cause an infinite loop, in the case where we
901                        -- are in the middle of a recursive TyCon/Class group;
902                        -- so let's just not print it!  Getting a loop here is
903                        -- very unhelpful, because it hides one compiler bug with another
904        }
905
906 wrongThingErr :: String -> TcTyThing -> Name -> TcM a
907 -- It's important that this only calls pprTcTyThingCategory, which in 
908 -- turn does not look at the details of the TcTyThing.
909 -- See Note [Placeholder PatSyn kinds] in TcBinds
910 wrongThingErr expected thing name
911   = failWithTc (pprTcTyThingCategory thing <+> quotes (ppr name) <+> 
912                 ptext (sLit "used as a") <+> text expected)
913 \end{code}
914
915 Note [Out of scope might be a staging error]
916 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
917 Consider
918   x = 3
919   data T = MkT $(foo x)
920
921 This is really a staging error, because we can't run code involving 'x'.
922 But in fact the type checker processes types first, so 'x' won't even be
923 in the type envt when we look for it in $(foo x).  So inside splices we
924 report something missing from the type env as a staging error.
925 See Trac #5752 and #5795.