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
130 = tcLookupId name -- Note [Record field lookup]
132 {- Note [Record field lookup]
133 ~~~~~~~~~~~~~~~~~~~~~~~~~~
134 You might think we should have tcLookupGlobal here, since record fields
135 are always top level. But consider
137 Then the renamer (which does not keep track of what is a record selector
138 and what is not) will rename the definition thus
139 f_7 = e { f_7 = True }
140 Now the type checker will find f_7 in the *local* type environment, not
141 the global (imported) one. It's wrong, of course, but we want to report a tidy
142 error, not in TcEnv.notFound. -}
144 tcLookupDataCon :: Name -> TcM DataCon
145 tcLookupDataCon name = do
146 thing <- tcLookupGlobal name
148 ADataCon con -> return con
149 _ -> wrongThingErr "data constructor" (AGlobal thing) name
151 tcLookupClass :: Name -> TcM Class
152 tcLookupClass name = do
153 thing <- tcLookupGlobal name
155 AClass cls -> return cls
156 _ -> wrongThingErr "class" (AGlobal thing) name
158 tcLookupTyCon :: Name -> TcM TyCon
159 tcLookupTyCon name = do
160 thing <- tcLookupGlobal name
162 ATyCon tc -> return tc
163 _ -> wrongThingErr "type constructor" (AGlobal thing) name
165 tcLookupLocatedGlobalId :: Located Name -> TcM Id
166 tcLookupLocatedGlobalId = addLocM tcLookupId
168 tcLookupLocatedClass :: Located Name -> TcM Class
169 tcLookupLocatedClass = addLocM tcLookupClass
171 tcLookupLocatedTyCon :: Located Name -> TcM TyCon
172 tcLookupLocatedTyCon = addLocM tcLookupTyCon
174 -- Look up the instance tycon of a family instance.
176 -- The match must be unique - ie, match exactly one instance - but the
177 -- type arguments used for matching may be more specific than those of
178 -- the family instance declaration.
180 -- Return the instance tycon and its type instance. For example, if we have
182 -- tcLookupFamInst 'T' '[Int]' yields (':R42T', 'Int')
184 -- then we have a coercion (ie, type instance of family instance coercion)
186 -- :Co:R42T Int :: T [Int] ~ :R42T Int
188 -- which implies that :R42T was declared as 'data instance T [a]'.
190 tcLookupFamInst :: TyCon -> [Type] -> TcM (Maybe (TyCon, [Type]))
191 tcLookupFamInst tycon tys
192 | not (isOpenTyCon tycon)
195 = do { env <- getGblEnv
197 ; let instEnv = (eps_fam_inst_env eps, tcg_fam_inst_env env)
198 ; case lookupFamInstEnv instEnv tycon tys of
199 [(fam_inst, rep_tys)] -> return $ Just (famInstTyCon fam_inst,
206 instance MonadThings (IOEnv (Env TcGblEnv TcLclEnv)) where
207 lookupThing = tcLookupGlobal
210 %************************************************************************
212 Extending the global environment
214 %************************************************************************
218 setGlobalTypeEnv :: TcGblEnv -> TypeEnv -> TcM TcGblEnv
219 -- Use this to update the global type env
220 -- It updates both * the normal tcg_type_env field
221 -- * the tcg_type_env_var field seen by interface files
222 setGlobalTypeEnv tcg_env new_type_env
223 = do { -- Sync the type-envt variable seen by interface files
224 writeMutVar (tcg_type_env_var tcg_env) new_type_env
225 ; return (tcg_env { tcg_type_env = new_type_env }) }
227 tcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r
228 -- Given a mixture of Ids, TyCons, Classes, all from the
229 -- module being compiled, extend the global environment
230 tcExtendGlobalEnv things thing_inside
231 = do { tcg_env <- getGblEnv
232 ; let ge' = extendTypeEnvList (tcg_type_env tcg_env) things
233 ; tcg_env' <- setGlobalTypeEnv tcg_env ge'
234 ; setGblEnv tcg_env' thing_inside }
236 tcExtendGlobalValEnv :: [Id] -> TcM a -> TcM a
237 -- Same deal as tcExtendGlobalEnv, but for Ids
238 tcExtendGlobalValEnv ids thing_inside
239 = tcExtendGlobalEnv [AnId id | id <- ids] thing_inside
241 tcExtendRecEnv :: [(Name,TyThing)] -> TcM r -> TcM r
242 -- Extend the global environments for the type/class knot tying game
243 -- Just like tcExtendGlobalEnv, except the argument is a list of pairs
244 tcExtendRecEnv gbl_stuff thing_inside
245 = do { tcg_env <- getGblEnv
246 ; let ge' = extendNameEnvList (tcg_type_env tcg_env) gbl_stuff
247 ; tcg_env' <- setGlobalTypeEnv tcg_env ge'
248 ; setGblEnv tcg_env' thing_inside }
252 %************************************************************************
254 \subsection{The local environment}
256 %************************************************************************
259 tcLookupLocated :: Located Name -> TcM TcTyThing
260 tcLookupLocated = addLocM tcLookup
262 tcLookup :: Name -> TcM TcTyThing
264 local_env <- getLclEnv
265 case lookupNameEnv (tcl_env local_env) name of
266 Just thing -> return thing
267 Nothing -> AGlobal <$> tcLookupGlobal name
269 tcLookupTyVar :: Name -> TcM TcTyVar
270 tcLookupTyVar name = do
271 thing <- tcLookup name
273 ATyVar _ ty -> return (tcGetTyVar "tcLookupTyVar" ty)
274 _ -> pprPanic "tcLookupTyVar" (ppr name)
276 tcLookupId :: Name -> TcM Id
277 -- Used when we aren't interested in the binding level, nor refinement.
278 -- The "no refinement" part means that we return the un-refined Id regardless
280 -- The Id is never a DataCon. (Why does that matter? see TcExpr.tcId)
282 thing <- tcLookup name
284 ATcId { tct_id = id} -> return id
285 AGlobal (AnId id) -> return id
286 _ -> pprPanic "tcLookupId" (ppr name)
288 tcLookupLocalIds :: [Name] -> TcM [TcId]
289 -- We expect the variables to all be bound, and all at
290 -- the same level as the lookup. Only used in one place...
291 tcLookupLocalIds ns = do
293 return (map (lookup (tcl_env env) (thLevel (tcl_th_ctxt env))) ns)
296 = case lookupNameEnv lenv name of
297 Just (ATcId { tct_id = id, tct_level = lvl1 })
298 -> ASSERT( lvl == lvl1 ) id
299 _ -> pprPanic "tcLookupLocalIds" (ppr name)
301 lclEnvElts :: TcLclEnv -> [TcTyThing]
302 lclEnvElts env = nameEnvElts (tcl_env env)
304 getInLocalScope :: TcM (Name -> Bool)
308 let lcl_env = tcl_env env
309 return (`elemNameEnv` lcl_env)
313 tcExtendKindEnv :: [(Name, TcKind)] -> TcM r -> TcM r
314 tcExtendKindEnv things thing_inside
315 = updLclEnv upd thing_inside
317 upd lcl_env = lcl_env { tcl_env = extend (tcl_env lcl_env) }
318 extend env = extendNameEnvList env [(n, AThing k) | (n,k) <- things]
320 tcExtendKindEnvTvs :: [LHsTyVarBndr Name] -> TcM r -> TcM r
321 tcExtendKindEnvTvs bndrs thing_inside
322 = updLclEnv upd thing_inside
324 upd lcl_env = lcl_env { tcl_env = extend (tcl_env lcl_env) }
325 extend env = extendNameEnvList env pairs
326 pairs = [(n, AThing k) | L _ (KindedTyVar n k) <- bndrs]
328 tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
329 tcExtendTyVarEnv tvs thing_inside
330 = tcExtendTyVarEnv2 [(tyVarName tv, mkTyVarTy tv) | tv <- tvs] thing_inside
332 tcExtendTyVarEnv2 :: [(Name,TcType)] -> TcM r -> TcM r
333 tcExtendTyVarEnv2 binds thing_inside = do
334 env@(TcLclEnv {tcl_env = le,
336 tcl_rdr = rdr_env}) <- getLclEnv
338 rdr_env' = extendLocalRdrEnv rdr_env (map fst binds)
339 new_tv_set = tcTyVarsOfTypes (map snd binds)
340 le' = extendNameEnvList le [(name, ATyVar name ty) | (name, ty) <- binds]
342 -- It's important to add the in-scope tyvars to the global tyvar set
344 -- f (_::r) = let g y = y::r in ...
345 -- Here, g mustn't be generalised. This is also important during
346 -- class and instance decls, when we mustn't generalise the class tyvars
347 -- when typechecking the methods.
348 gtvs' <- tc_extend_gtvs gtvs new_tv_set
349 setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs', tcl_rdr = rdr_env'}) thing_inside
351 getScopedTyVarBinds :: TcM [(Name, TcType)]
353 = do { lcl_env <- getLclEnv
354 ; return [(name, ty) | ATyVar name ty <- nameEnvElts (tcl_env lcl_env)] }
359 tcExtendIdEnv :: [TcId] -> TcM a -> TcM a
360 tcExtendIdEnv ids thing_inside = tcExtendIdEnv2 [(idName id, id) | id <- ids] thing_inside
362 tcExtendIdEnv1 :: Name -> TcId -> TcM a -> TcM a
363 tcExtendIdEnv1 name id thing_inside = tcExtendIdEnv2 [(name,id)] thing_inside
365 tcExtendIdEnv2 :: [(Name,TcId)] -> TcM a -> TcM a
366 -- Invariant: the TcIds are fully zonked (see tcExtendIdEnv above)
367 tcExtendIdEnv2 names_w_ids thing_inside
368 = do { env <- getLclEnv
369 ; tc_extend_local_id_env env (thLevel (tcl_th_ctxt env)) names_w_ids thing_inside }
371 tcExtendGhciEnv :: [TcId] -> TcM a -> TcM a
372 -- Used to bind Ids for GHCi identifiers bound earlier in the user interaction
373 -- Note especially that we bind them at TH level 'impLevel'. That's because it's
374 -- OK to use a variable bound earlier in the interaction in a splice, becuase
375 -- GHCi has already compiled it to bytecode
376 tcExtendGhciEnv ids thing_inside
377 = do { env <- getLclEnv
378 ; tc_extend_local_id_env env impLevel [(idName id, id) | id <- ids] thing_inside }
380 tc_extend_local_id_env -- This is the guy who does the work
385 -- Invariant: the TcIds are fully zonked. Reasons:
386 -- (a) The kinds of the forall'd type variables are defaulted
387 -- (see Kind.defaultKind, done in zonkQuantifiedTyVar)
388 -- (b) There are no via-Indirect occurrences of the bound variables
389 -- in the types, because instantiation does not look through such things
390 -- (c) The call to tyVarsOfTypes is ok without looking through refs
392 tc_extend_local_id_env env th_lvl names_w_ids thing_inside
393 = do { traceTc (text "env2")
394 ; traceTc (text "env3" <+> ppr extra_env)
395 ; gtvs' <- tc_extend_gtvs (tcl_tyvars env) extra_global_tyvars
396 ; let env' = env {tcl_env = le', tcl_tyvars = gtvs', tcl_rdr = rdr_env'}
397 ; setLclEnv env' thing_inside }
399 extra_global_tyvars = tcTyVarsOfTypes [idType id | (_,id) <- names_w_ids]
400 extra_env = [ (name, ATcId { tct_id = id,
403 tct_co = case isRefineableTy id_ty of
404 (True,_) -> Unrefineable
405 (_,True) -> Rigid idHsWrapper
407 | (name,id) <- names_w_ids, let id_ty = idType id]
408 le' = extendNameEnvList (tcl_env env) extra_env
409 rdr_env' = extendLocalRdrEnv (tcl_rdr env) [name | (name,_) <- names_w_ids]
414 -----------------------
415 -- findGlobals looks at the value environment and finds values
416 -- whose types mention the offending type variable. It has to be
417 -- careful to zonk the Id's type first, so it has to be in the monad.
418 -- We must be careful to pass it a zonked type variable, too.
420 findGlobals :: TcTyVarSet
422 -> TcM (TidyEnv, [SDoc])
424 findGlobals tvs tidy_env = do
426 go tidy_env [] (lclEnvElts lcl_env)
428 go tidy_env acc [] = return (tidy_env, acc)
429 go tidy_env acc (thing : things) = do
430 (tidy_env1, maybe_doc) <- find_thing ignore_it tidy_env thing
432 Just d -> go tidy_env1 (d:acc) things
433 Nothing -> go tidy_env1 acc things
435 ignore_it ty = tvs `disjointVarSet` tyVarsOfType ty
437 -----------------------
438 find_thing :: (TcType -> Bool) -> TidyEnv -> TcTyThing
439 -> TcM (TidyEnv, Maybe SDoc)
440 find_thing ignore_it tidy_env (ATcId { tct_id = id }) = do
441 id_ty <- zonkTcType (idType id)
442 if ignore_it id_ty then
443 return (tidy_env, Nothing)
445 (tidy_env', tidy_ty) = tidyOpenType tidy_env id_ty
446 msg = sep [ppr id <+> dcolon <+> ppr tidy_ty,
447 nest 2 (parens (ptext (sLit "bound at") <+>
448 ppr (getSrcLoc id)))]
450 return (tidy_env', Just msg)
452 find_thing ignore_it tidy_env (ATyVar tv ty) = do
453 tv_ty <- zonkTcType ty
454 if ignore_it tv_ty then
455 return (tidy_env, Nothing)
457 -- The name tv is scoped, so we don't need to tidy it
458 (tidy_env1, tidy_ty) = tidyOpenType tidy_env tv_ty
459 msg = sep [ptext (sLit "Scoped type variable") <+> quotes (ppr tv) <+> eq_stuff, nest 2 bound_at]
461 eq_stuff | Just tv' <- Type.getTyVar_maybe tv_ty,
462 getOccName tv == getOccName tv' = empty
463 | otherwise = equals <+> ppr tidy_ty
464 -- It's ok to use Type.getTyVar_maybe because ty is zonked by now
465 bound_at = parens $ ptext (sLit "bound at:") <+> ppr (getSrcLoc tv)
467 return (tidy_env1, Just msg)
469 find_thing _ _ thing = pprPanic "find_thing" (ppr thing)
472 %************************************************************************
474 \subsection{The global tyvars}
476 %************************************************************************
479 tc_extend_gtvs :: IORef VarSet -> VarSet -> TcM (IORef VarSet)
480 tc_extend_gtvs gtvs extra_global_tvs = do
481 global_tvs <- readMutVar gtvs
482 newMutVar (global_tvs `unionVarSet` extra_global_tvs)
485 @tcGetGlobalTyVars@ returns a fully-zonked set of tyvars free in the environment.
486 To improve subsequent calls to the same function it writes the zonked set back into
490 tcGetGlobalTyVars :: TcM TcTyVarSet
491 tcGetGlobalTyVars = do
492 (TcLclEnv {tcl_tyvars = gtv_var}) <- getLclEnv
493 gbl_tvs <- readMutVar gtv_var
494 gbl_tvs' <- zonkTcTyVarsAndFV (varSetElems gbl_tvs)
495 writeMutVar gtv_var gbl_tvs'
500 %************************************************************************
504 %************************************************************************
507 tcExtendRules :: [LRuleDecl Id] -> TcM a -> TcM a
508 -- Just pop the new rules into the EPS and envt resp
509 -- All the rules come from an interface file, not soruce
510 -- Nevertheless, some may be for this module, if we read
511 -- its interface instead of its source code
512 tcExtendRules lcl_rules thing_inside
513 = do { env <- getGblEnv
515 env' = env { tcg_rules = lcl_rules ++ tcg_rules env }
516 ; setGblEnv env' thing_inside }
520 %************************************************************************
524 %************************************************************************
527 instance Outputable ThStage where
528 ppr (Comp l) = text "Comp" <+> int l
529 ppr (Brack l _ _) = text "Brack" <+> int l
530 ppr (Splice l) = text "Splice" <+> int l
533 thLevel :: ThStage -> ThLevel
535 thLevel (Splice l) = l
536 thLevel (Brack l _ _) = l
539 checkWellStaged :: SDoc -- What the stage check is for
540 -> ThLevel -- Binding level (increases inside brackets)
541 -> ThStage -- Use stage
542 -> TcM () -- Fail if badly staged, adding an error
543 checkWellStaged pp_thing bind_lvl use_stage
544 | use_lvl >= bind_lvl -- OK! Used later than bound
545 = return () -- E.g. \x -> [| $(f x) |]
547 | bind_lvl == topLevel -- GHC restriction on top level splices
549 sep [ptext (sLit "GHC stage restriction:") <+> pp_thing,
550 nest 2 (ptext (sLit "is used in") <+> use_lvl_doc <> ptext (sLit ", and must be imported, not defined locally"))]
552 | otherwise -- Badly staged
553 = failWithTc $ -- E.g. \x -> $(f x)
554 ptext (sLit "Stage error:") <+> pp_thing <+>
555 hsep [ptext (sLit "is bound at stage") <+> ppr bind_lvl,
556 ptext (sLit "but used at stage") <+> ppr use_lvl]
558 use_lvl = thLevel use_stage
559 use_lvl_doc | use_lvl == thLevel topStage = ptext (sLit "a top-level splice")
560 | use_lvl == thLevel topAnnStage = ptext (sLit "an annotation")
561 | otherwise = panic "checkWellStaged"
563 topIdLvl :: Id -> ThLevel
564 -- Globals may either be imported, or may be from an earlier "chunk"
565 -- (separated by declaration splices) of this module. The former
566 -- *can* be used inside a top-level splice, but the latter cannot.
567 -- Hence we give the former impLevel, but the latter topLevel
571 -- By the time we are prcessing the $(f x), the binding for "x"
572 -- will be in the global env, not the local one.
573 topIdLvl id | isLocalId id = topLevel
574 | otherwise = impLevel
576 -- Indicates the legal transitions on bracket( [| |] ).
577 bracketOK :: ThStage -> Maybe ThLevel
578 bracketOK (Brack _ _ _) = Nothing -- Bracket illegal inside a bracket
579 bracketOK stage = Just (thLevel stage + 1)
581 -- Indicates the legal transitions on splice($).
582 spliceOK :: ThStage -> Maybe ThLevel
583 spliceOK (Splice _) = Nothing -- Splice illegal inside splice
584 spliceOK stage = Just (thLevel stage - 1)
586 tcMetaTy :: Name -> TcM Type
587 -- Given the name of a Template Haskell data type,
589 -- E.g. given the name "Expr" return the type "Expr"
590 tcMetaTy tc_name = do
591 t <- tcLookupTyCon tc_name
592 return (mkTyConApp t [])
595 -- Used *only* to indicate that we are inside a TH bracket during renaming
596 -- Tested by TcEnv.isBrackStage
597 -- See Note [Top-level Names in Template Haskell decl quotes]
598 thRnBrack = Brack (panic "thRnBrack1") (panic "thRnBrack2") (panic "thRnBrack3")
600 isBrackStage :: ThStage -> Bool
601 isBrackStage (Brack {}) = True
602 isBrackStage _other = False
604 thTopLevelId :: Id -> Bool
605 -- See Note [What is a top-level Id?] in TcSplice
606 thTopLevelId id = isGlobalId id || isExternalName (idName id)
610 %************************************************************************
612 \subsection{The InstInfo type}
614 %************************************************************************
616 The InstInfo type summarises the information in an instance declaration
618 instance c => k (t tvs) where b
620 It is used just for *local* instance decls (not ones from interface files).
621 But local instance decls includes
624 as well as explicit user written ones.
629 iSpec :: Instance, -- Includes the dfun id. Its forall'd type
630 iBinds :: InstBindings a -- variables scope over the stuff in InstBindings!
633 iDFunId :: InstInfo a -> DFunId
634 iDFunId info = instanceDFunId (iSpec info)
637 = VanillaInst -- The normal case
638 (LHsBinds a) -- Bindings for the instance methods
639 [LSig a] -- User pragmas recorded for generating
640 -- specialised instances
642 | NewTypeDerived -- Used for deriving instances of newtypes, where the
643 CoercionI -- witness dictionary is identical to the argument
644 -- dictionary. Hence no bindings, no pragmas.
645 -- The coercion maps from newtype to the representation type
646 -- (mentioning type variables bound by the forall'd iSpec variables)
647 -- E.g. newtype instance N [a] = N1 (Tree a)
648 -- co : N [a] ~ Tree a
650 pprInstInfo :: InstInfo a -> SDoc
651 pprInstInfo info = vcat [ptext (sLit "InstInfo:") <+> ppr (idType (iDFunId info))]
653 pprInstInfoDetails :: OutputableBndr a => InstInfo a -> SDoc
654 pprInstInfoDetails info = pprInstInfo info $$ nest 2 (details (iBinds info))
656 details (VanillaInst b _) = pprLHsBinds b
657 details (NewTypeDerived _) = text "Derived from the representation type"
659 simpleInstInfoClsTy :: InstInfo a -> (Class, Type)
660 simpleInstInfoClsTy info = case instanceHead (iSpec info) of
661 (_, _, cls, [ty]) -> (cls, ty)
662 _ -> panic "simpleInstInfoClsTy"
664 simpleInstInfoTy :: InstInfo a -> Type
665 simpleInstInfoTy info = snd (simpleInstInfoClsTy info)
667 simpleInstInfoTyCon :: InstInfo a -> TyCon
668 -- Gets the type constructor for a simple instance declaration,
669 -- i.e. one of the form instance (...) => C (T a b c) where ...
670 simpleInstInfoTyCon inst = tcTyConAppTyCon (simpleInstInfoTy inst)
673 Make a name for the dict fun for an instance decl. It's an *external*
674 name, like otber top-level names, and hence must be made with newGlobalBinder.
677 newDFunName :: Class -> [Type] -> SrcSpan -> TcM Name
678 newDFunName clas (ty:_) loc
679 = do { index <- nextDFunIndex
680 ; is_boot <- tcIsHsBoot
682 ; let info_string = occNameString (getOccName clas) ++
683 occNameString (getDFunTyKey ty)
684 dfun_occ = mkDFunOcc info_string is_boot index
686 ; newGlobalBinder mod dfun_occ loc }
688 newDFunName clas [] loc = pprPanic "newDFunName" (ppr clas <+> ppr loc)
691 Make a name for the representation tycon of a family instance. It's an
692 *external* name, like otber top-level names, and hence must be made with
696 newFamInstTyConName :: Name -> SrcSpan -> TcM Name
697 newFamInstTyConName tc_name loc
698 = do { index <- nextDFunIndex
700 ; let occ = nameOccName tc_name
701 ; newGlobalBinder mod (mkInstTyTcOcc index occ) loc }
704 Stable names used for foreign exports and annotations.
705 For stable names, the name must be unique (see #1533). If the
706 same thing has several stable Ids based on it, the
707 top-level bindings generated must not have the same name.
708 Hence we create an External name (doesn't change), and we
709 append a Unique to the string right here.
712 mkStableIdFromString :: String -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
713 mkStableIdFromString str sig_ty loc occ_wrapper = do
716 let uniq_str = showSDoc (pprUnique uniq) :: String
717 occ = mkVarOcc (str ++ '_' : uniq_str) :: OccName
718 gnm = mkExternalName uniq mod (occ_wrapper occ) loc :: Name
719 id = mkExportedLocalId gnm sig_ty :: Id
722 mkStableIdFromName :: Name -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
723 mkStableIdFromName nm = mkStableIdFromString (getOccString nm)
726 %************************************************************************
730 %************************************************************************
733 pprBinders :: [Name] -> SDoc
734 -- Used in error messages
735 -- Use quotes for a single one; they look a bit "busy" for several
736 pprBinders [bndr] = quotes (ppr bndr)
737 pprBinders bndrs = pprWithCommas ppr bndrs
739 notFound :: Name -> TcGblEnv -> TcM TyThing
741 = failWithTc (vcat[ptext (sLit "GHC internal error:") <+> quotes (ppr name) <+>
742 ptext (sLit "is not in scope during type checking, but it passed the renamer"),
743 ptext (sLit "tcg_type_env of environment:") <+> ppr (tcg_type_env env)]
746 wrongThingErr :: String -> TcTyThing -> Name -> TcM a
747 wrongThingErr expected thing name
748 = failWithTc (pprTcTyThingCategory thing <+> quotes (ppr name) <+>
749 ptext (sLit "used as a") <+> text expected)