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