2 % (c) The University of Glasgow 2006
7 TyThing(..), TcTyThing(..), TcId,
9 -- Instance environment, and InstInfo type
10 InstInfo(..), iDFunId, pprInstInfo, pprInstInfoDetails,
11 simpleInstInfoClsTy, simpleInstInfoTy, simpleInstInfoTyCon,
15 tcExtendGlobalEnv, setGlobalTypeEnv,
17 tcLookupLocatedGlobal, tcLookupGlobal,
18 tcLookupField, tcLookupTyCon, tcLookupClass, tcLookupDataCon,
19 tcLookupLocatedGlobalId, tcLookupLocatedTyCon,
20 tcLookupLocatedClass, tcLookupFamInst,
23 tcExtendKindEnv, tcExtendKindEnvTvs,
24 tcExtendTyVarEnv, tcExtendTyVarEnv2,
26 tcExtendIdEnv, tcExtendIdEnv1, tcExtendIdEnv2,
27 tcLookup, tcLookupLocated, tcLookupLocalIds,
28 tcLookupId, tcLookupTyVar, getScopedTyVarBinds,
29 lclEnvElts, getInLocalScope, findGlobals,
30 wrongThingErr, pprBinders,
32 tcExtendRecEnv, -- For knot-tying
37 -- Global type variables
40 -- Template Haskell stuff
41 checkWellStaged, spliceOK, bracketOK, tcMetaTy, thLevel,
42 topIdLvl, thTopLevelId, thRnBrack, isBrackStage,
45 newLocalName, newDFunName, newFamInstTyConName,
46 mkStableIdFromString, mkStableIdFromName
49 #include "HsVersions.h"
57 -- import TcSuspension
83 %************************************************************************
87 %************************************************************************
89 Using the Located versions (eg. tcLookupLocatedGlobal) is preferred,
90 unless you know that the SrcSpan in the monad is already set to the
94 tcLookupLocatedGlobal :: Located Name -> TcM TyThing
95 -- c.f. IfaceEnvEnv.tcIfaceGlobal
96 tcLookupLocatedGlobal name
97 = addLocM tcLookupGlobal name
99 tcLookupGlobal :: Name -> TcM TyThing
100 -- The Name is almost always an ExternalName, but not always
101 -- In GHCi, we may make command-line bindings (ghci> let x = True)
102 -- that bind a GlobalId, but with an InternalName
104 = do { env <- getGblEnv
107 ; case lookupNameEnv (tcg_type_env env) name of {
108 Just thing -> return thing ;
112 { hsc_env <- getTopEnv
113 ; mb_thing <- liftIO (lookupTypeHscEnv hsc_env name)
115 Just thing -> return thing ;
118 -- Should it have been in the local envt?
119 { case nameModule_maybe name of
120 Nothing -> notFound name env -- Internal names can happen in GHCi
122 Just mod | mod == tcg_mod env -- Names from this module
123 -> notFound name env -- should be in tcg_type_env
125 -> tcImportDecl name -- Go find it in an interface
128 tcLookupField :: Name -> TcM Id -- Returns the selector Id
129 tcLookupField name = do
130 thing <- tcLookup name -- Note [Record field lookup]
132 AGlobal (AnId id) -> return id
133 thing -> wrongThingErr "field name" thing name
135 {- Note [Record field lookup]
136 ~~~~~~~~~~~~~~~~~~~~~~~~~~
137 You might think we should have tcLookupGlobal here, since record fields
138 are always top level. But consider
140 Then the renamer (which does not keep track of what is a record selector
141 and what is not) will rename the definition thus
142 f_7 = e { f_7 = True }
143 Now the type checker will find f_7 in the *local* type environment, not
144 the global (imported) one. It's wrong, of course, but we want to report a tidy
145 error, not in TcEnv.notFound. -}
147 tcLookupDataCon :: Name -> TcM DataCon
148 tcLookupDataCon name = do
149 thing <- tcLookupGlobal name
151 ADataCon con -> return con
152 _ -> wrongThingErr "data constructor" (AGlobal thing) name
154 tcLookupClass :: Name -> TcM Class
155 tcLookupClass name = do
156 thing <- tcLookupGlobal name
158 AClass cls -> return cls
159 _ -> wrongThingErr "class" (AGlobal thing) name
161 tcLookupTyCon :: Name -> TcM TyCon
162 tcLookupTyCon name = do
163 thing <- tcLookupGlobal name
165 ATyCon tc -> return tc
166 _ -> wrongThingErr "type constructor" (AGlobal thing) name
168 tcLookupLocatedGlobalId :: Located Name -> TcM Id
169 tcLookupLocatedGlobalId = addLocM tcLookupId
171 tcLookupLocatedClass :: Located Name -> TcM Class
172 tcLookupLocatedClass = addLocM tcLookupClass
174 tcLookupLocatedTyCon :: Located Name -> TcM TyCon
175 tcLookupLocatedTyCon = addLocM tcLookupTyCon
177 -- Look up the instance tycon of a family instance.
179 -- The match must be unique - ie, match exactly one instance - but the
180 -- type arguments used for matching may be more specific than those of
181 -- the family instance declaration.
183 -- Return the instance tycon and its type instance. For example, if we have
185 -- tcLookupFamInst 'T' '[Int]' yields (':R42T', 'Int')
187 -- then we have a coercion (ie, type instance of family instance coercion)
189 -- :Co:R42T Int :: T [Int] ~ :R42T Int
191 -- which implies that :R42T was declared as 'data instance T [a]'.
193 tcLookupFamInst :: TyCon -> [Type] -> TcM (Maybe (TyCon, [Type]))
194 tcLookupFamInst tycon tys
195 | not (isOpenTyCon tycon)
198 = do { env <- getGblEnv
200 ; let instEnv = (eps_fam_inst_env eps, tcg_fam_inst_env env)
201 ; case lookupFamInstEnv instEnv tycon tys of
202 [(fam_inst, rep_tys)] -> return $ Just (famInstTyCon fam_inst,
209 instance MonadThings (IOEnv (Env TcGblEnv TcLclEnv)) where
210 lookupThing = tcLookupGlobal
213 %************************************************************************
215 Extending the global environment
217 %************************************************************************
221 setGlobalTypeEnv :: TcGblEnv -> TypeEnv -> TcM TcGblEnv
222 -- Use this to update the global type env
223 -- It updates both * the normal tcg_type_env field
224 -- * the tcg_type_env_var field seen by interface files
225 setGlobalTypeEnv tcg_env new_type_env
226 = do { -- Sync the type-envt variable seen by interface files
227 writeMutVar (tcg_type_env_var tcg_env) new_type_env
228 ; return (tcg_env { tcg_type_env = new_type_env }) }
230 tcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r
231 -- Given a mixture of Ids, TyCons, Classes, all from the
232 -- module being compiled, extend the global environment
233 tcExtendGlobalEnv things thing_inside
234 = do { tcg_env <- getGblEnv
235 ; let ge' = extendTypeEnvList (tcg_type_env tcg_env) things
236 ; tcg_env' <- setGlobalTypeEnv tcg_env ge'
237 ; setGblEnv tcg_env' thing_inside }
239 tcExtendGlobalValEnv :: [Id] -> TcM a -> TcM a
240 -- Same deal as tcExtendGlobalEnv, but for Ids
241 tcExtendGlobalValEnv ids thing_inside
242 = tcExtendGlobalEnv [AnId id | id <- ids] thing_inside
244 tcExtendRecEnv :: [(Name,TyThing)] -> TcM r -> TcM r
245 -- Extend the global environments for the type/class knot tying game
246 -- Just like tcExtendGlobalEnv, except the argument is a list of pairs
247 tcExtendRecEnv gbl_stuff thing_inside
248 = do { tcg_env <- getGblEnv
249 ; let ge' = extendNameEnvList (tcg_type_env tcg_env) gbl_stuff
250 ; tcg_env' <- setGlobalTypeEnv tcg_env ge'
251 ; setGblEnv tcg_env' thing_inside }
255 %************************************************************************
257 \subsection{The local environment}
259 %************************************************************************
262 tcLookupLocated :: Located Name -> TcM TcTyThing
263 tcLookupLocated = addLocM tcLookup
265 tcLookup :: Name -> TcM TcTyThing
267 local_env <- getLclEnv
268 case lookupNameEnv (tcl_env local_env) name of
269 Just thing -> return thing
270 Nothing -> AGlobal <$> tcLookupGlobal name
272 tcLookupTyVar :: Name -> TcM TcTyVar
273 tcLookupTyVar name = do
274 thing <- tcLookup name
276 ATyVar _ ty -> return (tcGetTyVar "tcLookupTyVar" ty)
277 _ -> pprPanic "tcLookupTyVar" (ppr name)
279 tcLookupId :: Name -> TcM Id
280 -- Used when we aren't interested in the binding level, nor refinement.
281 -- The "no refinement" part means that we return the un-refined Id regardless
283 -- The Id is never a DataCon. (Why does that matter? see TcExpr.tcId)
285 thing <- tcLookup name
287 ATcId { tct_id = id} -> return id
288 AGlobal (AnId id) -> return id
289 _ -> pprPanic "tcLookupId" (ppr name)
291 tcLookupLocalIds :: [Name] -> TcM [TcId]
292 -- We expect the variables to all be bound, and all at
293 -- the same level as the lookup. Only used in one place...
294 tcLookupLocalIds ns = do
296 return (map (lookup (tcl_env env) (thLevel (tcl_th_ctxt env))) ns)
299 = case lookupNameEnv lenv name of
300 Just (ATcId { tct_id = id, tct_level = lvl1 })
301 -> ASSERT( lvl == lvl1 ) id
302 _ -> pprPanic "tcLookupLocalIds" (ppr name)
304 lclEnvElts :: TcLclEnv -> [TcTyThing]
305 lclEnvElts env = nameEnvElts (tcl_env env)
307 getInLocalScope :: TcM (Name -> Bool)
311 let lcl_env = tcl_env env
312 return (`elemNameEnv` lcl_env)
316 tcExtendKindEnv :: [(Name, TcKind)] -> TcM r -> TcM r
317 tcExtendKindEnv things thing_inside
318 = updLclEnv upd thing_inside
320 upd lcl_env = lcl_env { tcl_env = extend (tcl_env lcl_env) }
321 extend env = extendNameEnvList env [(n, AThing k) | (n,k) <- things]
323 tcExtendKindEnvTvs :: [LHsTyVarBndr Name] -> TcM r -> TcM r
324 tcExtendKindEnvTvs bndrs thing_inside
325 = updLclEnv upd thing_inside
327 upd lcl_env = lcl_env { tcl_env = extend (tcl_env lcl_env) }
328 extend env = extendNameEnvList env pairs
329 pairs = [(n, AThing k) | L _ (KindedTyVar n k) <- bndrs]
331 tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
332 tcExtendTyVarEnv tvs thing_inside
333 = tcExtendTyVarEnv2 [(tyVarName tv, mkTyVarTy tv) | tv <- tvs] thing_inside
335 tcExtendTyVarEnv2 :: [(Name,TcType)] -> TcM r -> TcM r
336 tcExtendTyVarEnv2 binds thing_inside = do
337 env@(TcLclEnv {tcl_env = le,
339 tcl_rdr = rdr_env}) <- getLclEnv
341 rdr_env' = extendLocalRdrEnv rdr_env (map fst binds)
342 new_tv_set = tcTyVarsOfTypes (map snd binds)
343 le' = extendNameEnvList le [(name, ATyVar name ty) | (name, ty) <- binds]
345 -- It's important to add the in-scope tyvars to the global tyvar set
347 -- f (_::r) = let g y = y::r in ...
348 -- Here, g mustn't be generalised. This is also important during
349 -- class and instance decls, when we mustn't generalise the class tyvars
350 -- when typechecking the methods.
351 gtvs' <- tc_extend_gtvs gtvs new_tv_set
352 setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs', tcl_rdr = rdr_env'}) thing_inside
354 getScopedTyVarBinds :: TcM [(Name, TcType)]
356 = do { lcl_env <- getLclEnv
357 ; return [(name, ty) | ATyVar name ty <- nameEnvElts (tcl_env lcl_env)] }
362 tcExtendIdEnv :: [TcId] -> TcM a -> TcM a
363 tcExtendIdEnv ids thing_inside = tcExtendIdEnv2 [(idName id, id) | id <- ids] thing_inside
365 tcExtendIdEnv1 :: Name -> TcId -> TcM a -> TcM a
366 tcExtendIdEnv1 name id thing_inside = tcExtendIdEnv2 [(name,id)] thing_inside
368 tcExtendIdEnv2 :: [(Name,TcId)] -> TcM a -> TcM a
369 -- Invariant: the TcIds are fully zonked (see tcExtendIdEnv above)
370 tcExtendIdEnv2 names_w_ids thing_inside
371 = do { env <- getLclEnv
372 ; tc_extend_local_id_env env (thLevel (tcl_th_ctxt env)) names_w_ids thing_inside }
374 tcExtendGhciEnv :: [TcId] -> TcM a -> TcM a
375 -- Used to bind Ids for GHCi identifiers bound earlier in the user interaction
376 -- Note especially that we bind them at TH level 'impLevel'. That's because it's
377 -- OK to use a variable bound earlier in the interaction in a splice, becuase
378 -- GHCi has already compiled it to bytecode
379 tcExtendGhciEnv ids thing_inside
380 = do { env <- getLclEnv
381 ; tc_extend_local_id_env env impLevel [(idName id, id) | id <- ids] thing_inside }
383 tc_extend_local_id_env -- This is the guy who does the work
388 -- Invariant: the TcIds are fully zonked. Reasons:
389 -- (a) The kinds of the forall'd type variables are defaulted
390 -- (see Kind.defaultKind, done in zonkQuantifiedTyVar)
391 -- (b) There are no via-Indirect occurrences of the bound variables
392 -- in the types, because instantiation does not look through such things
393 -- (c) The call to tyVarsOfTypes is ok without looking through refs
395 tc_extend_local_id_env env th_lvl names_w_ids thing_inside
396 = do { traceTc (text "env2")
397 ; traceTc (text "env3" <+> ppr extra_env)
398 ; gtvs' <- tc_extend_gtvs (tcl_tyvars env) extra_global_tyvars
399 ; let env' = env {tcl_env = le', tcl_tyvars = gtvs', tcl_rdr = rdr_env'}
400 ; setLclEnv env' thing_inside }
402 extra_global_tyvars = tcTyVarsOfTypes [idType id | (_,id) <- names_w_ids]
403 extra_env = [ (name, ATcId { tct_id = id,
406 tct_co = case isRefineableTy id_ty of
407 (True,_) -> Unrefineable
408 (_,True) -> Rigid idHsWrapper
410 | (name,id) <- names_w_ids, let id_ty = idType id]
411 le' = extendNameEnvList (tcl_env env) extra_env
412 rdr_env' = extendLocalRdrEnv (tcl_rdr env) [name | (name,_) <- names_w_ids]
417 -----------------------
418 -- findGlobals looks at the value environment and finds values
419 -- whose types mention the offending type variable. It has to be
420 -- careful to zonk the Id's type first, so it has to be in the monad.
421 -- We must be careful to pass it a zonked type variable, too.
423 findGlobals :: TcTyVarSet
425 -> TcM (TidyEnv, [SDoc])
427 findGlobals tvs tidy_env = do
429 go tidy_env [] (lclEnvElts lcl_env)
431 go tidy_env acc [] = return (tidy_env, acc)
432 go tidy_env acc (thing : things) = do
433 (tidy_env1, maybe_doc) <- find_thing ignore_it tidy_env thing
435 Just d -> go tidy_env1 (d:acc) things
436 Nothing -> go tidy_env1 acc things
438 ignore_it ty = tvs `disjointVarSet` tyVarsOfType ty
440 -----------------------
441 find_thing :: (TcType -> Bool) -> TidyEnv -> TcTyThing
442 -> TcM (TidyEnv, Maybe SDoc)
443 find_thing ignore_it tidy_env (ATcId { tct_id = id }) = do
444 id_ty <- zonkTcType (idType id)
445 if ignore_it id_ty then
446 return (tidy_env, Nothing)
448 (tidy_env', tidy_ty) = tidyOpenType tidy_env id_ty
449 msg = sep [ppr id <+> dcolon <+> ppr tidy_ty,
450 nest 2 (parens (ptext (sLit "bound at") <+>
451 ppr (getSrcLoc id)))]
453 return (tidy_env', Just msg)
455 find_thing ignore_it tidy_env (ATyVar tv ty) = do
456 tv_ty <- zonkTcType ty
457 if ignore_it tv_ty then
458 return (tidy_env, Nothing)
460 -- The name tv is scoped, so we don't need to tidy it
461 (tidy_env1, tidy_ty) = tidyOpenType tidy_env tv_ty
462 msg = sep [ptext (sLit "Scoped type variable") <+> quotes (ppr tv) <+> eq_stuff, nest 2 bound_at]
464 eq_stuff | Just tv' <- Type.getTyVar_maybe tv_ty,
465 getOccName tv == getOccName tv' = empty
466 | otherwise = equals <+> ppr tidy_ty
467 -- It's ok to use Type.getTyVar_maybe because ty is zonked by now
468 bound_at = parens $ ptext (sLit "bound at:") <+> ppr (getSrcLoc tv)
470 return (tidy_env1, Just msg)
472 find_thing _ _ thing = pprPanic "find_thing" (ppr thing)
475 %************************************************************************
477 \subsection{The global tyvars}
479 %************************************************************************
482 tc_extend_gtvs :: IORef VarSet -> VarSet -> TcM (IORef VarSet)
483 tc_extend_gtvs gtvs extra_global_tvs = do
484 global_tvs <- readMutVar gtvs
485 newMutVar (global_tvs `unionVarSet` extra_global_tvs)
488 @tcGetGlobalTyVars@ returns a fully-zonked set of tyvars free in the environment.
489 To improve subsequent calls to the same function it writes the zonked set back into
493 tcGetGlobalTyVars :: TcM TcTyVarSet
494 tcGetGlobalTyVars = do
495 (TcLclEnv {tcl_tyvars = gtv_var}) <- getLclEnv
496 gbl_tvs <- readMutVar gtv_var
497 gbl_tvs' <- zonkTcTyVarsAndFV (varSetElems gbl_tvs)
498 writeMutVar gtv_var gbl_tvs'
503 %************************************************************************
507 %************************************************************************
510 tcExtendRules :: [LRuleDecl Id] -> TcM a -> TcM a
511 -- Just pop the new rules into the EPS and envt resp
512 -- All the rules come from an interface file, not soruce
513 -- Nevertheless, some may be for this module, if we read
514 -- its interface instead of its source code
515 tcExtendRules lcl_rules thing_inside
516 = do { env <- getGblEnv
518 env' = env { tcg_rules = lcl_rules ++ tcg_rules env }
519 ; setGblEnv env' thing_inside }
523 %************************************************************************
527 %************************************************************************
530 instance Outputable ThStage where
531 ppr (Comp l) = text "Comp" <+> int l
532 ppr (Brack l _ _) = text "Brack" <+> int l
533 ppr (Splice l) = text "Splice" <+> int l
536 thLevel :: ThStage -> ThLevel
538 thLevel (Splice l) = l
539 thLevel (Brack l _ _) = l
542 checkWellStaged :: SDoc -- What the stage check is for
543 -> ThLevel -- Binding level (increases inside brackets)
544 -> ThStage -- Use stage
545 -> TcM () -- Fail if badly staged, adding an error
546 checkWellStaged pp_thing bind_lvl use_stage
547 | use_lvl >= bind_lvl -- OK! Used later than bound
548 = return () -- E.g. \x -> [| $(f x) |]
550 | bind_lvl == topLevel -- GHC restriction on top level splices
552 sep [ptext (sLit "GHC stage restriction:") <+> pp_thing,
553 nest 2 (ptext (sLit "is used in") <+> use_lvl_doc <> ptext (sLit ", and must be imported, not defined locally"))]
555 | otherwise -- Badly staged
556 = failWithTc $ -- E.g. \x -> $(f x)
557 ptext (sLit "Stage error:") <+> pp_thing <+>
558 hsep [ptext (sLit "is bound at stage") <+> ppr bind_lvl,
559 ptext (sLit "but used at stage") <+> ppr use_lvl]
561 use_lvl = thLevel use_stage
562 use_lvl_doc | use_lvl == thLevel topStage = ptext (sLit "a top-level splice")
563 | use_lvl == thLevel topAnnStage = ptext (sLit "an annotation")
564 | otherwise = panic "checkWellStaged"
566 topIdLvl :: Id -> ThLevel
567 -- Globals may either be imported, or may be from an earlier "chunk"
568 -- (separated by declaration splices) of this module. The former
569 -- *can* be used inside a top-level splice, but the latter cannot.
570 -- Hence we give the former impLevel, but the latter topLevel
574 -- By the time we are prcessing the $(f x), the binding for "x"
575 -- will be in the global env, not the local one.
576 topIdLvl id | isLocalId id = topLevel
577 | otherwise = impLevel
579 -- Indicates the legal transitions on bracket( [| |] ).
580 bracketOK :: ThStage -> Maybe ThLevel
581 bracketOK (Brack _ _ _) = Nothing -- Bracket illegal inside a bracket
582 bracketOK stage = Just (thLevel stage + 1)
584 -- Indicates the legal transitions on splice($).
585 spliceOK :: ThStage -> Maybe ThLevel
586 spliceOK (Splice _) = Nothing -- Splice illegal inside splice
587 spliceOK stage = Just (thLevel stage - 1)
589 tcMetaTy :: Name -> TcM Type
590 -- Given the name of a Template Haskell data type,
592 -- E.g. given the name "Expr" return the type "Expr"
593 tcMetaTy tc_name = do
594 t <- tcLookupTyCon tc_name
595 return (mkTyConApp t [])
598 -- Used *only* to indicate that we are inside a TH bracket during renaming
599 -- Tested by TcEnv.isBrackStage
600 -- See Note [Top-level Names in Template Haskell decl quotes]
601 thRnBrack = Brack (panic "thRnBrack1") (panic "thRnBrack2") (panic "thRnBrack3")
603 isBrackStage :: ThStage -> Bool
604 isBrackStage (Brack {}) = True
605 isBrackStage _other = False
607 thTopLevelId :: Id -> Bool
608 -- See Note [What is a top-level Id?] in TcSplice
609 thTopLevelId id = isGlobalId id || isExternalName (idName id)
613 %************************************************************************
615 \subsection{The InstInfo type}
617 %************************************************************************
619 The InstInfo type summarises the information in an instance declaration
621 instance c => k (t tvs) where b
623 It is used just for *local* instance decls (not ones from interface files).
624 But local instance decls includes
627 as well as explicit user written ones.
632 iSpec :: Instance, -- Includes the dfun id. Its forall'd type
633 iBinds :: InstBindings a -- variables scope over the stuff in InstBindings!
636 iDFunId :: InstInfo a -> DFunId
637 iDFunId info = instanceDFunId (iSpec info)
640 = VanillaInst -- The normal case
641 (LHsBinds a) -- Bindings for the instance methods
642 [LSig a] -- User pragmas recorded for generating
643 -- specialised instances
645 | NewTypeDerived -- Used for deriving instances of newtypes, where the
646 CoercionI -- witness dictionary is identical to the argument
647 -- dictionary. Hence no bindings, no pragmas.
648 -- The coercion maps from newtype to the representation type
649 -- (mentioning type variables bound by the forall'd iSpec variables)
650 -- E.g. newtype instance N [a] = N1 (Tree a)
651 -- co : N [a] ~ Tree a
653 pprInstInfo :: InstInfo a -> SDoc
654 pprInstInfo info = vcat [ptext (sLit "InstInfo:") <+> ppr (idType (iDFunId info))]
656 pprInstInfoDetails :: OutputableBndr a => InstInfo a -> SDoc
657 pprInstInfoDetails info = pprInstInfo info $$ nest 2 (details (iBinds info))
659 details (VanillaInst b _) = pprLHsBinds b
660 details (NewTypeDerived _) = text "Derived from the representation type"
662 simpleInstInfoClsTy :: InstInfo a -> (Class, Type)
663 simpleInstInfoClsTy info = case instanceHead (iSpec info) of
664 (_, _, cls, [ty]) -> (cls, ty)
665 _ -> panic "simpleInstInfoClsTy"
667 simpleInstInfoTy :: InstInfo a -> Type
668 simpleInstInfoTy info = snd (simpleInstInfoClsTy info)
670 simpleInstInfoTyCon :: InstInfo a -> TyCon
671 -- Gets the type constructor for a simple instance declaration,
672 -- i.e. one of the form instance (...) => C (T a b c) where ...
673 simpleInstInfoTyCon inst = tcTyConAppTyCon (simpleInstInfoTy inst)
676 Make a name for the dict fun for an instance decl. It's an *external*
677 name, like otber top-level names, and hence must be made with newGlobalBinder.
680 newDFunName :: Class -> [Type] -> SrcSpan -> TcM Name
681 newDFunName clas (ty:_) loc
682 = do { index <- nextDFunIndex
683 ; is_boot <- tcIsHsBoot
685 ; let info_string = occNameString (getOccName clas) ++
686 occNameString (getDFunTyKey ty)
687 dfun_occ = mkDFunOcc info_string is_boot index
689 ; newGlobalBinder mod dfun_occ loc }
691 newDFunName clas [] loc = pprPanic "newDFunName" (ppr clas <+> ppr loc)
694 Make a name for the representation tycon of a family instance. It's an
695 *external* name, like otber top-level names, and hence must be made with
699 newFamInstTyConName :: Name -> SrcSpan -> TcM Name
700 newFamInstTyConName tc_name loc
701 = do { index <- nextDFunIndex
703 ; let occ = nameOccName tc_name
704 ; newGlobalBinder mod (mkInstTyTcOcc index occ) loc }
707 Stable names used for foreign exports and annotations.
708 For stable names, the name must be unique (see #1533). If the
709 same thing has several stable Ids based on it, the
710 top-level bindings generated must not have the same name.
711 Hence we create an External name (doesn't change), and we
712 append a Unique to the string right here.
715 mkStableIdFromString :: String -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
716 mkStableIdFromString str sig_ty loc occ_wrapper = do
719 let uniq_str = showSDoc (pprUnique uniq) :: String
720 occ = mkVarOcc (str ++ '_' : uniq_str) :: OccName
721 gnm = mkExternalName uniq mod (occ_wrapper occ) loc :: Name
722 id = mkExportedLocalId gnm sig_ty :: Id
725 mkStableIdFromName :: Name -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
726 mkStableIdFromName nm = mkStableIdFromString (getOccString nm)
729 %************************************************************************
733 %************************************************************************
736 pprBinders :: [Name] -> SDoc
737 -- Used in error messages
738 -- Use quotes for a single one; they look a bit "busy" for several
739 pprBinders [bndr] = quotes (ppr bndr)
740 pprBinders bndrs = pprWithCommas ppr bndrs
742 notFound :: Name -> TcGblEnv -> TcM TyThing
744 = failWithTc (vcat[ptext (sLit "GHC internal error:") <+> quotes (ppr name) <+>
745 ptext (sLit "is not in scope during type checking, but it passed the renamer"),
746 ptext (sLit "tcg_type_env of environment:") <+> ppr (tcg_type_env env)]
749 wrongThingErr :: String -> TcTyThing -> Name -> TcM a
750 wrongThingErr expected thing name
751 = failWithTc (pprTcTyThingCategory thing <+> quotes (ppr name) <+>
752 ptext (sLit "used as a") <+> text expected)