12f8a1df4f74c36998534b297f9c6138e7787c47
[ghc.git] / compiler / typecheck / TcEnv.hs
1 -- (c) The University of Glasgow 2006
2 {-# LANGUAGE CPP, FlexibleInstances #-}
3 {-# LANGUAGE FlexibleContexts #-}
4 {-# OPTIONS_GHC -fno-warn-orphans #-} -- instance MonadThings is necessarily an
5 -- orphan
6 {-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
7 -- in module PlaceHolder
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, tcExtendTyConEnv,
19 tcExtendGlobalEnvImplicit, setGlobalTypeEnv,
20 tcExtendGlobalValEnv,
21 tcLookupLocatedGlobal, tcLookupGlobal,
22 tcLookupTyCon, tcLookupClass,
23 tcLookupDataCon, tcLookupPatSyn, tcLookupConLike,
24 tcLookupLocatedGlobalId, tcLookupLocatedTyCon,
25 tcLookupLocatedClass, tcLookupAxiom,
26 lookupGlobal,
27
28 -- Local environment
29 tcExtendKindEnv, tcExtendKindEnvList,
30 tcExtendTyVarEnv, tcExtendTyVarEnv2,
31 tcExtendLetEnv, tcExtendSigIds, tcExtendRecIds,
32 tcExtendIdEnv, tcExtendIdEnv1, tcExtendIdEnv2,
33 tcExtendIdBndrs, tcExtendLocalTypeEnv,
34 isTypeClosedLetBndr,
35
36 tcLookup, tcLookupLocated, tcLookupLocalIds,
37 tcLookupId, tcLookupTyVar,
38 tcLookupLcl_maybe,
39 getInLocalScope,
40 wrongThingErr, pprBinders,
41
42 tcAddDataFamConPlaceholders, tcAddPatSynPlaceholders,
43 getTypeSigNames,
44 tcExtendRecEnv, -- For knot-tying
45
46 -- Instances
47 tcLookupInstance, tcGetInstEnvs,
48
49 -- Rules
50 tcExtendRules,
51
52 -- Defaults
53 tcGetDefaultTys,
54
55 -- Global type variables
56 tcGetGlobalTyCoVars,
57
58 -- Template Haskell stuff
59 checkWellStaged, tcMetaTy, thLevel,
60 topIdLvl, isBrackStage,
61
62 -- New Ids
63 newDFunName, newDFunName', newFamInstTyConName,
64 newFamInstAxiomName,
65 mkStableIdFromString, mkStableIdFromName,
66 mkWrapperName
67 ) where
68
69 #include "HsVersions.h"
70
71 import HsSyn
72 import IfaceEnv
73 import TcRnMonad
74 import TcMType
75 import TcType
76 import LoadIface
77 import PrelNames
78 import TysWiredIn
79 import Id
80 import Var
81 import VarSet
82 import RdrName
83 import InstEnv
84 import DataCon ( DataCon )
85 import PatSyn ( PatSyn )
86 import ConLike
87 import TyCon
88 import CoAxiom
89 import Class
90 import Name
91 import NameSet
92 import NameEnv
93 import VarEnv
94 import HscTypes
95 import DynFlags
96 import SrcLoc
97 import BasicTypes hiding( SuccessFlag(..) )
98 import Module
99 import Outputable
100 import Encoding
101 import FastString
102 import ListSetOps
103 import Util
104 import Maybes( MaybeErr(..), orElse )
105 import qualified GHC.LanguageExtensions as LangExt
106
107 import Data.IORef
108 import Data.List
109
110
111 {- *********************************************************************
112 * *
113 An IO interface to looking up globals
114 * *
115 ********************************************************************* -}
116
117 lookupGlobal :: HscEnv -> Name -> IO TyThing
118 -- An IO version, used outside the typechecker
119 -- It's more complicated than it looks, because it may
120 -- need to suck in an interface file
121 lookupGlobal hsc_env name
122 = initTcForLookup hsc_env (tcLookupGlobal name)
123 -- This initTcForLookup stuff is massive overkill
124 -- but that's how it is right now, and at least
125 -- this function localises it
126
127 {-
128 ************************************************************************
129 * *
130 * tcLookupGlobal *
131 * *
132 ************************************************************************
133
134 Using the Located versions (eg. tcLookupLocatedGlobal) is preferred,
135 unless you know that the SrcSpan in the monad is already set to the
136 span of the Name.
137 -}
138
139
140 tcLookupLocatedGlobal :: Located Name -> TcM TyThing
141 -- c.f. IfaceEnvEnv.tcIfaceGlobal
142 tcLookupLocatedGlobal name
143 = addLocM tcLookupGlobal name
144
145 tcLookupGlobal :: Name -> TcM TyThing
146 -- The Name is almost always an ExternalName, but not always
147 -- In GHCi, we may make command-line bindings (ghci> let x = True)
148 -- that bind a GlobalId, but with an InternalName
149 tcLookupGlobal name
150 = do { -- Try local envt
151 env <- getGblEnv
152 ; case lookupNameEnv (tcg_type_env env) name of {
153 Just thing -> return thing ;
154 Nothing ->
155
156 -- Should it have been in the local envt?
157 -- (NB: use semantic mod here, since names never use
158 -- identity module, see Note [Identity versus semantic module].)
159 if nameIsLocalOrFrom (tcg_semantic_mod env) name
160 then notFound name -- Internal names can happen in GHCi
161 else
162
163 -- Try home package table and external package table
164 do { mb_thing <- tcLookupImported_maybe name
165 ; case mb_thing of
166 Succeeded thing -> return thing
167 Failed msg -> failWithTc msg
168 }}}
169
170 tcLookupDataCon :: Name -> TcM DataCon
171 tcLookupDataCon name = do
172 thing <- tcLookupGlobal name
173 case thing of
174 AConLike (RealDataCon con) -> return con
175 _ -> wrongThingErr "data constructor" (AGlobal thing) name
176
177 tcLookupPatSyn :: Name -> TcM PatSyn
178 tcLookupPatSyn name = do
179 thing <- tcLookupGlobal name
180 case thing of
181 AConLike (PatSynCon ps) -> return ps
182 _ -> wrongThingErr "pattern synonym" (AGlobal thing) name
183
184 tcLookupConLike :: Name -> TcM ConLike
185 tcLookupConLike name = do
186 thing <- tcLookupGlobal name
187 case thing of
188 AConLike cl -> return cl
189 _ -> wrongThingErr "constructor-like thing" (AGlobal thing) name
190
191 tcLookupClass :: Name -> TcM Class
192 tcLookupClass name = do
193 thing <- tcLookupGlobal name
194 case thing of
195 ATyCon tc | Just cls <- tyConClass_maybe tc -> return cls
196 _ -> wrongThingErr "class" (AGlobal thing) name
197
198 tcLookupTyCon :: Name -> TcM TyCon
199 tcLookupTyCon name = do
200 thing <- tcLookupGlobal name
201 case thing of
202 ATyCon tc -> return tc
203 _ -> wrongThingErr "type constructor" (AGlobal thing) name
204
205 tcLookupAxiom :: Name -> TcM (CoAxiom Branched)
206 tcLookupAxiom name = do
207 thing <- tcLookupGlobal name
208 case thing of
209 ACoAxiom ax -> return ax
210 _ -> wrongThingErr "axiom" (AGlobal thing) name
211
212 tcLookupLocatedGlobalId :: Located Name -> TcM Id
213 tcLookupLocatedGlobalId = addLocM tcLookupId
214
215 tcLookupLocatedClass :: Located Name -> TcM Class
216 tcLookupLocatedClass = addLocM tcLookupClass
217
218 tcLookupLocatedTyCon :: Located Name -> TcM TyCon
219 tcLookupLocatedTyCon = addLocM tcLookupTyCon
220
221 -- Find the instance that exactly matches a type class application. The class arguments must be precisely
222 -- the same as in the instance declaration (modulo renaming & casts).
223 --
224 tcLookupInstance :: Class -> [Type] -> TcM ClsInst
225 tcLookupInstance cls tys
226 = do { instEnv <- tcGetInstEnvs
227 ; case lookupUniqueInstEnv instEnv cls tys of
228 Left err -> failWithTc $ text "Couldn't match instance:" <+> err
229 Right (inst, tys)
230 | uniqueTyVars tys -> return inst
231 | otherwise -> failWithTc errNotExact
232 }
233 where
234 errNotExact = text "Not an exact match (i.e., some variables get instantiated)"
235
236 uniqueTyVars tys = all isTyVarTy tys
237 && hasNoDups (map (getTyVar "tcLookupInstance") tys)
238
239 tcGetInstEnvs :: TcM InstEnvs
240 -- Gets both the external-package inst-env
241 -- and the home-pkg inst env (includes module being compiled)
242 tcGetInstEnvs = do { eps <- getEps
243 ; env <- getGblEnv
244 ; return (InstEnvs { ie_global = eps_inst_env eps
245 , ie_local = tcg_inst_env env
246 , ie_visible = tcVisibleOrphanMods env }) }
247
248 instance MonadThings (IOEnv (Env TcGblEnv TcLclEnv)) where
249 lookupThing = tcLookupGlobal
250
251 {-
252 ************************************************************************
253 * *
254 Extending the global environment
255 * *
256 ************************************************************************
257 -}
258
259 setGlobalTypeEnv :: TcGblEnv -> TypeEnv -> TcM TcGblEnv
260 -- Use this to update the global type env
261 -- It updates both * the normal tcg_type_env field
262 -- * the tcg_type_env_var field seen by interface files
263 setGlobalTypeEnv tcg_env new_type_env
264 = do { -- Sync the type-envt variable seen by interface files
265 writeMutVar (tcg_type_env_var tcg_env) new_type_env
266 ; return (tcg_env { tcg_type_env = new_type_env }) }
267
268
269 tcExtendGlobalEnvImplicit :: [TyThing] -> TcM r -> TcM r
270 -- Just extend the global environment with some TyThings
271 -- Do not extend tcg_tcs etc
272 tcExtendGlobalEnvImplicit things thing_inside
273 = do { tcg_env <- getGblEnv
274 ; let ge' = extendTypeEnvList (tcg_type_env tcg_env) things
275 ; tcg_env' <- setGlobalTypeEnv tcg_env ge'
276 ; setGblEnv tcg_env' thing_inside }
277
278 tcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r
279 -- Given a mixture of Ids, TyCons, Classes, all defined in the
280 -- module being compiled, extend the global environment
281 tcExtendGlobalEnv things thing_inside
282 = do { env <- getGblEnv
283 ; let env' = env { tcg_tcs = [tc | ATyCon tc <- things] ++ tcg_tcs env,
284 tcg_patsyns = [ps | AConLike (PatSynCon ps) <- things] ++ tcg_patsyns env }
285 ; setGblEnv env' $
286 tcExtendGlobalEnvImplicit things thing_inside
287 }
288
289 tcExtendTyConEnv :: [TyCon] -> TcM r -> TcM r
290 -- Given a mixture of Ids, TyCons, Classes, all defined in the
291 -- module being compiled, extend the global environment
292 tcExtendTyConEnv tycons thing_inside
293 = do { env <- getGblEnv
294 ; let env' = env { tcg_tcs = tycons ++ tcg_tcs env }
295 ; setGblEnv env' $
296 tcExtendGlobalEnvImplicit (map ATyCon tycons) thing_inside
297 }
298
299 tcExtendGlobalValEnv :: [Id] -> TcM a -> TcM a
300 -- Same deal as tcExtendGlobalEnv, but for Ids
301 tcExtendGlobalValEnv ids thing_inside
302 = tcExtendGlobalEnvImplicit [AnId id | id <- ids] thing_inside
303
304 tcExtendRecEnv :: [(Name,TyThing)] -> TcM r -> TcM r
305 -- Extend the global environments for the type/class knot tying game
306 -- Just like tcExtendGlobalEnv, except the argument is a list of pairs
307 tcExtendRecEnv gbl_stuff thing_inside
308 = do { tcg_env <- getGblEnv
309 ; let ge' = extendNameEnvList (tcg_type_env tcg_env) gbl_stuff
310 ; tcg_env' <- setGlobalTypeEnv tcg_env ge'
311 ; setGblEnv tcg_env' thing_inside }
312
313 {-
314 ************************************************************************
315 * *
316 \subsection{The local environment}
317 * *
318 ************************************************************************
319 -}
320
321 tcLookupLocated :: Located Name -> TcM TcTyThing
322 tcLookupLocated = addLocM tcLookup
323
324 tcLookupLcl_maybe :: Name -> TcM (Maybe TcTyThing)
325 tcLookupLcl_maybe name
326 = do { local_env <- getLclTypeEnv
327 ; return (lookupNameEnv local_env name) }
328
329 tcLookup :: Name -> TcM TcTyThing
330 tcLookup name = do
331 local_env <- getLclTypeEnv
332 case lookupNameEnv local_env name of
333 Just thing -> return thing
334 Nothing -> AGlobal <$> tcLookupGlobal name
335
336 tcLookupTyVar :: Name -> TcM TcTyVar
337 tcLookupTyVar name
338 = do { thing <- tcLookup name
339 ; case thing of
340 ATyVar _ tv -> return tv
341 _ -> pprPanic "tcLookupTyVar" (ppr name) }
342
343 tcLookupId :: Name -> TcM Id
344 -- Used when we aren't interested in the binding level, nor refinement.
345 -- The "no refinement" part means that we return the un-refined Id regardless
346 --
347 -- The Id is never a DataCon. (Why does that matter? see TcExpr.tcId)
348 tcLookupId name = do
349 thing <- tcLookup name
350 case thing of
351 ATcId { tct_id = id} -> return id
352 AGlobal (AnId id) -> return id
353 _ -> pprPanic "tcLookupId" (ppr name)
354
355 tcLookupLocalIds :: [Name] -> TcM [TcId]
356 -- We expect the variables to all be bound, and all at
357 -- the same level as the lookup. Only used in one place...
358 tcLookupLocalIds ns
359 = do { env <- getLclEnv
360 ; return (map (lookup (tcl_env env)) ns) }
361 where
362 lookup lenv name
363 = case lookupNameEnv lenv name of
364 Just (ATcId { tct_id = id }) -> id
365 _ -> pprPanic "tcLookupLocalIds" (ppr name)
366
367 getInLocalScope :: TcM (Name -> Bool)
368 getInLocalScope = do { lcl_env <- getLclTypeEnv
369 ; return (`elemNameEnv` lcl_env) }
370
371 tcExtendKindEnvList :: [(Name, TcTyThing)] -> TcM r -> TcM r
372 -- Used only during kind checking, for TcThings that are
373 -- ATcTyCon or APromotionErr
374 -- No need to update the global tyvars, or tcl_th_bndrs, or tcl_rdr
375 tcExtendKindEnvList things thing_inside
376 = do { traceTc "txExtendKindEnvList" (ppr things)
377 ; updLclEnv upd_env thing_inside }
378 where
379 upd_env env = env { tcl_env = extendNameEnvList (tcl_env env) things }
380
381 tcExtendKindEnv :: NameEnv TcTyThing -> TcM r -> TcM r
382 -- A variant of tcExtendKindEvnList
383 tcExtendKindEnv extra_env thing_inside
384 = do { traceTc "txExtendKindEnv" (ppr extra_env)
385 ; updLclEnv upd_env thing_inside }
386 where
387 upd_env env = env { tcl_env = tcl_env env `plusNameEnv` extra_env }
388
389 -----------------------
390 -- Scoped type and kind variables
391 tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
392 tcExtendTyVarEnv tvs thing_inside
393 = tcExtendTyVarEnv2 [(tyVarName tv, tv) | tv <- tvs] thing_inside
394
395 tcExtendTyVarEnv2 :: [(Name,TcTyVar)] -> TcM r -> TcM r
396 tcExtendTyVarEnv2 binds thing_inside
397 -- this should be used only for explicitly mentioned scoped variables.
398 -- thus, no coercion variables
399 = do { tc_extend_local_env NotTopLevel
400 [(name, ATyVar name tv) | (name, tv) <- binds] $
401 do { env <- getLclEnv
402 ; let env' = env { tcl_tidy = add_tidy_tvs (tcl_tidy env) }
403 ; setLclEnv env' thing_inside }}
404 where
405 add_tidy_tvs env = foldl add env binds
406
407 -- We initialise the "tidy-env", used for tidying types before printing,
408 -- by building a reverse map from the in-scope type variables to the
409 -- OccName that the programmer originally used for them
410 add :: TidyEnv -> (Name, TcTyVar) -> TidyEnv
411 add (env,subst) (name, tyvar)
412 = ASSERT( isTyVar tyvar )
413 case tidyOccName env (nameOccName name) of
414 (env', occ') -> (env', extendVarEnv subst tyvar tyvar')
415 where
416 tyvar' = setTyVarName tyvar name'
417 name' = tidyNameOcc name occ'
418
419 isTypeClosedLetBndr :: Id -> Bool
420 -- See Note [Bindings with closed types] in TcRnTypes
421 isTypeClosedLetBndr = noFreeVarsOfType . idType
422
423 tcExtendRecIds :: [(Name, TcId)] -> TcM a -> TcM a
424 -- Used for binding the recurive uses of Ids in a binding
425 -- both top-level value bindings and and nested let/where-bindings
426 -- Does not extend the TcIdBinderStack
427 tcExtendRecIds pairs thing_inside
428 = tc_extend_local_env NotTopLevel
429 [ (name, ATcId { tct_id = let_id
430 , tct_info = NonClosedLet emptyNameSet False })
431 | (name, let_id) <- pairs ] $
432 thing_inside
433
434 tcExtendSigIds :: TopLevelFlag -> [TcId] -> TcM a -> TcM a
435 -- Used for binding the Ids that have a complete user type signature
436 -- Does not extend the TcIdBinderStack
437 tcExtendSigIds top_lvl sig_ids thing_inside
438 = tc_extend_local_env top_lvl
439 [ (idName id, ATcId { tct_id = id
440 , tct_info = info })
441 | id <- sig_ids
442 , let closed = isTypeClosedLetBndr id
443 info = NonClosedLet emptyNameSet closed ]
444 thing_inside
445
446
447 tcExtendLetEnv :: TopLevelFlag -> TcSigFun -> IsGroupClosed
448 -> [TcId] -> TcM a -> TcM a
449 -- Used for both top-level value bindings and and nested let/where-bindings
450 -- Adds to the TcIdBinderStack too
451 tcExtendLetEnv top_lvl sig_fn (IsGroupClosed fvs fv_type_closed)
452 ids thing_inside
453 = tcExtendIdBndrs [TcIdBndr id top_lvl | id <- ids] $
454 tc_extend_local_env top_lvl
455 [ (idName id, ATcId { tct_id = id
456 , tct_info = mk_tct_info id })
457 | id <- ids ]
458 thing_inside
459 where
460 mk_tct_info id
461 | type_closed && isEmptyNameSet rhs_fvs = ClosedLet
462 | otherwise = NonClosedLet rhs_fvs type_closed
463 where
464 name = idName id
465 rhs_fvs = lookupNameEnv fvs name `orElse` emptyNameSet
466 type_closed = isTypeClosedLetBndr id &&
467 (fv_type_closed || hasCompleteSig sig_fn name)
468
469 tcExtendIdEnv :: [TcId] -> TcM a -> TcM a
470 -- For lambda-bound and case-bound Ids
471 -- Extends the the TcIdBinderStack as well
472 tcExtendIdEnv ids thing_inside
473 = tcExtendIdEnv2 [(idName id, id) | id <- ids] thing_inside
474
475 tcExtendIdEnv1 :: Name -> TcId -> TcM a -> TcM a
476 -- Exactly like tcExtendIdEnv2, but for a single (name,id) pair
477 tcExtendIdEnv1 name id thing_inside
478 = tcExtendIdEnv2 [(name,id)] thing_inside
479
480 tcExtendIdEnv2 :: [(Name,TcId)] -> TcM a -> TcM a
481 tcExtendIdEnv2 names_w_ids thing_inside
482 = tcExtendIdBndrs [ TcIdBndr mono_id NotTopLevel
483 | (_,mono_id) <- names_w_ids ] $
484 tc_extend_local_env NotTopLevel
485 [ (name, ATcId { tct_id = id
486 , tct_info = NotLetBound })
487 | (name,id) <- names_w_ids]
488 thing_inside
489
490 tc_extend_local_env :: TopLevelFlag -> [(Name, TcTyThing)] -> TcM a -> TcM a
491 tc_extend_local_env top_lvl extra_env thing_inside
492 -- Precondition: the argument list extra_env has TcTyThings
493 -- that ATcId or ATyVar, but nothing else
494 --
495 -- Invariant: the ATcIds are fully zonked. Reasons:
496 -- (a) The kinds of the forall'd type variables are defaulted
497 -- (see Kind.defaultKind, done in zonkQuantifiedTyVar)
498 -- (b) There are no via-Indirect occurrences of the bound variables
499 -- in the types, because instantiation does not look through such things
500 -- (c) The call to tyCoVarsOfTypes is ok without looking through refs
501
502 -- The second argument of type TyVarSet is a set of type variables
503 -- that are bound together with extra_env and should not be regarded
504 -- as free in the types of extra_env.
505 = do { traceTc "env2" (ppr extra_env)
506 ; env0 <- getLclEnv
507 ; env1 <- tcExtendLocalTypeEnv env0 extra_env
508 ; stage <- getStage
509 ; let env2 = extend_local_env (top_lvl, thLevel stage) extra_env env1
510 ; setLclEnv env2 thing_inside }
511 where
512 extend_local_env :: (TopLevelFlag, ThLevel) -> [(Name, TcTyThing)] -> TcLclEnv -> TcLclEnv
513 -- Extend the local LocalRdrEnv and Template Haskell staging env simultaneously
514 -- Reason for extending LocalRdrEnv: after running a TH splice we need
515 -- to do renaming.
516 extend_local_env thlvl pairs env@(TcLclEnv { tcl_rdr = rdr_env
517 , tcl_th_bndrs = th_bndrs })
518 = env { tcl_rdr = extendLocalRdrEnvList rdr_env
519 [ n | (n, _) <- pairs, isInternalName n ]
520 -- The LocalRdrEnv contains only non-top-level names
521 -- (GlobalRdrEnv handles the top level)
522 , tcl_th_bndrs = extendNameEnvList th_bndrs -- We only track Ids in tcl_th_bndrs
523 [(n, thlvl) | (n, ATcId {}) <- pairs] }
524
525 tcExtendLocalTypeEnv :: TcLclEnv -> [(Name, TcTyThing)] -> TcM TcLclEnv
526 tcExtendLocalTypeEnv lcl_env@(TcLclEnv { tcl_env = lcl_type_env }) tc_ty_things
527 | isEmptyVarSet extra_tvs
528 = return (lcl_env { tcl_env = extendNameEnvList lcl_type_env tc_ty_things })
529 | otherwise
530 = do { 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_info = closed }) tvs
538 = case closed of
539 ClosedLet ->
540 ASSERT2( isEmptyVarSet id_tvs, ppr id $$ ppr (idType id) ) tvs
541 _ ->
542 tvs `unionVarSet` id_tvs
543 where id_tvs = tyCoVarsOfType (idType id)
544
545 get_tvs (_, ATyVar _ tv) tvs -- See Note [Global TyVars]
546 = tvs `unionVarSet` tyCoVarsOfType (tyVarKind tv) `extendVarSet` tv
547
548 get_tvs (_, ATcTyCon tc) tvs = tvs `unionVarSet` tyCoVarsOfType (tyConKind tc)
549
550 get_tvs (_, AGlobal {}) tvs = tvs
551 get_tvs (_, APromotionErr {}) tvs = tvs
552
553 -- Note [Global TyVars]
554 -- It's important to add the in-scope tyvars to the global tyvar set
555 -- as well. Consider
556 -- f (_::r) = let g y = y::r in ...
557 -- Here, g mustn't be generalised. This is also important during
558 -- class and instance decls, when we mustn't generalise the class tyvars
559 -- when typechecking the methods.
560 --
561 -- Nor must we generalise g over any kind variables free in r's kind
562
563 -------------------------------------------------------------
564 -- Extending the TcIdBinderStack, used only for error messages
565
566 tcExtendIdBndrs :: [TcIdBinder] -> TcM a -> TcM a
567 tcExtendIdBndrs bndrs thing_inside
568 = do { traceTc "tcExtendIdBndrs" (ppr bndrs)
569 ; updLclEnv (\env -> env { tcl_bndrs = bndrs ++ tcl_bndrs env })
570 thing_inside }
571
572
573 {- *********************************************************************
574 * *
575 Adding placeholders
576 * *
577 ********************************************************************* -}
578
579 tcAddDataFamConPlaceholders :: [LInstDecl GhcRn] -> TcM a -> TcM a
580 -- See Note [AFamDataCon: not promoting data family constructors]
581 tcAddDataFamConPlaceholders inst_decls thing_inside
582 = tcExtendKindEnvList [ (con, APromotionErr FamDataConPE)
583 | lid <- inst_decls, con <- get_cons lid ]
584 thing_inside
585 -- Note [AFamDataCon: not promoting data family constructors]
586 where
587 -- get_cons extracts the *constructor* bindings of the declaration
588 get_cons :: LInstDecl GhcRn -> [Name]
589 get_cons (L _ (TyFamInstD {})) = []
590 get_cons (L _ (DataFamInstD { dfid_inst = fid })) = get_fi_cons fid
591 get_cons (L _ (ClsInstD { cid_inst = ClsInstDecl { cid_datafam_insts = fids } }))
592 = concatMap (get_fi_cons . unLoc) fids
593
594 get_fi_cons :: DataFamInstDecl GhcRn -> [Name]
595 get_fi_cons (DataFamInstDecl { dfid_defn = HsDataDefn { dd_cons = cons } })
596 = map unLoc $ concatMap (getConNames . unLoc) cons
597
598
599 tcAddPatSynPlaceholders :: [PatSynBind GhcRn GhcRn] -> TcM a -> TcM a
600 -- See Note [Don't promote pattern synonyms]
601 tcAddPatSynPlaceholders pat_syns thing_inside
602 = tcExtendKindEnvList [ (name, APromotionErr PatSynPE)
603 | PSB{ psb_id = L _ name } <- pat_syns ]
604 thing_inside
605
606 getTypeSigNames :: [LSig GhcRn] -> NameSet
607 -- Get the names that have a user type sig
608 getTypeSigNames sigs
609 = foldr get_type_sig emptyNameSet sigs
610 where
611 get_type_sig :: LSig GhcRn -> NameSet -> NameSet
612 get_type_sig sig ns =
613 case sig of
614 L _ (TypeSig names _) -> extendNameSetList ns (map unLoc names)
615 L _ (PatSynSig names _) -> extendNameSetList ns (map unLoc names)
616 _ -> ns
617
618
619 {- Note [AFamDataCon: not promoting data family constructors]
620 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
621 Consider
622 data family T a
623 data instance T Int = MkT
624 data Proxy (a :: k)
625 data S = MkS (Proxy 'MkT)
626
627 Is it ok to use the promoted data family instance constructor 'MkT' in
628 the data declaration for S (where both declarations live in the same module)?
629 No, we don't allow this. It *might* make sense, but at least it would mean that
630 we'd have to interleave typechecking instances and data types, whereas at
631 present we do data types *then* instances.
632
633 So to check for this we put in the TcLclEnv a binding for all the family
634 constructors, bound to AFamDataCon, so that if we trip over 'MkT' when
635 type checking 'S' we'll produce a decent error message.
636
637 Trac #12088 describes this limitation. Of course, when MkT and S live in
638 different modules then all is well.
639
640 Note [Don't promote pattern synonyms]
641 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
642 We never promote pattern synonyms.
643
644 Consider this (Trac #11265):
645 pattern A = True
646 instance Eq A
647 We want a civilised error message from the occurrence of 'A'
648 in the instance, yet 'A' really has not yet been type checked.
649
650 Similarly (Trac #9161)
651 {-# LANGUAGE PatternSynonyms, DataKinds #-}
652 pattern A = ()
653 b :: A
654 b = undefined
655 Here, the type signature for b mentions A. But A is a pattern
656 synonym, which is typechecked as part of a group of bindings (for very
657 good reasons; a view pattern in the RHS may mention a value binding).
658 It is entirely reasonable to reject this, but to do so we need A to be
659 in the kind environment when kind-checking the signature for B.
660
661 Hence tcAddPatSynPlaceholers adds a binding
662 A -> APromotionErr PatSynPE
663 to the environment. Then TcHsType.tcTyVar will find A in the kind
664 environment, and will give a 'wrongThingErr' as a result. But the
665 lookup of A won't fail.
666
667
668 ************************************************************************
669 * *
670 \subsection{Rules}
671 * *
672 ************************************************************************
673 -}
674
675 tcExtendRules :: [LRuleDecl GhcTc] -> TcM a -> TcM a
676 -- Just pop the new rules into the EPS and envt resp
677 -- All the rules come from an interface file, not source
678 -- Nevertheless, some may be for this module, if we read
679 -- its interface instead of its source code
680 tcExtendRules lcl_rules thing_inside
681 = do { env <- getGblEnv
682 ; let
683 env' = env { tcg_rules = lcl_rules ++ tcg_rules env }
684 ; setGblEnv env' thing_inside }
685
686 {-
687 ************************************************************************
688 * *
689 Meta level
690 * *
691 ************************************************************************
692 -}
693
694 checkWellStaged :: SDoc -- What the stage check is for
695 -> ThLevel -- Binding level (increases inside brackets)
696 -> ThLevel -- Use stage
697 -> TcM () -- Fail if badly staged, adding an error
698 checkWellStaged pp_thing bind_lvl use_lvl
699 | use_lvl >= bind_lvl -- OK! Used later than bound
700 = return () -- E.g. \x -> [| $(f x) |]
701
702 | bind_lvl == outerLevel -- GHC restriction on top level splices
703 = stageRestrictionError pp_thing
704
705 | otherwise -- Badly staged
706 = failWithTc $ -- E.g. \x -> $(f x)
707 text "Stage error:" <+> pp_thing <+>
708 hsep [text "is bound at stage" <+> ppr bind_lvl,
709 text "but used at stage" <+> ppr use_lvl]
710
711 stageRestrictionError :: SDoc -> TcM a
712 stageRestrictionError pp_thing
713 = failWithTc $
714 sep [ text "GHC stage restriction:"
715 , nest 2 (vcat [ pp_thing <+> text "is used in a top-level splice, quasi-quote, or annotation,"
716 , text "and must be imported, not defined locally"])]
717
718 topIdLvl :: Id -> ThLevel
719 -- Globals may either be imported, or may be from an earlier "chunk"
720 -- (separated by declaration splices) of this module. The former
721 -- *can* be used inside a top-level splice, but the latter cannot.
722 -- Hence we give the former impLevel, but the latter topLevel
723 -- E.g. this is bad:
724 -- x = [| foo |]
725 -- $( f x )
726 -- By the time we are prcessing the $(f x), the binding for "x"
727 -- will be in the global env, not the local one.
728 topIdLvl id | isLocalId id = outerLevel
729 | otherwise = impLevel
730
731 tcMetaTy :: Name -> TcM Type
732 -- Given the name of a Template Haskell data type,
733 -- return the type
734 -- E.g. given the name "Expr" return the type "Expr"
735 tcMetaTy tc_name = do
736 t <- tcLookupTyCon tc_name
737 return (mkTyConApp t [])
738
739 isBrackStage :: ThStage -> Bool
740 isBrackStage (Brack {}) = True
741 isBrackStage _other = False
742
743 {-
744 ************************************************************************
745 * *
746 getDefaultTys
747 * *
748 ************************************************************************
749 -}
750
751 tcGetDefaultTys :: TcM ([Type], -- Default types
752 (Bool, -- True <=> Use overloaded strings
753 Bool)) -- True <=> Use extended defaulting rules
754 tcGetDefaultTys
755 = do { dflags <- getDynFlags
756 ; let ovl_strings = xopt LangExt.OverloadedStrings dflags
757 extended_defaults = xopt LangExt.ExtendedDefaultRules dflags
758 -- See also Trac #1974
759 flags = (ovl_strings, extended_defaults)
760
761 ; mb_defaults <- getDeclaredDefaultTys
762 ; case mb_defaults of {
763 Just tys -> return (tys, flags) ;
764 -- User-supplied defaults
765 Nothing -> do
766
767 -- No use-supplied default
768 -- Use [Integer, Double], plus modifications
769 { integer_ty <- tcMetaTy integerTyConName
770 ; list_ty <- tcMetaTy listTyConName
771 ; checkWiredInTyCon doubleTyCon
772 ; let deflt_tys = opt_deflt extended_defaults [unitTy, list_ty]
773 -- Note [Extended defaults]
774 ++ [integer_ty, doubleTy]
775 ++ opt_deflt ovl_strings [stringTy]
776 ; return (deflt_tys, flags) } } }
777 where
778 opt_deflt True xs = xs
779 opt_deflt False _ = []
780
781 {-
782 Note [Extended defaults]
783 ~~~~~~~~~~~~~~~~~~~~~
784 In interative mode (or with -XExtendedDefaultRules) we add () as the first type we
785 try when defaulting. This has very little real impact, except in the following case.
786 Consider:
787 Text.Printf.printf "hello"
788 This has type (forall a. IO a); it prints "hello", and returns 'undefined'. We don't
789 want the GHCi repl loop to try to print that 'undefined'. The neatest thing is to
790 default the 'a' to (), rather than to Integer (which is what would otherwise happen;
791 and then GHCi doesn't attempt to print the (). So in interactive mode, we add
792 () to the list of defaulting types. See Trac #1200.
793
794 Additonally, the list type [] is added as a default specialization for
795 Traversable and Foldable. As such the default default list now has types of
796 varying kinds, e.g. ([] :: * -> *) and (Integer :: *).
797
798 ************************************************************************
799 * *
800 \subsection{The InstInfo type}
801 * *
802 ************************************************************************
803
804 The InstInfo type summarises the information in an instance declaration
805
806 instance c => k (t tvs) where b
807
808 It is used just for *local* instance decls (not ones from interface files).
809 But local instance decls includes
810 - derived ones
811 - generic ones
812 as well as explicit user written ones.
813 -}
814
815 data InstInfo a
816 = InstInfo
817 { iSpec :: ClsInst -- Includes the dfun id
818 , iBinds :: InstBindings a
819 }
820
821 iDFunId :: InstInfo a -> DFunId
822 iDFunId info = instanceDFunId (iSpec info)
823
824 data InstBindings a
825 = InstBindings
826 { ib_tyvars :: [Name] -- Names of the tyvars from the instance head
827 -- that are lexically in scope in the bindings
828 -- Must correspond 1-1 with the forall'd tyvars
829 -- of the dfun Id. When typechecking, we are
830 -- going to extend the typechecker's envt with
831 -- ib_tyvars -> dfun_forall_tyvars
832
833 , ib_binds :: LHsBinds a -- Bindings for the instance methods
834
835 , ib_pragmas :: [LSig a] -- User pragmas recorded for generating
836 -- specialised instances
837
838 , ib_extensions :: [LangExt.Extension] -- Any extra extensions that should
839 -- be enabled when type-checking
840 -- this instance; needed for
841 -- GeneralizedNewtypeDeriving
842
843 , ib_derived :: Bool
844 -- True <=> This code was generated by GHC from a deriving clause
845 -- or standalone deriving declaration
846 -- Used only to improve error messages
847 }
848
849 instance (SourceTextX a, OutputableBndrId a) => Outputable (InstInfo a) where
850 ppr = pprInstInfoDetails
851
852 pprInstInfoDetails :: (SourceTextX a, OutputableBndrId a) => InstInfo a -> SDoc
853 pprInstInfoDetails info
854 = hang (pprInstanceHdr (iSpec info) <+> text "where")
855 2 (details (iBinds info))
856 where
857 details (InstBindings { ib_binds = b }) = pprLHsBinds b
858
859 simpleInstInfoClsTy :: InstInfo a -> (Class, Type)
860 simpleInstInfoClsTy info = case instanceHead (iSpec info) of
861 (_, cls, [ty]) -> (cls, ty)
862 _ -> panic "simpleInstInfoClsTy"
863
864 simpleInstInfoTy :: InstInfo a -> Type
865 simpleInstInfoTy info = snd (simpleInstInfoClsTy info)
866
867 simpleInstInfoTyCon :: InstInfo a -> TyCon
868 -- Gets the type constructor for a simple instance declaration,
869 -- i.e. one of the form instance (...) => C (T a b c) where ...
870 simpleInstInfoTyCon inst = tcTyConAppTyCon (simpleInstInfoTy inst)
871
872 -- | Make a name for the dict fun for an instance decl. It's an *external*
873 -- name, like other top-level names, and hence must be made with
874 -- newGlobalBinder.
875 newDFunName :: Class -> [Type] -> SrcSpan -> TcM Name
876 newDFunName clas tys loc
877 = do { is_boot <- tcIsHsBootOrSig
878 ; mod <- getModule
879 ; let info_string = occNameString (getOccName clas) ++
880 concatMap (occNameString.getDFunTyKey) tys
881 ; dfun_occ <- chooseUniqueOccTc (mkDFunOcc info_string is_boot)
882 ; newGlobalBinder mod dfun_occ loc }
883
884 -- | Special case of 'newDFunName' to generate dict fun name for a single TyCon.
885 newDFunName' :: Class -> TyCon -> TcM Name
886 newDFunName' clas tycon -- Just a simple wrapper
887 = do { loc <- getSrcSpanM -- The location of the instance decl,
888 -- not of the tycon
889 ; newDFunName clas [mkTyConApp tycon []] loc }
890 -- The type passed to newDFunName is only used to generate
891 -- a suitable string; hence the empty type arg list
892
893 {-
894 Make a name for the representation tycon of a family instance. It's an
895 *external* name, like other top-level names, and hence must be made with
896 newGlobalBinder.
897 -}
898
899 newFamInstTyConName :: Located Name -> [Type] -> TcM Name
900 newFamInstTyConName (L loc name) tys = mk_fam_inst_name id loc name [tys]
901
902 newFamInstAxiomName :: Located Name -> [[Type]] -> TcM Name
903 newFamInstAxiomName (L loc name) branches
904 = mk_fam_inst_name mkInstTyCoOcc loc name branches
905
906 mk_fam_inst_name :: (OccName -> OccName) -> SrcSpan -> Name -> [[Type]] -> TcM Name
907 mk_fam_inst_name adaptOcc loc tc_name tyss
908 = do { mod <- getModule
909 ; let info_string = occNameString (getOccName tc_name) ++
910 intercalate "|" ty_strings
911 ; occ <- chooseUniqueOccTc (mkInstTyTcOcc info_string)
912 ; newGlobalBinder mod (adaptOcc occ) loc }
913 where
914 ty_strings = map (concatMap (occNameString . getDFunTyKey)) tyss
915
916 {-
917 Stable names used for foreign exports and annotations.
918 For stable names, the name must be unique (see #1533). If the
919 same thing has several stable Ids based on it, the
920 top-level bindings generated must not have the same name.
921 Hence we create an External name (doesn't change), and we
922 append a Unique to the string right here.
923 -}
924
925 mkStableIdFromString :: String -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
926 mkStableIdFromString str sig_ty loc occ_wrapper = do
927 uniq <- newUnique
928 mod <- getModule
929 name <- mkWrapperName "stable" str
930 let occ = mkVarOccFS name :: OccName
931 gnm = mkExternalName uniq mod (occ_wrapper occ) loc :: Name
932 id = mkExportedVanillaId gnm sig_ty :: Id
933 return id
934
935 mkStableIdFromName :: Name -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
936 mkStableIdFromName nm = mkStableIdFromString (getOccString nm)
937
938 mkWrapperName :: (MonadIO m, HasDynFlags m, HasModule m)
939 => String -> String -> m FastString
940 mkWrapperName what nameBase
941 = do dflags <- getDynFlags
942 thisMod <- getModule
943 let -- Note [Generating fresh names for ccall wrapper]
944 wrapperRef = nextWrapperNum dflags
945 pkg = unitIdString (moduleUnitId thisMod)
946 mod = moduleNameString (moduleName thisMod)
947 wrapperNum <- liftIO $ atomicModifyIORef' wrapperRef $ \mod_env ->
948 let num = lookupWithDefaultModuleEnv mod_env 0 thisMod
949 mod_env' = extendModuleEnv mod_env thisMod (num+1)
950 in (mod_env', num)
951 let components = [what, show wrapperNum, pkg, mod, nameBase]
952 return $ mkFastString $ zEncodeString $ intercalate ":" components
953
954 {-
955 Note [Generating fresh names for FFI wrappers]
956
957 We used to use a unique, rather than nextWrapperNum, to distinguish
958 between FFI wrapper functions. However, the wrapper names that we
959 generate are external names. This means that if a call to them ends up
960 in an unfolding, then we can't alpha-rename them, and thus if the
961 unique randomly changes from one compile to another then we get a
962 spurious ABI change (#4012).
963
964 The wrapper counter has to be per-module, not global, so that the number we end
965 up using is not dependent on the modules compiled before the current one.
966 -}
967
968 {-
969 ************************************************************************
970 * *
971 \subsection{Errors}
972 * *
973 ************************************************************************
974 -}
975
976 pprBinders :: [Name] -> SDoc
977 -- Used in error messages
978 -- Use quotes for a single one; they look a bit "busy" for several
979 pprBinders [bndr] = quotes (ppr bndr)
980 pprBinders bndrs = pprWithCommas ppr bndrs
981
982 notFound :: Name -> TcM TyThing
983 notFound name
984 = do { lcl_env <- getLclEnv
985 ; let stage = tcl_th_ctxt lcl_env
986 ; case stage of -- See Note [Out of scope might be a staging error]
987 Splice {}
988 | isUnboundName name -> failM -- If the name really isn't in scope
989 -- don't report it again (Trac #11941)
990 | otherwise -> stageRestrictionError (quotes (ppr name))
991 _ -> failWithTc $
992 vcat[text "GHC internal error:" <+> quotes (ppr name) <+>
993 text "is not in scope during type checking, but it passed the renamer",
994 text "tcl_env of environment:" <+> ppr (tcl_env lcl_env)]
995 -- Take care: printing the whole gbl env can
996 -- cause an infinite loop, in the case where we
997 -- are in the middle of a recursive TyCon/Class group;
998 -- so let's just not print it! Getting a loop here is
999 -- very unhelpful, because it hides one compiler bug with another
1000 }
1001
1002 wrongThingErr :: String -> TcTyThing -> Name -> TcM a
1003 -- It's important that this only calls pprTcTyThingCategory, which in
1004 -- turn does not look at the details of the TcTyThing.
1005 -- See Note [Placeholder PatSyn kinds] in TcBinds
1006 wrongThingErr expected thing name
1007 = failWithTc (pprTcTyThingCategory thing <+> quotes (ppr name) <+>
1008 text "used as a" <+> text expected)
1009
1010 {- Note [Out of scope might be a staging error]
1011 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1012 Consider
1013 x = 3
1014 data T = MkT $(foo x)
1015
1016 where 'foo' is imported from somewhere.
1017
1018 This is really a staging error, because we can't run code involving 'x'.
1019 But in fact the type checker processes types first, so 'x' won't even be
1020 in the type envt when we look for it in $(foo x). So inside splices we
1021 report something missing from the type env as a staging error.
1022 See Trac #5752 and #5795.
1023 -}