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
82 %************************************************************************
86 %************************************************************************
88 Using the Located versions (eg. tcLookupLocatedGlobal) is preferred,
89 unless you know that the SrcSpan in the monad is already set to the
93 tcLookupLocatedGlobal :: Located Name -> TcM TyThing
94 -- c.f. IfaceEnvEnv.tcIfaceGlobal
95 tcLookupLocatedGlobal name
96 = addLocM tcLookupGlobal name
98 tcLookupGlobal :: Name -> TcM TyThing
99 -- The Name is almost always an ExternalName, but not always
100 -- In GHCi, we may make command-line bindings (ghci> let x = True)
101 -- that bind a GlobalId, but with an InternalName
103 = do { env <- getGblEnv
106 ; case lookupNameEnv (tcg_type_env env) name of {
107 Just thing -> return thing ;
111 { hsc_env <- getTopEnv
112 ; mb_thing <- liftIO (lookupTypeHscEnv hsc_env name)
114 Just thing -> return thing ;
117 -- Should it have been in the local envt?
118 { case nameModule_maybe name of
119 Nothing -> notFound name env -- Internal names can happen in GHCi
121 Just mod | mod == tcg_mod env -- Names from this module
122 -> notFound name env -- should be in tcg_type_env
124 -> tcImportDecl name -- Go find it in an interface
127 tcLookupField :: Name -> TcM Id -- Returns the selector Id
128 tcLookupField name = do
129 thing <- tcLookup name -- Note [Record field lookup]
131 AGlobal (AnId id) -> return id
132 thing -> wrongThingErr "field name" thing name
134 {- Note [Record field lookup]
135 ~~~~~~~~~~~~~~~~~~~~~~~~~~
136 You might think we should have tcLookupGlobal here, since record fields
137 are always top level. But consider
139 Then the renamer (which does not keep track of what is a record selector
140 and what is not) will rename the definition thus
141 f_7 = e { f_7 = True }
142 Now the type checker will find f_7 in the *local* type environment, not
143 the global (imported) one. It's wrong, of course, but we want to report a tidy
144 error, not in TcEnv.notFound. -}
146 tcLookupDataCon :: Name -> TcM DataCon
147 tcLookupDataCon name = do
148 thing <- tcLookupGlobal name
150 ADataCon con -> return con
151 _ -> wrongThingErr "data constructor" (AGlobal thing) name
153 tcLookupClass :: Name -> TcM Class
154 tcLookupClass name = do
155 thing <- tcLookupGlobal name
157 AClass cls -> return cls
158 _ -> wrongThingErr "class" (AGlobal thing) name
160 tcLookupTyCon :: Name -> TcM TyCon
161 tcLookupTyCon name = do
162 thing <- tcLookupGlobal name
164 ATyCon tc -> return tc
165 _ -> wrongThingErr "type constructor" (AGlobal thing) name
167 tcLookupLocatedGlobalId :: Located Name -> TcM Id
168 tcLookupLocatedGlobalId = addLocM tcLookupId
170 tcLookupLocatedClass :: Located Name -> TcM Class
171 tcLookupLocatedClass = addLocM tcLookupClass
173 tcLookupLocatedTyCon :: Located Name -> TcM TyCon
174 tcLookupLocatedTyCon = addLocM tcLookupTyCon
176 -- Look up the instance tycon of a family instance.
178 -- The match must be unique - ie, match exactly one instance - but the
179 -- type arguments used for matching may be more specific than those of
180 -- the family instance declaration.
182 -- Return the instance tycon and its type instance. For example, if we have
184 -- tcLookupFamInst 'T' '[Int]' yields (':R42T', 'Int')
186 -- then we have a coercion (ie, type instance of family instance coercion)
188 -- :Co:R42T Int :: T [Int] ~ :R42T Int
190 -- which implies that :R42T was declared as 'data instance T [a]'.
192 tcLookupFamInst :: TyCon -> [Type] -> TcM (Maybe (TyCon, [Type]))
193 tcLookupFamInst tycon tys
194 | not (isOpenTyCon tycon)
197 = do { env <- getGblEnv
199 ; let instEnv = (eps_fam_inst_env eps, tcg_fam_inst_env env)
200 ; case lookupFamInstEnv instEnv tycon tys of
201 [(fam_inst, rep_tys)] -> return $ Just (famInstTyCon fam_inst,
208 instance MonadThings (IOEnv (Env TcGblEnv TcLclEnv)) where
209 lookupThing = tcLookupGlobal
212 %************************************************************************
214 Extending the global environment
216 %************************************************************************
220 setGlobalTypeEnv :: TcGblEnv -> TypeEnv -> TcM TcGblEnv
221 -- Use this to update the global type env
222 -- It updates both * the normal tcg_type_env field
223 -- * the tcg_type_env_var field seen by interface files
224 setGlobalTypeEnv tcg_env new_type_env
225 = do { -- Sync the type-envt variable seen by interface files
226 writeMutVar (tcg_type_env_var tcg_env) new_type_env
227 ; return (tcg_env { tcg_type_env = new_type_env }) }
229 tcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r
230 -- Given a mixture of Ids, TyCons, Classes, all from the
231 -- module being compiled, extend the global environment
232 tcExtendGlobalEnv things thing_inside
233 = do { tcg_env <- getGblEnv
234 ; let ge' = extendTypeEnvList (tcg_type_env tcg_env) things
235 ; tcg_env' <- setGlobalTypeEnv tcg_env ge'
236 ; setGblEnv tcg_env' thing_inside }
238 tcExtendGlobalValEnv :: [Id] -> TcM a -> TcM a
239 -- Same deal as tcExtendGlobalEnv, but for Ids
240 tcExtendGlobalValEnv ids thing_inside
241 = tcExtendGlobalEnv [AnId id | id <- ids] thing_inside
243 tcExtendRecEnv :: [(Name,TyThing)] -> TcM r -> TcM r
244 -- Extend the global environments for the type/class knot tying game
245 -- Just like tcExtendGlobalEnv, except the argument is a list of pairs
246 tcExtendRecEnv gbl_stuff thing_inside
247 = do { tcg_env <- getGblEnv
248 ; let ge' = extendNameEnvList (tcg_type_env tcg_env) gbl_stuff
249 ; tcg_env' <- setGlobalTypeEnv tcg_env ge'
250 ; setGblEnv tcg_env' thing_inside }
254 %************************************************************************
256 \subsection{The local environment}
258 %************************************************************************
261 tcLookupLocated :: Located Name -> TcM TcTyThing
262 tcLookupLocated = addLocM tcLookup
264 tcLookup :: Name -> TcM TcTyThing
266 local_env <- getLclEnv
267 case lookupNameEnv (tcl_env local_env) name of
268 Just thing -> return thing
269 Nothing -> AGlobal <$> tcLookupGlobal name
271 tcLookupTyVar :: Name -> TcM TcTyVar
272 tcLookupTyVar name = do
273 thing <- tcLookup name
275 ATyVar _ ty -> return (tcGetTyVar "tcLookupTyVar" ty)
276 _ -> pprPanic "tcLookupTyVar" (ppr name)
278 tcLookupId :: Name -> TcM Id
279 -- Used when we aren't interested in the binding level, nor refinement.
280 -- The "no refinement" part means that we return the un-refined Id regardless
282 -- The Id is never a DataCon. (Why does that matter? see TcExpr.tcId)
284 thing <- tcLookup name
286 ATcId { tct_id = id} -> return id
287 AGlobal (AnId id) -> return id
288 _ -> pprPanic "tcLookupId" (ppr name)
290 tcLookupLocalIds :: [Name] -> TcM [TcId]
291 -- We expect the variables to all be bound, and all at
292 -- the same level as the lookup. Only used in one place...
293 tcLookupLocalIds ns = do
295 return (map (lookup (tcl_env env) (thLevel (tcl_th_ctxt env))) ns)
298 = case lookupNameEnv lenv name of
299 Just (ATcId { tct_id = id, tct_level = lvl1 })
300 -> ASSERT( lvl == lvl1 ) id
301 _ -> pprPanic "tcLookupLocalIds" (ppr name)
303 lclEnvElts :: TcLclEnv -> [TcTyThing]
304 lclEnvElts env = nameEnvElts (tcl_env env)
306 getInLocalScope :: TcM (Name -> Bool)
310 let lcl_env = tcl_env env
311 return (`elemNameEnv` lcl_env)
315 tcExtendKindEnv :: [(Name, TcKind)] -> TcM r -> TcM r
316 tcExtendKindEnv things thing_inside
317 = updLclEnv upd thing_inside
319 upd lcl_env = lcl_env { tcl_env = extend (tcl_env lcl_env) }
320 extend env = extendNameEnvList env [(n, AThing k) | (n,k) <- things]
322 tcExtendKindEnvTvs :: [LHsTyVarBndr Name] -> TcM r -> TcM r
323 tcExtendKindEnvTvs bndrs thing_inside
324 = updLclEnv upd thing_inside
326 upd lcl_env = lcl_env { tcl_env = extend (tcl_env lcl_env) }
327 extend env = extendNameEnvList env pairs
328 pairs = [(n, AThing k) | L _ (KindedTyVar n k) <- bndrs]
330 tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
331 tcExtendTyVarEnv tvs thing_inside
332 = tcExtendTyVarEnv2 [(tyVarName tv, mkTyVarTy tv) | tv <- tvs] thing_inside
334 tcExtendTyVarEnv2 :: [(Name,TcType)] -> TcM r -> TcM r
335 tcExtendTyVarEnv2 binds thing_inside = do
336 env@(TcLclEnv {tcl_env = le,
338 tcl_rdr = rdr_env}) <- getLclEnv
340 rdr_env' = extendLocalRdrEnv rdr_env (map fst binds)
341 new_tv_set = tcTyVarsOfTypes (map snd binds)
342 le' = extendNameEnvList le [(name, ATyVar name ty) | (name, ty) <- binds]
344 -- It's important to add the in-scope tyvars to the global tyvar set
346 -- f (_::r) = let g y = y::r in ...
347 -- Here, g mustn't be generalised. This is also important during
348 -- class and instance decls, when we mustn't generalise the class tyvars
349 -- when typechecking the methods.
350 gtvs' <- tc_extend_gtvs gtvs new_tv_set
351 setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs', tcl_rdr = rdr_env'}) thing_inside
353 getScopedTyVarBinds :: TcM [(Name, TcType)]
355 = do { lcl_env <- getLclEnv
356 ; return [(name, ty) | ATyVar name ty <- nameEnvElts (tcl_env lcl_env)] }
361 tcExtendIdEnv :: [TcId] -> TcM a -> TcM a
362 tcExtendIdEnv ids thing_inside = tcExtendIdEnv2 [(idName id, id) | id <- ids] thing_inside
364 tcExtendIdEnv1 :: Name -> TcId -> TcM a -> TcM a
365 tcExtendIdEnv1 name id thing_inside = tcExtendIdEnv2 [(name,id)] thing_inside
367 tcExtendIdEnv2 :: [(Name,TcId)] -> TcM a -> TcM a
368 -- Invariant: the TcIds are fully zonked (see tcExtendIdEnv above)
369 tcExtendIdEnv2 names_w_ids thing_inside
370 = do { env <- getLclEnv
371 ; tc_extend_local_id_env env (thLevel (tcl_th_ctxt env)) names_w_ids thing_inside }
373 tcExtendGhciEnv :: [TcId] -> TcM a -> TcM a
374 -- Used to bind Ids for GHCi identifiers bound earlier in the user interaction
375 -- Note especially that we bind them at TH level 'impLevel'. That's because it's
376 -- OK to use a variable bound earlier in the interaction in a splice, becuase
377 -- GHCi has already compiled it to bytecode
378 tcExtendGhciEnv ids thing_inside
379 = do { env <- getLclEnv
380 ; tc_extend_local_id_env env impLevel [(idName id, id) | id <- ids] thing_inside }
382 tc_extend_local_id_env -- This is the guy who does the work
387 -- Invariant: the TcIds are fully zonked. Reasons:
388 -- (a) The kinds of the forall'd type variables are defaulted
389 -- (see Kind.defaultKind, done in zonkQuantifiedTyVar)
390 -- (b) There are no via-Indirect occurrences of the bound variables
391 -- in the types, because instantiation does not look through such things
392 -- (c) The call to tyVarsOfTypes is ok without looking through refs
394 tc_extend_local_id_env env th_lvl names_w_ids thing_inside
395 = do { traceTc (text "env2")
396 ; traceTc (text "env3" <+> ppr extra_env)
397 ; gtvs' <- tc_extend_gtvs (tcl_tyvars env) extra_global_tyvars
398 ; let env' = env {tcl_env = le', tcl_tyvars = gtvs', tcl_rdr = rdr_env'}
399 ; setLclEnv env' thing_inside }
401 extra_global_tyvars = tcTyVarsOfTypes [idType id | (_,id) <- names_w_ids]
402 extra_env = [ (name, ATcId { tct_id = id,
405 tct_co = case isRefineableTy id_ty of
406 (True,_) -> Unrefineable
407 (_,True) -> Rigid idHsWrapper
409 | (name,id) <- names_w_ids, let id_ty = idType id]
410 le' = extendNameEnvList (tcl_env env) extra_env
411 rdr_env' = extendLocalRdrEnv (tcl_rdr env) [name | (name,_) <- names_w_ids]
416 -----------------------
417 -- findGlobals looks at the value environment and finds values
418 -- whose types mention the offending type variable. It has to be
419 -- careful to zonk the Id's type first, so it has to be in the monad.
420 -- We must be careful to pass it a zonked type variable, too.
422 findGlobals :: TcTyVarSet
424 -> TcM (TidyEnv, [SDoc])
426 findGlobals tvs tidy_env = do
428 go tidy_env [] (lclEnvElts lcl_env)
430 go tidy_env acc [] = return (tidy_env, acc)
431 go tidy_env acc (thing : things) = do
432 (tidy_env1, maybe_doc) <- find_thing ignore_it tidy_env thing
434 Just d -> go tidy_env1 (d:acc) things
435 Nothing -> go tidy_env1 acc things
437 ignore_it ty = tvs `disjointVarSet` tyVarsOfType ty
439 -----------------------
440 find_thing :: (TcType -> Bool) -> TidyEnv -> TcTyThing
441 -> TcM (TidyEnv, Maybe SDoc)
442 find_thing ignore_it tidy_env (ATcId { tct_id = id }) = do
443 id_ty <- zonkTcType (idType id)
444 if ignore_it id_ty then
445 return (tidy_env, Nothing)
447 (tidy_env', tidy_ty) = tidyOpenType tidy_env id_ty
448 msg = sep [ppr id <+> dcolon <+> ppr tidy_ty,
449 nest 2 (parens (ptext (sLit "bound at") <+>
450 ppr (getSrcLoc id)))]
452 return (tidy_env', Just msg)
454 find_thing ignore_it tidy_env (ATyVar tv ty) = do
455 tv_ty <- zonkTcType ty
456 if ignore_it tv_ty then
457 return (tidy_env, Nothing)
459 -- The name tv is scoped, so we don't need to tidy it
460 (tidy_env1, tidy_ty) = tidyOpenType tidy_env tv_ty
461 msg = sep [ptext (sLit "Scoped type variable") <+> quotes (ppr tv) <+> eq_stuff, nest 2 bound_at]
463 eq_stuff | Just tv' <- Type.getTyVar_maybe tv_ty,
464 getOccName tv == getOccName tv' = empty
465 | otherwise = equals <+> ppr tidy_ty
466 -- It's ok to use Type.getTyVar_maybe because ty is zonked by now
467 bound_at = parens $ ptext (sLit "bound at:") <+> ppr (getSrcLoc tv)
469 return (tidy_env1, Just msg)
471 find_thing _ _ thing = pprPanic "find_thing" (ppr thing)
474 %************************************************************************
476 \subsection{The global tyvars}
478 %************************************************************************
481 tc_extend_gtvs :: IORef VarSet -> VarSet -> TcM (IORef VarSet)
482 tc_extend_gtvs gtvs extra_global_tvs = do
483 global_tvs <- readMutVar gtvs
484 newMutVar (global_tvs `unionVarSet` extra_global_tvs)
487 @tcGetGlobalTyVars@ returns a fully-zonked set of tyvars free in the environment.
488 To improve subsequent calls to the same function it writes the zonked set back into
492 tcGetGlobalTyVars :: TcM TcTyVarSet
493 tcGetGlobalTyVars = do
494 (TcLclEnv {tcl_tyvars = gtv_var}) <- getLclEnv
495 gbl_tvs <- readMutVar gtv_var
496 gbl_tvs' <- zonkTcTyVarsAndFV (varSetElems gbl_tvs)
497 writeMutVar gtv_var gbl_tvs'
502 %************************************************************************
506 %************************************************************************
509 tcExtendRules :: [LRuleDecl Id] -> TcM a -> TcM a
510 -- Just pop the new rules into the EPS and envt resp
511 -- All the rules come from an interface file, not soruce
512 -- Nevertheless, some may be for this module, if we read
513 -- its interface instead of its source code
514 tcExtendRules lcl_rules thing_inside
515 = do { env <- getGblEnv
517 env' = env { tcg_rules = lcl_rules ++ tcg_rules env }
518 ; setGblEnv env' thing_inside }
522 %************************************************************************
526 %************************************************************************
529 instance Outputable ThStage where
530 ppr (Comp l) = text "Comp" <+> int l
531 ppr (Brack l _ _) = text "Brack" <+> int l
532 ppr (Splice l) = text "Splice" <+> int l
535 thLevel :: ThStage -> ThLevel
537 thLevel (Splice l) = l
538 thLevel (Brack l _ _) = l
541 checkWellStaged :: SDoc -- What the stage check is for
542 -> ThLevel -- Binding level (increases inside brackets)
543 -> ThStage -- Use stage
544 -> TcM () -- Fail if badly staged, adding an error
545 checkWellStaged pp_thing bind_lvl use_stage
546 | use_lvl >= bind_lvl -- OK! Used later than bound
547 = return () -- E.g. \x -> [| $(f x) |]
549 | bind_lvl == topLevel -- GHC restriction on top level splices
551 sep [ptext (sLit "GHC stage restriction:") <+> pp_thing,
552 nest 2 (ptext (sLit "is used in") <+> use_lvl_doc <> ptext (sLit ", and must be imported, not defined locally"))]
554 | otherwise -- Badly staged
555 = failWithTc $ -- E.g. \x -> $(f x)
556 ptext (sLit "Stage error:") <+> pp_thing <+>
557 hsep [ptext (sLit "is bound at stage") <+> ppr bind_lvl,
558 ptext (sLit "but used at stage") <+> ppr use_lvl]
560 use_lvl = thLevel use_stage
561 use_lvl_doc | use_lvl == thLevel topStage = ptext (sLit "a top-level splice")
562 | use_lvl == thLevel topAnnStage = ptext (sLit "an annotation")
563 | otherwise = panic "checkWellStaged"
565 topIdLvl :: Id -> ThLevel
566 -- Globals may either be imported, or may be from an earlier "chunk"
567 -- (separated by declaration splices) of this module. The former
568 -- *can* be used inside a top-level splice, but the latter cannot.
569 -- Hence we give the former impLevel, but the latter topLevel
573 -- By the time we are prcessing the $(f x), the binding for "x"
574 -- will be in the global env, not the local one.
575 topIdLvl id | isLocalId id = topLevel
576 | otherwise = impLevel
578 -- Indicates the legal transitions on bracket( [| |] ).
579 bracketOK :: ThStage -> Maybe ThLevel
580 bracketOK (Brack _ _ _) = Nothing -- Bracket illegal inside a bracket
581 bracketOK stage = Just (thLevel stage + 1)
583 -- Indicates the legal transitions on splice($).
584 spliceOK :: ThStage -> Maybe ThLevel
585 spliceOK (Splice _) = Nothing -- Splice illegal inside splice
586 spliceOK stage = Just (thLevel stage - 1)
588 tcMetaTy :: Name -> TcM Type
589 -- Given the name of a Template Haskell data type,
591 -- E.g. given the name "Expr" return the type "Expr"
592 tcMetaTy tc_name = do
593 t <- tcLookupTyCon tc_name
594 return (mkTyConApp t [])
597 -- Used *only* to indicate that we are inside a TH bracket during renaming
598 -- Tested by TcEnv.isBrackStage
599 -- See Note [Top-level Names in Template Haskell decl quotes]
600 thRnBrack = Brack (panic "thRnBrack1") (panic "thRnBrack2") (panic "thRnBrack3")
602 isBrackStage :: ThStage -> Bool
603 isBrackStage (Brack {}) = True
604 isBrackStage _other = False
606 thTopLevelId :: Id -> Bool
607 -- See Note [What is a top-level Id?] in TcSplice
608 thTopLevelId id = isGlobalId id || isExternalName (idName id)
612 %************************************************************************
614 \subsection{The InstInfo type}
616 %************************************************************************
618 The InstInfo type summarises the information in an instance declaration
620 instance c => k (t tvs) where b
622 It is used just for *local* instance decls (not ones from interface files).
623 But local instance decls includes
626 as well as explicit user written ones.
631 iSpec :: Instance, -- Includes the dfun id. Its forall'd type
632 iBinds :: InstBindings a -- variables scope over the stuff in InstBindings!
635 iDFunId :: InstInfo a -> DFunId
636 iDFunId info = instanceDFunId (iSpec info)
639 = VanillaInst -- The normal case
640 (LHsBinds a) -- Bindings for the instance methods
641 [LSig a] -- User pragmas recorded for generating
642 -- specialised instances
644 | NewTypeDerived -- Used for deriving instances of newtypes, where the
645 -- witness dictionary is identical to the argument
646 -- dictionary. Hence no bindings, no pragmas.
648 pprInstInfo :: InstInfo a -> SDoc
649 pprInstInfo info = vcat [ptext (sLit "InstInfo:") <+> ppr (idType (iDFunId info))]
651 pprInstInfoDetails :: OutputableBndr a => InstInfo a -> SDoc
652 pprInstInfoDetails info = pprInstInfo info $$ nest 2 (details (iBinds info))
654 details (VanillaInst b _) = pprLHsBinds b
655 details NewTypeDerived = text "Derived from the representation type"
657 simpleInstInfoClsTy :: InstInfo a -> (Class, Type)
658 simpleInstInfoClsTy info = case instanceHead (iSpec info) of
659 (_, _, cls, [ty]) -> (cls, ty)
660 _ -> panic "simpleInstInfoClsTy"
662 simpleInstInfoTy :: InstInfo a -> Type
663 simpleInstInfoTy info = snd (simpleInstInfoClsTy info)
665 simpleInstInfoTyCon :: InstInfo a -> TyCon
666 -- Gets the type constructor for a simple instance declaration,
667 -- i.e. one of the form instance (...) => C (T a b c) where ...
668 simpleInstInfoTyCon inst = tcTyConAppTyCon (simpleInstInfoTy inst)
671 Make a name for the dict fun for an instance decl. It's an *external*
672 name, like otber top-level names, and hence must be made with newGlobalBinder.
675 newDFunName :: Class -> [Type] -> SrcSpan -> TcM Name
676 newDFunName clas (ty:_) loc
677 = do { index <- nextDFunIndex
678 ; is_boot <- tcIsHsBoot
680 ; let info_string = occNameString (getOccName clas) ++
681 occNameString (getDFunTyKey ty)
682 dfun_occ = mkDFunOcc info_string is_boot index
684 ; newGlobalBinder mod dfun_occ loc }
686 newDFunName clas [] loc = pprPanic "newDFunName" (ppr clas <+> ppr loc)
689 Make a name for the representation tycon of a family instance. It's an
690 *external* name, like otber top-level names, and hence must be made with
694 newFamInstTyConName :: Name -> SrcSpan -> TcM Name
695 newFamInstTyConName tc_name loc
696 = do { index <- nextDFunIndex
698 ; let occ = nameOccName tc_name
699 ; newGlobalBinder mod (mkInstTyTcOcc index occ) loc }
702 Stable names used for foreign exports and annotations.
703 For stable names, the name must be unique (see #1533). If the
704 same thing has several stable Ids based on it, the
705 top-level bindings generated must not have the same name.
706 Hence we create an External name (doesn't change), and we
707 append a Unique to the string right here.
710 mkStableIdFromString :: String -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
711 mkStableIdFromString str sig_ty loc occ_wrapper = do
714 let uniq_str = showSDoc (pprUnique uniq) :: String
715 occ = mkVarOcc (str ++ '_' : uniq_str) :: OccName
716 gnm = mkExternalName uniq mod (occ_wrapper occ) loc :: Name
717 id = mkExportedLocalId gnm sig_ty :: Id
720 mkStableIdFromName :: Name -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
721 mkStableIdFromName nm = mkStableIdFromString (getOccString nm)
724 %************************************************************************
728 %************************************************************************
731 pprBinders :: [Name] -> SDoc
732 -- Used in error messages
733 -- Use quotes for a single one; they look a bit "busy" for several
734 pprBinders [bndr] = quotes (ppr bndr)
735 pprBinders bndrs = pprWithCommas ppr bndrs
737 notFound :: Name -> TcGblEnv -> TcM TyThing
739 = failWithTc (vcat[ptext (sLit "GHC internal error:") <+> quotes (ppr name) <+>
740 ptext (sLit "is not in scope during type checking, but it passed the renamer"),
741 ptext (sLit "tcg_type_env of environment:") <+> ppr (tcg_type_env env)]
744 wrongThingErr :: String -> TcTyThing -> Name -> TcM a
745 wrongThingErr expected thing name
746 = failWithTc (pprTcTyThingCategory thing <+> quotes (ppr name) <+>
747 ptext (sLit "used as a") <+> text expected)