Refactor type family instance abstract syntax declarations
[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_eqn = HsIB { hsib_body =
596 FamEqn { feqn_rhs = HsDataDefn { dd_cons = cons } }}})
597 = map unLoc $ concatMap (getConNames . unLoc) cons
598
599
600 tcAddPatSynPlaceholders :: [PatSynBind GhcRn GhcRn] -> TcM a -> TcM a
601 -- See Note [Don't promote pattern synonyms]
602 tcAddPatSynPlaceholders pat_syns thing_inside
603 = tcExtendKindEnvList [ (name, APromotionErr PatSynPE)
604 | PSB{ psb_id = L _ name } <- pat_syns ]
605 thing_inside
606
607 getTypeSigNames :: [LSig GhcRn] -> NameSet
608 -- Get the names that have a user type sig
609 getTypeSigNames sigs
610 = foldr get_type_sig emptyNameSet sigs
611 where
612 get_type_sig :: LSig GhcRn -> NameSet -> NameSet
613 get_type_sig sig ns =
614 case sig of
615 L _ (TypeSig names _) -> extendNameSetList ns (map unLoc names)
616 L _ (PatSynSig names _) -> extendNameSetList ns (map unLoc names)
617 _ -> ns
618
619
620 {- Note [AFamDataCon: not promoting data family constructors]
621 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
622 Consider
623 data family T a
624 data instance T Int = MkT
625 data Proxy (a :: k)
626 data S = MkS (Proxy 'MkT)
627
628 Is it ok to use the promoted data family instance constructor 'MkT' in
629 the data declaration for S (where both declarations live in the same module)?
630 No, we don't allow this. It *might* make sense, but at least it would mean that
631 we'd have to interleave typechecking instances and data types, whereas at
632 present we do data types *then* instances.
633
634 So to check for this we put in the TcLclEnv a binding for all the family
635 constructors, bound to AFamDataCon, so that if we trip over 'MkT' when
636 type checking 'S' we'll produce a decent error message.
637
638 Trac #12088 describes this limitation. Of course, when MkT and S live in
639 different modules then all is well.
640
641 Note [Don't promote pattern synonyms]
642 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
643 We never promote pattern synonyms.
644
645 Consider this (Trac #11265):
646 pattern A = True
647 instance Eq A
648 We want a civilised error message from the occurrence of 'A'
649 in the instance, yet 'A' really has not yet been type checked.
650
651 Similarly (Trac #9161)
652 {-# LANGUAGE PatternSynonyms, DataKinds #-}
653 pattern A = ()
654 b :: A
655 b = undefined
656 Here, the type signature for b mentions A. But A is a pattern
657 synonym, which is typechecked as part of a group of bindings (for very
658 good reasons; a view pattern in the RHS may mention a value binding).
659 It is entirely reasonable to reject this, but to do so we need A to be
660 in the kind environment when kind-checking the signature for B.
661
662 Hence tcAddPatSynPlaceholers adds a binding
663 A -> APromotionErr PatSynPE
664 to the environment. Then TcHsType.tcTyVar will find A in the kind
665 environment, and will give a 'wrongThingErr' as a result. But the
666 lookup of A won't fail.
667
668
669 ************************************************************************
670 * *
671 \subsection{Rules}
672 * *
673 ************************************************************************
674 -}
675
676 tcExtendRules :: [LRuleDecl GhcTc] -> TcM a -> TcM a
677 -- Just pop the new rules into the EPS and envt resp
678 -- All the rules come from an interface file, not source
679 -- Nevertheless, some may be for this module, if we read
680 -- its interface instead of its source code
681 tcExtendRules lcl_rules thing_inside
682 = do { env <- getGblEnv
683 ; let
684 env' = env { tcg_rules = lcl_rules ++ tcg_rules env }
685 ; setGblEnv env' thing_inside }
686
687 {-
688 ************************************************************************
689 * *
690 Meta level
691 * *
692 ************************************************************************
693 -}
694
695 checkWellStaged :: SDoc -- What the stage check is for
696 -> ThLevel -- Binding level (increases inside brackets)
697 -> ThLevel -- Use stage
698 -> TcM () -- Fail if badly staged, adding an error
699 checkWellStaged pp_thing bind_lvl use_lvl
700 | use_lvl >= bind_lvl -- OK! Used later than bound
701 = return () -- E.g. \x -> [| $(f x) |]
702
703 | bind_lvl == outerLevel -- GHC restriction on top level splices
704 = stageRestrictionError pp_thing
705
706 | otherwise -- Badly staged
707 = failWithTc $ -- E.g. \x -> $(f x)
708 text "Stage error:" <+> pp_thing <+>
709 hsep [text "is bound at stage" <+> ppr bind_lvl,
710 text "but used at stage" <+> ppr use_lvl]
711
712 stageRestrictionError :: SDoc -> TcM a
713 stageRestrictionError pp_thing
714 = failWithTc $
715 sep [ text "GHC stage restriction:"
716 , nest 2 (vcat [ pp_thing <+> text "is used in a top-level splice, quasi-quote, or annotation,"
717 , text "and must be imported, not defined locally"])]
718
719 topIdLvl :: Id -> ThLevel
720 -- Globals may either be imported, or may be from an earlier "chunk"
721 -- (separated by declaration splices) of this module. The former
722 -- *can* be used inside a top-level splice, but the latter cannot.
723 -- Hence we give the former impLevel, but the latter topLevel
724 -- E.g. this is bad:
725 -- x = [| foo |]
726 -- $( f x )
727 -- By the time we are prcessing the $(f x), the binding for "x"
728 -- will be in the global env, not the local one.
729 topIdLvl id | isLocalId id = outerLevel
730 | otherwise = impLevel
731
732 tcMetaTy :: Name -> TcM Type
733 -- Given the name of a Template Haskell data type,
734 -- return the type
735 -- E.g. given the name "Expr" return the type "Expr"
736 tcMetaTy tc_name = do
737 t <- tcLookupTyCon tc_name
738 return (mkTyConApp t [])
739
740 isBrackStage :: ThStage -> Bool
741 isBrackStage (Brack {}) = True
742 isBrackStage _other = False
743
744 {-
745 ************************************************************************
746 * *
747 getDefaultTys
748 * *
749 ************************************************************************
750 -}
751
752 tcGetDefaultTys :: TcM ([Type], -- Default types
753 (Bool, -- True <=> Use overloaded strings
754 Bool)) -- True <=> Use extended defaulting rules
755 tcGetDefaultTys
756 = do { dflags <- getDynFlags
757 ; let ovl_strings = xopt LangExt.OverloadedStrings dflags
758 extended_defaults = xopt LangExt.ExtendedDefaultRules dflags
759 -- See also Trac #1974
760 flags = (ovl_strings, extended_defaults)
761
762 ; mb_defaults <- getDeclaredDefaultTys
763 ; case mb_defaults of {
764 Just tys -> return (tys, flags) ;
765 -- User-supplied defaults
766 Nothing -> do
767
768 -- No use-supplied default
769 -- Use [Integer, Double], plus modifications
770 { integer_ty <- tcMetaTy integerTyConName
771 ; list_ty <- tcMetaTy listTyConName
772 ; checkWiredInTyCon doubleTyCon
773 ; let deflt_tys = opt_deflt extended_defaults [unitTy, list_ty]
774 -- Note [Extended defaults]
775 ++ [integer_ty, doubleTy]
776 ++ opt_deflt ovl_strings [stringTy]
777 ; return (deflt_tys, flags) } } }
778 where
779 opt_deflt True xs = xs
780 opt_deflt False _ = []
781
782 {-
783 Note [Extended defaults]
784 ~~~~~~~~~~~~~~~~~~~~~
785 In interative mode (or with -XExtendedDefaultRules) we add () as the first type we
786 try when defaulting. This has very little real impact, except in the following case.
787 Consider:
788 Text.Printf.printf "hello"
789 This has type (forall a. IO a); it prints "hello", and returns 'undefined'. We don't
790 want the GHCi repl loop to try to print that 'undefined'. The neatest thing is to
791 default the 'a' to (), rather than to Integer (which is what would otherwise happen;
792 and then GHCi doesn't attempt to print the (). So in interactive mode, we add
793 () to the list of defaulting types. See Trac #1200.
794
795 Additonally, the list type [] is added as a default specialization for
796 Traversable and Foldable. As such the default default list now has types of
797 varying kinds, e.g. ([] :: * -> *) and (Integer :: *).
798
799 ************************************************************************
800 * *
801 \subsection{The InstInfo type}
802 * *
803 ************************************************************************
804
805 The InstInfo type summarises the information in an instance declaration
806
807 instance c => k (t tvs) where b
808
809 It is used just for *local* instance decls (not ones from interface files).
810 But local instance decls includes
811 - derived ones
812 - generic ones
813 as well as explicit user written ones.
814 -}
815
816 data InstInfo a
817 = InstInfo
818 { iSpec :: ClsInst -- Includes the dfun id
819 , iBinds :: InstBindings a
820 }
821
822 iDFunId :: InstInfo a -> DFunId
823 iDFunId info = instanceDFunId (iSpec info)
824
825 data InstBindings a
826 = InstBindings
827 { ib_tyvars :: [Name] -- Names of the tyvars from the instance head
828 -- that are lexically in scope in the bindings
829 -- Must correspond 1-1 with the forall'd tyvars
830 -- of the dfun Id. When typechecking, we are
831 -- going to extend the typechecker's envt with
832 -- ib_tyvars -> dfun_forall_tyvars
833
834 , ib_binds :: LHsBinds a -- Bindings for the instance methods
835
836 , ib_pragmas :: [LSig a] -- User pragmas recorded for generating
837 -- specialised instances
838
839 , ib_extensions :: [LangExt.Extension] -- Any extra extensions that should
840 -- be enabled when type-checking
841 -- this instance; needed for
842 -- GeneralizedNewtypeDeriving
843
844 , ib_derived :: Bool
845 -- True <=> This code was generated by GHC from a deriving clause
846 -- or standalone deriving declaration
847 -- Used only to improve error messages
848 }
849
850 instance (SourceTextX a, OutputableBndrId a) => Outputable (InstInfo a) where
851 ppr = pprInstInfoDetails
852
853 pprInstInfoDetails :: (SourceTextX a, OutputableBndrId a) => InstInfo a -> SDoc
854 pprInstInfoDetails info
855 = hang (pprInstanceHdr (iSpec info) <+> text "where")
856 2 (details (iBinds info))
857 where
858 details (InstBindings { ib_binds = b }) = pprLHsBinds b
859
860 simpleInstInfoClsTy :: InstInfo a -> (Class, Type)
861 simpleInstInfoClsTy info = case instanceHead (iSpec info) of
862 (_, cls, [ty]) -> (cls, ty)
863 _ -> panic "simpleInstInfoClsTy"
864
865 simpleInstInfoTy :: InstInfo a -> Type
866 simpleInstInfoTy info = snd (simpleInstInfoClsTy info)
867
868 simpleInstInfoTyCon :: InstInfo a -> TyCon
869 -- Gets the type constructor for a simple instance declaration,
870 -- i.e. one of the form instance (...) => C (T a b c) where ...
871 simpleInstInfoTyCon inst = tcTyConAppTyCon (simpleInstInfoTy inst)
872
873 -- | Make a name for the dict fun for an instance decl. It's an *external*
874 -- name, like other top-level names, and hence must be made with
875 -- newGlobalBinder.
876 newDFunName :: Class -> [Type] -> SrcSpan -> TcM Name
877 newDFunName clas tys loc
878 = do { is_boot <- tcIsHsBootOrSig
879 ; mod <- getModule
880 ; let info_string = occNameString (getOccName clas) ++
881 concatMap (occNameString.getDFunTyKey) tys
882 ; dfun_occ <- chooseUniqueOccTc (mkDFunOcc info_string is_boot)
883 ; newGlobalBinder mod dfun_occ loc }
884
885 -- | Special case of 'newDFunName' to generate dict fun name for a single TyCon.
886 newDFunName' :: Class -> TyCon -> TcM Name
887 newDFunName' clas tycon -- Just a simple wrapper
888 = do { loc <- getSrcSpanM -- The location of the instance decl,
889 -- not of the tycon
890 ; newDFunName clas [mkTyConApp tycon []] loc }
891 -- The type passed to newDFunName is only used to generate
892 -- a suitable string; hence the empty type arg list
893
894 {-
895 Make a name for the representation tycon of a family instance. It's an
896 *external* name, like other top-level names, and hence must be made with
897 newGlobalBinder.
898 -}
899
900 newFamInstTyConName :: Located Name -> [Type] -> TcM Name
901 newFamInstTyConName (L loc name) tys = mk_fam_inst_name id loc name [tys]
902
903 newFamInstAxiomName :: Located Name -> [[Type]] -> TcM Name
904 newFamInstAxiomName (L loc name) branches
905 = mk_fam_inst_name mkInstTyCoOcc loc name branches
906
907 mk_fam_inst_name :: (OccName -> OccName) -> SrcSpan -> Name -> [[Type]] -> TcM Name
908 mk_fam_inst_name adaptOcc loc tc_name tyss
909 = do { mod <- getModule
910 ; let info_string = occNameString (getOccName tc_name) ++
911 intercalate "|" ty_strings
912 ; occ <- chooseUniqueOccTc (mkInstTyTcOcc info_string)
913 ; newGlobalBinder mod (adaptOcc occ) loc }
914 where
915 ty_strings = map (concatMap (occNameString . getDFunTyKey)) tyss
916
917 {-
918 Stable names used for foreign exports and annotations.
919 For stable names, the name must be unique (see #1533). If the
920 same thing has several stable Ids based on it, the
921 top-level bindings generated must not have the same name.
922 Hence we create an External name (doesn't change), and we
923 append a Unique to the string right here.
924 -}
925
926 mkStableIdFromString :: String -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
927 mkStableIdFromString str sig_ty loc occ_wrapper = do
928 uniq <- newUnique
929 mod <- getModule
930 name <- mkWrapperName "stable" str
931 let occ = mkVarOccFS name :: OccName
932 gnm = mkExternalName uniq mod (occ_wrapper occ) loc :: Name
933 id = mkExportedVanillaId gnm sig_ty :: Id
934 return id
935
936 mkStableIdFromName :: Name -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
937 mkStableIdFromName nm = mkStableIdFromString (getOccString nm)
938
939 mkWrapperName :: (MonadIO m, HasDynFlags m, HasModule m)
940 => String -> String -> m FastString
941 mkWrapperName what nameBase
942 = do dflags <- getDynFlags
943 thisMod <- getModule
944 let -- Note [Generating fresh names for ccall wrapper]
945 wrapperRef = nextWrapperNum dflags
946 pkg = unitIdString (moduleUnitId thisMod)
947 mod = moduleNameString (moduleName thisMod)
948 wrapperNum <- liftIO $ atomicModifyIORef' wrapperRef $ \mod_env ->
949 let num = lookupWithDefaultModuleEnv mod_env 0 thisMod
950 mod_env' = extendModuleEnv mod_env thisMod (num+1)
951 in (mod_env', num)
952 let components = [what, show wrapperNum, pkg, mod, nameBase]
953 return $ mkFastString $ zEncodeString $ intercalate ":" components
954
955 {-
956 Note [Generating fresh names for FFI wrappers]
957
958 We used to use a unique, rather than nextWrapperNum, to distinguish
959 between FFI wrapper functions. However, the wrapper names that we
960 generate are external names. This means that if a call to them ends up
961 in an unfolding, then we can't alpha-rename them, and thus if the
962 unique randomly changes from one compile to another then we get a
963 spurious ABI change (#4012).
964
965 The wrapper counter has to be per-module, not global, so that the number we end
966 up using is not dependent on the modules compiled before the current one.
967 -}
968
969 {-
970 ************************************************************************
971 * *
972 \subsection{Errors}
973 * *
974 ************************************************************************
975 -}
976
977 pprBinders :: [Name] -> SDoc
978 -- Used in error messages
979 -- Use quotes for a single one; they look a bit "busy" for several
980 pprBinders [bndr] = quotes (ppr bndr)
981 pprBinders bndrs = pprWithCommas ppr bndrs
982
983 notFound :: Name -> TcM TyThing
984 notFound name
985 = do { lcl_env <- getLclEnv
986 ; let stage = tcl_th_ctxt lcl_env
987 ; case stage of -- See Note [Out of scope might be a staging error]
988 Splice {}
989 | isUnboundName name -> failM -- If the name really isn't in scope
990 -- don't report it again (Trac #11941)
991 | otherwise -> stageRestrictionError (quotes (ppr name))
992 _ -> failWithTc $
993 vcat[text "GHC internal error:" <+> quotes (ppr name) <+>
994 text "is not in scope during type checking, but it passed the renamer",
995 text "tcl_env of environment:" <+> ppr (tcl_env lcl_env)]
996 -- Take care: printing the whole gbl env can
997 -- cause an infinite loop, in the case where we
998 -- are in the middle of a recursive TyCon/Class group;
999 -- so let's just not print it! Getting a loop here is
1000 -- very unhelpful, because it hides one compiler bug with another
1001 }
1002
1003 wrongThingErr :: String -> TcTyThing -> Name -> TcM a
1004 -- It's important that this only calls pprTcTyThingCategory, which in
1005 -- turn does not look at the details of the TcTyThing.
1006 -- See Note [Placeholder PatSyn kinds] in TcBinds
1007 wrongThingErr expected thing name
1008 = failWithTc (pprTcTyThingCategory thing <+> quotes (ppr name) <+>
1009 text "used as a" <+> text expected)
1010
1011 {- Note [Out of scope might be a staging error]
1012 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1013 Consider
1014 x = 3
1015 data T = MkT $(foo x)
1016
1017 where 'foo' is imported from somewhere.
1018
1019 This is really a staging error, because we can't run code involving 'x'.
1020 But in fact the type checker processes types first, so 'x' won't even be
1021 in the type envt when we look for it in $(foo x). So inside splices we
1022 report something missing from the type env as a staging error.
1023 See Trac #5752 and #5795.
1024 -}