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, tcMetaTy, thLevel,
42 topIdLvl, thTopLevelId, thRnBrack, isBrackStage,
45 newLocalName, newDFunName, newFamInstTyConName,
46 mkStableIdFromString, mkStableIdFromName
49 #include "HsVersions.h"
57 -- import TcSuspension
81 %************************************************************************
85 %************************************************************************
87 Using the Located versions (eg. tcLookupLocatedGlobal) is preferred,
88 unless you know that the SrcSpan in the monad is already set to the
92 tcLookupLocatedGlobal :: Located Name -> TcM TyThing
93 -- c.f. IfaceEnvEnv.tcIfaceGlobal
94 tcLookupLocatedGlobal name
95 = addLocM tcLookupGlobal name
97 tcLookupGlobal :: Name -> TcM TyThing
98 -- The Name is almost always an ExternalName, but not always
99 -- In GHCi, we may make command-line bindings (ghci> let x = True)
100 -- that bind a GlobalId, but with an InternalName
102 = do { env <- getGblEnv
105 ; case lookupNameEnv (tcg_type_env env) name of {
106 Just thing -> return thing ;
110 { hsc_env <- getTopEnv
111 ; mb_thing <- liftIO (lookupTypeHscEnv hsc_env name)
113 Just thing -> return thing ;
116 -- Should it have been in the local envt?
117 { case nameModule_maybe name of
118 Nothing -> notFound name -- Internal names can happen in GHCi
120 Just mod | mod == tcg_mod env -- Names from this module
121 -> notFound name -- should be in tcg_type_env
123 -> tcImportDecl name -- Go find it in an interface
126 tcLookupField :: Name -> TcM Id -- Returns the selector Id
128 = tcLookupId name -- Note [Record field lookup]
130 {- Note [Record field lookup]
131 ~~~~~~~~~~~~~~~~~~~~~~~~~~
132 You might think we should have tcLookupGlobal here, since record fields
133 are always top level. But consider
135 Then the renamer (which does not keep track of what is a record selector
136 and what is not) will rename the definition thus
137 f_7 = e { f_7 = True }
138 Now the type checker will find f_7 in the *local* type environment, not
139 the global (imported) one. It's wrong, of course, but we want to report a tidy
140 error, not in TcEnv.notFound. -}
142 tcLookupDataCon :: Name -> TcM DataCon
143 tcLookupDataCon name = do
144 thing <- tcLookupGlobal name
146 ADataCon con -> return con
147 _ -> wrongThingErr "data constructor" (AGlobal thing) name
149 tcLookupClass :: Name -> TcM Class
150 tcLookupClass name = do
151 thing <- tcLookupGlobal name
153 AClass cls -> return cls
154 _ -> wrongThingErr "class" (AGlobal thing) name
156 tcLookupTyCon :: Name -> TcM TyCon
157 tcLookupTyCon name = do
158 thing <- tcLookupGlobal name
160 ATyCon tc -> return tc
161 _ -> wrongThingErr "type constructor" (AGlobal thing) name
163 tcLookupLocatedGlobalId :: Located Name -> TcM Id
164 tcLookupLocatedGlobalId = addLocM tcLookupId
166 tcLookupLocatedClass :: Located Name -> TcM Class
167 tcLookupLocatedClass = addLocM tcLookupClass
169 tcLookupLocatedTyCon :: Located Name -> TcM TyCon
170 tcLookupLocatedTyCon = addLocM tcLookupTyCon
172 -- Look up the instance tycon of a family instance.
174 -- The match may be ambiguous (as we know that overlapping instances have
175 -- identical right-hand sides under overlapping substitutions - see
176 -- 'FamInstEnv.lookupFamInstEnvConflicts'). However, the type arguments used
177 -- for matching must be equal to or be more specific than those of the family
178 -- instance declaration. We pick one of the matches in case of ambiguity; as
179 -- the right-hand sides are identical under the match substitution, the choice
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
202 ((fam_inst, rep_tys):_)
203 -> return $ Just (famInstTyCon fam_inst, rep_tys)
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] -> ([LHsTyVarBndr Name] -> TcM r) -> TcM r
323 tcExtendKindEnvTvs bndrs thing_inside
324 = tcExtendKindEnv (map (hsTyVarNameKind . unLoc) bndrs)
327 tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
328 tcExtendTyVarEnv tvs thing_inside
329 = tcExtendTyVarEnv2 [(tyVarName tv, mkTyVarTy tv) | tv <- tvs] thing_inside
331 tcExtendTyVarEnv2 :: [(Name,TcType)] -> TcM r -> TcM r
332 tcExtendTyVarEnv2 binds thing_inside = do
333 env@(TcLclEnv {tcl_env = le,
335 tcl_rdr = rdr_env}) <- getLclEnv
337 rdr_env' = extendLocalRdrEnvList rdr_env (map fst binds)
338 new_tv_set = tcTyVarsOfTypes (map snd binds)
339 le' = extendNameEnvList le [(name, ATyVar name ty) | (name, ty) <- binds]
341 -- It's important to add the in-scope tyvars to the global tyvar set
343 -- f (_::r) = let g y = y::r in ...
344 -- Here, g mustn't be generalised. This is also important during
345 -- class and instance decls, when we mustn't generalise the class tyvars
346 -- when typechecking the methods.
347 gtvs' <- tc_extend_gtvs gtvs new_tv_set
348 setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs', tcl_rdr = rdr_env'}) thing_inside
350 getScopedTyVarBinds :: TcM [(Name, TcType)]
352 = do { lcl_env <- getLclEnv
353 ; return [(name, ty) | ATyVar name ty <- nameEnvElts (tcl_env lcl_env)] }
358 tcExtendIdEnv :: [TcId] -> TcM a -> TcM a
359 tcExtendIdEnv ids thing_inside = tcExtendIdEnv2 [(idName id, id) | id <- ids] thing_inside
361 tcExtendIdEnv1 :: Name -> TcId -> TcM a -> TcM a
362 tcExtendIdEnv1 name id thing_inside = tcExtendIdEnv2 [(name,id)] thing_inside
364 tcExtendIdEnv2 :: [(Name,TcId)] -> TcM a -> TcM a
365 -- Invariant: the TcIds are fully zonked (see tcExtendIdEnv above)
366 tcExtendIdEnv2 names_w_ids thing_inside
367 = do { env <- getLclEnv
368 ; tc_extend_local_id_env env (thLevel (tcl_th_ctxt env)) names_w_ids thing_inside }
370 tcExtendGhciEnv :: [TcId] -> TcM a -> TcM a
371 -- Used to bind Ids for GHCi identifiers bound earlier in the user interaction
372 -- Note especially that we bind them at TH level 'impLevel'. That's because it's
373 -- OK to use a variable bound earlier in the interaction in a splice, becuase
374 -- GHCi has already compiled it to bytecode
375 tcExtendGhciEnv ids thing_inside
376 = do { env <- getLclEnv
377 ; tc_extend_local_id_env env impLevel [(idName id, id) | id <- ids] thing_inside }
379 tc_extend_local_id_env -- This is the guy who does the work
384 -- Invariant: the TcIds are fully zonked. Reasons:
385 -- (a) The kinds of the forall'd type variables are defaulted
386 -- (see Kind.defaultKind, done in zonkQuantifiedTyVar)
387 -- (b) There are no via-Indirect occurrences of the bound variables
388 -- in the types, because instantiation does not look through such things
389 -- (c) The call to tyVarsOfTypes is ok without looking through refs
391 tc_extend_local_id_env env th_lvl names_w_ids thing_inside
392 = do { traceTc (text "env2")
393 ; traceTc (text "env3" <+> ppr extra_env)
394 ; gtvs' <- tc_extend_gtvs (tcl_tyvars env) extra_global_tyvars
395 ; let env' = env {tcl_env = le', tcl_tyvars = gtvs', tcl_rdr = rdr_env'}
396 ; setLclEnv env' thing_inside }
398 extra_global_tyvars = tcTyVarsOfTypes [idType id | (_,id) <- names_w_ids]
399 extra_env = [ (name, ATcId { tct_id = id,
402 tct_co = case isRefineableTy id_ty of
403 (True,_) -> Unrefineable
404 (_,True) -> Rigid idHsWrapper
406 | (name,id) <- names_w_ids, let id_ty = idType id]
407 le' = extendNameEnvList (tcl_env env) extra_env
408 rdr_env' = extendLocalRdrEnvList (tcl_rdr env) [name | (name,_) <- names_w_ids]
413 -----------------------
414 -- findGlobals looks at the value environment and finds values
415 -- whose types mention the offending type variable. It has to be
416 -- careful to zonk the Id's type first, so it has to be in the monad.
417 -- We must be careful to pass it a zonked type variable, too.
419 findGlobals :: TcTyVarSet
421 -> TcM (TidyEnv, [SDoc])
423 findGlobals tvs tidy_env = do
425 go tidy_env [] (lclEnvElts lcl_env)
427 go tidy_env acc [] = return (tidy_env, acc)
428 go tidy_env acc (thing : things) = do
429 (tidy_env1, maybe_doc) <- find_thing ignore_it tidy_env thing
431 Just d -> go tidy_env1 (d:acc) things
432 Nothing -> go tidy_env1 acc things
434 ignore_it ty = tvs `disjointVarSet` tyVarsOfType ty
436 -----------------------
437 find_thing :: (TcType -> Bool) -> TidyEnv -> TcTyThing
438 -> TcM (TidyEnv, Maybe SDoc)
439 find_thing ignore_it tidy_env (ATcId { tct_id = id }) = do
440 id_ty <- zonkTcType (idType id)
441 if ignore_it id_ty then
442 return (tidy_env, Nothing)
444 (tidy_env', tidy_ty) = tidyOpenType tidy_env id_ty
445 msg = sep [ppr id <+> dcolon <+> ppr tidy_ty,
446 nest 2 (parens (ptext (sLit "bound at") <+>
447 ppr (getSrcLoc id)))]
449 return (tidy_env', Just msg)
451 find_thing ignore_it tidy_env (ATyVar tv ty) = do
452 tv_ty <- zonkTcType ty
453 if ignore_it tv_ty then
454 return (tidy_env, Nothing)
456 -- The name tv is scoped, so we don't need to tidy it
457 (tidy_env1, tidy_ty) = tidyOpenType tidy_env tv_ty
458 msg = sep [ptext (sLit "Scoped type variable") <+> quotes (ppr tv) <+> eq_stuff, nest 2 bound_at]
460 eq_stuff | Just tv' <- Type.getTyVar_maybe tv_ty,
461 getOccName tv == getOccName tv' = empty
462 | otherwise = equals <+> ppr tidy_ty
463 -- It's ok to use Type.getTyVar_maybe because ty is zonked by now
464 bound_at = parens $ ptext (sLit "bound at:") <+> ppr (getSrcLoc tv)
466 return (tidy_env1, Just msg)
468 find_thing _ _ thing = pprPanic "find_thing" (ppr thing)
471 %************************************************************************
473 \subsection{The global tyvars}
475 %************************************************************************
478 tc_extend_gtvs :: IORef VarSet -> VarSet -> TcM (IORef VarSet)
479 tc_extend_gtvs gtvs extra_global_tvs = do
480 global_tvs <- readMutVar gtvs
481 newMutVar (global_tvs `unionVarSet` extra_global_tvs)
484 @tcGetGlobalTyVars@ returns a fully-zonked set of tyvars free in the environment.
485 To improve subsequent calls to the same function it writes the zonked set back into
489 tcGetGlobalTyVars :: TcM TcTyVarSet
490 tcGetGlobalTyVars = do
491 (TcLclEnv {tcl_tyvars = gtv_var}) <- getLclEnv
492 gbl_tvs <- readMutVar gtv_var
493 gbl_tvs' <- zonkTcTyVarsAndFV (varSetElems gbl_tvs)
494 writeMutVar gtv_var gbl_tvs'
499 %************************************************************************
503 %************************************************************************
506 tcExtendRules :: [LRuleDecl Id] -> TcM a -> TcM a
507 -- Just pop the new rules into the EPS and envt resp
508 -- All the rules come from an interface file, not soruce
509 -- Nevertheless, some may be for this module, if we read
510 -- its interface instead of its source code
511 tcExtendRules lcl_rules thing_inside
512 = do { env <- getGblEnv
514 env' = env { tcg_rules = lcl_rules ++ tcg_rules env }
515 ; setGblEnv env' thing_inside }
519 %************************************************************************
523 %************************************************************************
526 checkWellStaged :: SDoc -- What the stage check is for
527 -> ThLevel -- Binding level (increases inside brackets)
528 -> ThLevel -- Use stage
529 -> TcM () -- Fail if badly staged, adding an error
530 checkWellStaged pp_thing bind_lvl use_lvl
531 | use_lvl >= bind_lvl -- OK! Used later than bound
532 = return () -- E.g. \x -> [| $(f x) |]
534 | bind_lvl == outerLevel -- GHC restriction on top level splices
536 sep [ptext (sLit "GHC stage restriction:") <+> pp_thing,
537 nest 2 (vcat [ ptext (sLit "is used in a top-level splice or annotation,")
538 , ptext (sLit "and must be imported, not defined locally")])]
540 | otherwise -- Badly staged
541 = failWithTc $ -- E.g. \x -> $(f x)
542 ptext (sLit "Stage error:") <+> pp_thing <+>
543 hsep [ptext (sLit "is bound at stage") <+> ppr bind_lvl,
544 ptext (sLit "but used at stage") <+> ppr use_lvl]
546 topIdLvl :: Id -> ThLevel
547 -- Globals may either be imported, or may be from an earlier "chunk"
548 -- (separated by declaration splices) of this module. The former
549 -- *can* be used inside a top-level splice, but the latter cannot.
550 -- Hence we give the former impLevel, but the latter topLevel
554 -- By the time we are prcessing the $(f x), the binding for "x"
555 -- will be in the global env, not the local one.
556 topIdLvl id | isLocalId id = outerLevel
557 | otherwise = impLevel
559 tcMetaTy :: Name -> TcM Type
560 -- Given the name of a Template Haskell data type,
562 -- E.g. given the name "Expr" return the type "Expr"
563 tcMetaTy tc_name = do
564 t <- tcLookupTyCon tc_name
565 return (mkTyConApp t [])
568 -- Used *only* to indicate that we are inside a TH bracket during renaming
569 -- Tested by TcEnv.isBrackStage
570 -- See Note [Top-level Names in Template Haskell decl quotes]
571 thRnBrack = Brack (panic "thRnBrack1") (panic "thRnBrack2") (panic "thRnBrack3")
573 isBrackStage :: ThStage -> Bool
574 isBrackStage (Brack {}) = True
575 isBrackStage _other = False
577 thTopLevelId :: Id -> Bool
578 -- See Note [What is a top-level Id?] in TcSplice
579 thTopLevelId id = isGlobalId id || isExternalName (idName id)
583 %************************************************************************
585 \subsection{The InstInfo type}
587 %************************************************************************
589 The InstInfo type summarises the information in an instance declaration
591 instance c => k (t tvs) where b
593 It is used just for *local* instance decls (not ones from interface files).
594 But local instance decls includes
597 as well as explicit user written ones.
602 iSpec :: Instance, -- Includes the dfun id. Its forall'd type
603 iBinds :: InstBindings a -- variables scope over the stuff in InstBindings!
606 iDFunId :: InstInfo a -> DFunId
607 iDFunId info = instanceDFunId (iSpec info)
610 = VanillaInst -- The normal case
611 (LHsBinds a) -- Bindings for the instance methods
612 [LSig a] -- User pragmas recorded for generating
613 -- specialised instances
614 Bool -- True <=> This code came from a standalone deriving clause
616 | NewTypeDerived -- Used for deriving instances of newtypes, where the
617 -- witness dictionary is identical to the argument
618 -- dictionary. Hence no bindings, no pragmas.
620 CoercionI -- The coercion maps from newtype to the representation type
621 -- (mentioning type variables bound by the forall'd iSpec variables)
622 -- E.g. newtype instance N [a] = N1 (Tree a)
623 -- co : N [a] ~ Tree a
625 TyCon -- The TyCon is the newtype N. If it's indexed, then it's the
626 -- representation TyCon, so that tyConDataCons returns [N1],
627 -- the "data constructor".
628 -- See Note [Newtype deriving and unused constructors]
631 pprInstInfo :: InstInfo a -> SDoc
632 pprInstInfo info = vcat [ptext (sLit "InstInfo:") <+> ppr (idType (iDFunId info))]
634 pprInstInfoDetails :: OutputableBndr a => InstInfo a -> SDoc
635 pprInstInfoDetails info = pprInstInfo info $$ nest 2 (details (iBinds info))
637 details (VanillaInst b _ _) = pprLHsBinds b
638 details (NewTypeDerived {}) = text "Derived from the representation type"
640 simpleInstInfoClsTy :: InstInfo a -> (Class, Type)
641 simpleInstInfoClsTy info = case instanceHead (iSpec info) of
642 (_, _, cls, [ty]) -> (cls, ty)
643 _ -> panic "simpleInstInfoClsTy"
645 simpleInstInfoTy :: InstInfo a -> Type
646 simpleInstInfoTy info = snd (simpleInstInfoClsTy info)
648 simpleInstInfoTyCon :: InstInfo a -> TyCon
649 -- Gets the type constructor for a simple instance declaration,
650 -- i.e. one of the form instance (...) => C (T a b c) where ...
651 simpleInstInfoTyCon inst = tcTyConAppTyCon (simpleInstInfoTy inst)
654 Make a name for the dict fun for an instance decl. It's an *external*
655 name, like otber top-level names, and hence must be made with newGlobalBinder.
658 newDFunName :: Class -> [Type] -> SrcSpan -> TcM Name
659 newDFunName clas tys loc
660 = do { is_boot <- tcIsHsBoot
662 ; let info_string = occNameString (getOccName clas) ++
663 concatMap (occNameString.getDFunTyKey) tys
664 ; dfun_occ <- chooseUniqueOccTc (mkDFunOcc info_string is_boot)
665 ; newGlobalBinder mod dfun_occ loc }
668 Make a name for the representation tycon of a family instance. It's an
669 *external* name, like otber top-level names, and hence must be made with
673 newFamInstTyConName :: Name -> [Type] -> SrcSpan -> TcM Name
674 newFamInstTyConName tc_name tys loc
675 = do { mod <- getModule
676 ; let info_string = occNameString (getOccName tc_name) ++
677 concatMap (occNameString.getDFunTyKey) tys
678 ; occ <- chooseUniqueOccTc (mkInstTyTcOcc info_string)
679 ; newGlobalBinder mod occ loc }
682 Stable names used for foreign exports and annotations.
683 For stable names, the name must be unique (see #1533). If the
684 same thing has several stable Ids based on it, the
685 top-level bindings generated must not have the same name.
686 Hence we create an External name (doesn't change), and we
687 append a Unique to the string right here.
690 mkStableIdFromString :: String -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
691 mkStableIdFromString str sig_ty loc occ_wrapper = do
694 let uniq_str = showSDoc (pprUnique uniq) :: String
695 occ = mkVarOcc (str ++ '_' : uniq_str) :: OccName
696 gnm = mkExternalName uniq mod (occ_wrapper occ) loc :: Name
697 id = mkExportedLocalId gnm sig_ty :: Id
700 mkStableIdFromName :: Name -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
701 mkStableIdFromName nm = mkStableIdFromString (getOccString nm)
704 %************************************************************************
708 %************************************************************************
711 pprBinders :: [Name] -> SDoc
712 -- Used in error messages
713 -- Use quotes for a single one; they look a bit "busy" for several
714 pprBinders [bndr] = quotes (ppr bndr)
715 pprBinders bndrs = pprWithCommas ppr bndrs
717 notFound :: Name -> TcM TyThing
719 = do { (gbl,lcl) <- getEnvs
720 ; failWithTc (vcat[ptext (sLit "GHC internal error:") <+> quotes (ppr name) <+>
721 ptext (sLit "is not in scope during type checking, but it passed the renamer"),
722 ptext (sLit "tcg_type_env of environment:") <+> ppr (tcg_type_env gbl),
723 ptext (sLit "tcl_env of environment:") <+> ppr (tcl_env lcl)]
726 wrongThingErr :: String -> TcTyThing -> Name -> TcM a
727 wrongThingErr expected thing name
728 = failWithTc (pprTcTyThingCategory thing <+> quotes (ppr name) <+>
729 ptext (sLit "used as a") <+> text expected)