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,
21 tcLookupFamInst, tcLookupDataFamInst,
24 tcExtendKindEnv, tcExtendKindEnvTvs,
25 tcExtendTyVarEnv, tcExtendTyVarEnv2,
27 tcExtendIdEnv, tcExtendIdEnv1, tcExtendIdEnv2,
28 tcLookup, tcLookupLocated, tcLookupLocalIds,
29 tcLookupId, tcLookupTyVar, getScopedTyVarBinds,
31 wrongThingErr, pprBinders,
34 tcExtendRecEnv, -- For knot-tying
42 -- Global type variables
45 -- Template Haskell stuff
46 checkWellStaged, tcMetaTy, thLevel,
47 topIdLvl, thTopLevelId, thRnBrack, isBrackStage,
50 newLocalName, newDFunName, newFamInstTyConName,
51 mkStableIdFromString, mkStableIdFromName
54 #include "HsVersions.h"
64 -- import qualified Type
88 %************************************************************************
92 %************************************************************************
94 Using the Located versions (eg. tcLookupLocatedGlobal) is preferred,
95 unless you know that the SrcSpan in the monad is already set to the
99 tcLookupLocatedGlobal :: Located Name -> TcM TyThing
100 -- c.f. IfaceEnvEnv.tcIfaceGlobal
101 tcLookupLocatedGlobal name
102 = addLocM tcLookupGlobal name
104 tcLookupGlobal :: Name -> TcM TyThing
105 -- The Name is almost always an ExternalName, but not always
106 -- In GHCi, we may make command-line bindings (ghci> let x = True)
107 -- that bind a GlobalId, but with an InternalName
109 = do { env <- getGblEnv
112 ; case lookupNameEnv (tcg_type_env env) name of {
113 Just thing -> return thing ;
117 { hsc_env <- getTopEnv
118 ; mb_thing <- liftIO (lookupTypeHscEnv hsc_env name)
120 Just thing -> return thing ;
123 -- Should it have been in the local envt?
124 { case nameModule_maybe name of
125 Nothing -> notFound name -- Internal names can happen in GHCi
127 Just mod | mod == tcg_mod env -- Names from this module
128 -> notFound name -- should be in tcg_type_env
130 -> tcImportDecl name -- Go find it in an interface
133 tcLookupField :: Name -> TcM Id -- Returns the selector Id
135 = tcLookupId name -- Note [Record field lookup]
137 {- Note [Record field lookup]
138 ~~~~~~~~~~~~~~~~~~~~~~~~~~
139 You might think we should have tcLookupGlobal here, since record fields
140 are always top level. But consider
142 Then the renamer (which does not keep track of what is a record selector
143 and what is not) will rename the definition thus
144 f_7 = e { f_7 = True }
145 Now the type checker will find f_7 in the *local* type environment, not
146 the global (imported) one. It's wrong, of course, but we want to report a tidy
147 error, not in TcEnv.notFound. -}
149 tcLookupDataCon :: Name -> TcM DataCon
150 tcLookupDataCon name = do
151 thing <- tcLookupGlobal name
153 ADataCon con -> return con
154 _ -> wrongThingErr "data constructor" (AGlobal thing) name
156 tcLookupClass :: Name -> TcM Class
157 tcLookupClass name = do
158 thing <- tcLookupGlobal name
160 AClass cls -> return cls
161 _ -> wrongThingErr "class" (AGlobal thing) name
163 tcLookupTyCon :: Name -> TcM TyCon
164 tcLookupTyCon name = do
165 thing <- tcLookupGlobal name
167 ATyCon tc -> return tc
168 _ -> wrongThingErr "type constructor" (AGlobal thing) name
170 tcLookupLocatedGlobalId :: Located Name -> TcM Id
171 tcLookupLocatedGlobalId = addLocM tcLookupId
173 tcLookupLocatedClass :: Located Name -> TcM Class
174 tcLookupLocatedClass = addLocM tcLookupClass
176 tcLookupLocatedTyCon :: Located Name -> TcM TyCon
177 tcLookupLocatedTyCon = addLocM tcLookupTyCon
179 -- Look up the instance tycon of a family instance.
181 -- The match may be ambiguous (as we know that overlapping instances have
182 -- identical right-hand sides under overlapping substitutions - see
183 -- 'FamInstEnv.lookupFamInstEnvConflicts'). However, the type arguments used
184 -- for matching must be equal to or be more specific than those of the family
185 -- instance declaration. We pick one of the matches in case of ambiguity; as
186 -- the right-hand sides are identical under the match substitution, the choice
189 -- Return the instance tycon and its type instance. For example, if we have
191 -- tcLookupFamInst 'T' '[Int]' yields (':R42T', 'Int')
193 -- then we have a coercion (ie, type instance of family instance coercion)
195 -- :Co:R42T Int :: T [Int] ~ :R42T Int
197 -- which implies that :R42T was declared as 'data instance T [a]'.
199 tcLookupFamInst :: TyCon -> [Type] -> TcM (Maybe (TyCon, [Type]))
200 tcLookupFamInst tycon tys
201 | not (isFamilyTyCon tycon)
204 = do { env <- getGblEnv
206 ; let instEnv = (eps_fam_inst_env eps, tcg_fam_inst_env env)
207 ; traceTc "lookupFamInst" ((ppr tycon <+> ppr tys) $$ ppr instEnv)
208 ; case lookupFamInstEnv instEnv tycon tys of
210 ((fam_inst, rep_tys):_)
211 -> return $ Just (famInstTyCon fam_inst, rep_tys)
214 tcLookupDataFamInst :: TyCon -> [Type] -> TcM (TyCon, [Type])
215 -- Find the instance of a data famliy
216 -- Note [Looking up family instances for deriving]
217 tcLookupDataFamInst tycon tys
218 | not (isFamilyTyCon tycon)
219 = return (tycon, tys)
221 = ASSERT( isAlgTyCon tycon )
222 do { maybeFamInst <- tcLookupFamInst tycon tys
223 ; case maybeFamInst of
224 Nothing -> famInstNotFound tycon tys
225 Just famInst -> return famInst }
227 famInstNotFound :: TyCon -> [Type] -> TcM a
228 famInstNotFound tycon tys
229 = failWithTc (ptext (sLit "No family instance for")
230 <+> quotes (pprTypeApp tycon tys))
233 Note [Looking up family instances for deriving]
234 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
235 tcLookupFamInstExact is an auxiliary lookup wrapper which requires
236 that looked-up family instances exist. If called with a vanilla
237 tycon, the old type application is simply returned.
240 data instance F () = ... deriving Eq
241 data instance F () = ... deriving Eq
242 then tcLookupFamInstExact will be confused by the two matches;
243 but that can't happen because tcInstDecls1 doesn't call tcDeriving
244 if there are any overlaps.
246 There are two other things that might go wrong with the lookup.
247 First, we might see a standalone deriving clause
249 when there is no data instance F () in scope.
251 Note that it's OK to have
252 data instance F [a] = ...
253 deriving Eq (F [(a,b)])
254 where the match is not exact; the same holds for ordinary data types
255 with standalone deriving declrations.
258 instance MonadThings (IOEnv (Env TcGblEnv TcLclEnv)) where
259 lookupThing = tcLookupGlobal
262 %************************************************************************
264 Extending the global environment
266 %************************************************************************
270 setGlobalTypeEnv :: TcGblEnv -> TypeEnv -> TcM TcGblEnv
271 -- Use this to update the global type env
272 -- It updates both * the normal tcg_type_env field
273 -- * the tcg_type_env_var field seen by interface files
274 setGlobalTypeEnv tcg_env new_type_env
275 = do { -- Sync the type-envt variable seen by interface files
276 writeMutVar (tcg_type_env_var tcg_env) new_type_env
277 ; return (tcg_env { tcg_type_env = new_type_env }) }
279 tcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r
280 -- Given a mixture of Ids, TyCons, Classes, all from the
281 -- module being compiled, extend the global environment
282 tcExtendGlobalEnv things thing_inside
283 = do { tcg_env <- getGblEnv
284 ; let ge' = extendTypeEnvList (tcg_type_env tcg_env) things
285 ; tcg_env' <- setGlobalTypeEnv tcg_env ge'
286 ; setGblEnv tcg_env' thing_inside }
288 tcExtendGlobalValEnv :: [Id] -> TcM a -> TcM a
289 -- Same deal as tcExtendGlobalEnv, but for Ids
290 tcExtendGlobalValEnv ids thing_inside
291 = tcExtendGlobalEnv [AnId id | id <- ids] thing_inside
293 tcExtendRecEnv :: [(Name,TyThing)] -> TcM r -> TcM r
294 -- Extend the global environments for the type/class knot tying game
295 -- Just like tcExtendGlobalEnv, except the argument is a list of pairs
296 tcExtendRecEnv gbl_stuff thing_inside
297 = do { tcg_env <- getGblEnv
298 ; let ge' = extendNameEnvList (tcg_type_env tcg_env) gbl_stuff
299 ; tcg_env' <- setGlobalTypeEnv tcg_env ge'
300 ; setGblEnv tcg_env' thing_inside }
304 %************************************************************************
306 \subsection{The local environment}
308 %************************************************************************
311 tcLookupLocated :: Located Name -> TcM TcTyThing
312 tcLookupLocated = addLocM tcLookup
314 tcLookup :: Name -> TcM TcTyThing
316 local_env <- getLclTypeEnv
317 case lookupNameEnv local_env name of
318 Just thing -> return thing
319 Nothing -> AGlobal <$> tcLookupGlobal name
321 tcLookupTyVar :: Name -> TcM TcTyVar
322 tcLookupTyVar name = do
323 thing <- tcLookup name
325 ATyVar _ ty -> return (tcGetTyVar "tcLookupTyVar" ty)
326 _ -> pprPanic "tcLookupTyVar" (ppr name)
328 tcLookupId :: Name -> TcM Id
329 -- Used when we aren't interested in the binding level, nor refinement.
330 -- The "no refinement" part means that we return the un-refined Id regardless
332 -- The Id is never a DataCon. (Why does that matter? see TcExpr.tcId)
334 thing <- tcLookup name
336 ATcId { tct_id = id} -> return id
337 AGlobal (AnId id) -> return id
338 _ -> pprPanic "tcLookupId" (ppr name)
340 tcLookupLocalIds :: [Name] -> TcM [TcId]
341 -- We expect the variables to all be bound, and all at
342 -- the same level as the lookup. Only used in one place...
343 tcLookupLocalIds ns = do
345 return (map (lookup (tcl_env env) (thLevel (tcl_th_ctxt env))) ns)
348 = case lookupNameEnv lenv name of
349 Just (ATcId { tct_id = id, tct_level = lvl1 })
350 -> ASSERT( lvl == lvl1 ) id
351 _ -> pprPanic "tcLookupLocalIds" (ppr name)
353 getInLocalScope :: TcM (Name -> Bool)
355 getInLocalScope = do { lcl_env <- getLclTypeEnv
356 ; return (`elemNameEnv` lcl_env) }
360 tcExtendKindEnv :: [(Name, TcKind)] -> TcM r -> TcM r
361 tcExtendKindEnv things thing_inside
362 = updLclEnv upd thing_inside
364 upd lcl_env = lcl_env { tcl_env = extend (tcl_env lcl_env) }
365 extend env = extendNameEnvList env [(n, AThing k) | (n,k) <- things]
367 tcExtendKindEnvTvs :: [LHsTyVarBndr Name] -> ([LHsTyVarBndr Name] -> TcM r) -> TcM r
368 tcExtendKindEnvTvs bndrs thing_inside
369 = tcExtendKindEnv (map (hsTyVarNameKind . unLoc) bndrs)
372 tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
373 tcExtendTyVarEnv tvs thing_inside
374 = tcExtendTyVarEnv2 [(tyVarName tv, mkTyVarTy tv) | tv <- tvs] thing_inside
376 tcExtendTyVarEnv2 :: [(Name,TcType)] -> TcM r -> TcM r
377 tcExtendTyVarEnv2 binds thing_inside = do
378 env@(TcLclEnv {tcl_env = le,
380 tcl_rdr = rdr_env}) <- getLclEnv
382 rdr_env' = extendLocalRdrEnvList rdr_env (map fst binds)
383 new_tv_set = tcTyVarsOfTypes (map snd binds)
384 le' = extendNameEnvList le [(name, ATyVar name ty) | (name, ty) <- binds]
386 -- It's important to add the in-scope tyvars to the global tyvar set
388 -- f (_::r) = let g y = y::r in ...
389 -- Here, g mustn't be generalised. This is also important during
390 -- class and instance decls, when we mustn't generalise the class tyvars
391 -- when typechecking the methods.
392 gtvs' <- tcExtendGlobalTyVars gtvs new_tv_set
393 setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs', tcl_rdr = rdr_env'}) thing_inside
395 getScopedTyVarBinds :: TcM [(Name, TcType)]
397 = do { lcl_env <- getLclEnv
398 ; return [(name, ty) | ATyVar name ty <- nameEnvElts (tcl_env lcl_env)] }
403 tcExtendIdEnv :: [TcId] -> TcM a -> TcM a
404 tcExtendIdEnv ids thing_inside = tcExtendIdEnv2 [(idName id, id) | id <- ids] thing_inside
406 tcExtendIdEnv1 :: Name -> TcId -> TcM a -> TcM a
407 tcExtendIdEnv1 name id thing_inside = tcExtendIdEnv2 [(name,id)] thing_inside
409 getHetMetLevel :: TcM [TyVar]
412 ; return $ case env of Env { env_lcl = e' } -> case e' of TcLclEnv { tcl_hetMetLevel = x } -> x
415 tcExtendIdEnv2 :: [(Name,TcId)] -> TcM a -> TcM a
416 -- Invariant: the TcIds are fully zonked (see tcExtendIdEnv above)
417 tcExtendIdEnv2 names_w_ids thing_inside
418 = do { env <- getLclEnv
419 ; hetMetLevel <- getHetMetLevel
420 ; tc_extend_local_id_env env (thLevel (tcl_th_ctxt env)) hetMetLevel names_w_ids thing_inside }
423 tcExtendGhciEnv :: [TcId] -> TcM a -> TcM a
424 -- Used to bind Ids for GHCi identifiers bound earlier in the user interaction
425 -- Note especially that we bind them at TH level 'impLevel'. That's because it's
426 -- OK to use a variable bound earlier in the interaction in a splice, becuase
427 -- GHCi has already compiled it to bytecode
428 tcExtendGhciEnv ids thing_inside
429 = do { env <- getLclEnv
430 ; hetMetLevel <- getHetMetLevel
431 ; tc_extend_local_id_env env impLevel hetMetLevel [(idName id, id) | id <- ids] thing_inside }
433 tc_extend_local_id_env -- This is the guy who does the work
439 -- Invariant: the TcIds are fully zonked. Reasons:
440 -- (a) The kinds of the forall'd type variables are defaulted
441 -- (see Kind.defaultKind, done in zonkQuantifiedTyVar)
442 -- (b) There are no via-Indirect occurrences of the bound variables
443 -- in the types, because instantiation does not look through such things
444 -- (c) The call to tyVarsOfTypes is ok without looking through refs
446 tc_extend_local_id_env env th_lvl hetMetLevel names_w_ids thing_inside
447 = do { traceTc "env2" (ppr extra_env)
448 ; gtvs' <- tcExtendGlobalTyVars (tcl_tyvars env) extra_global_tyvars
449 ; let env' = env {tcl_env = le', tcl_tyvars = gtvs', tcl_rdr = rdr_env'}
450 ; setLclEnv env' thing_inside }
452 extra_global_tyvars = tcTyVarsOfTypes [idType id | (_,id) <- names_w_ids]
453 extra_env = [ (name, ATcId { tct_id = id,
455 tct_hetMetLevel = hetMetLevel
457 | (name,id) <- names_w_ids]
458 le' = extendNameEnvList (tcl_env env) extra_env
459 rdr_env' = extendLocalRdrEnvList (tcl_rdr env) [name | (name,_) <- names_w_ids]
461 tcExtendGlobalTyVars :: IORef VarSet -> VarSet -> TcM (IORef VarSet)
462 tcExtendGlobalTyVars gtv_var extra_global_tvs
463 = do { global_tvs <- readMutVar gtv_var
464 ; newMutVar (global_tvs `unionVarSet` extra_global_tvs) }
468 %************************************************************************
472 %************************************************************************
475 tcExtendRules :: [LRuleDecl Id] -> TcM a -> TcM a
476 -- Just pop the new rules into the EPS and envt resp
477 -- All the rules come from an interface file, not soruce
478 -- Nevertheless, some may be for this module, if we read
479 -- its interface instead of its source code
480 tcExtendRules lcl_rules thing_inside
481 = do { env <- getGblEnv
483 env' = env { tcg_rules = lcl_rules ++ tcg_rules env }
484 ; setGblEnv env' thing_inside }
488 %************************************************************************
492 %************************************************************************
495 checkWellStaged :: SDoc -- What the stage check is for
496 -> ThLevel -- Binding level (increases inside brackets)
497 -> ThLevel -- Use stage
498 -> TcM () -- Fail if badly staged, adding an error
499 checkWellStaged pp_thing bind_lvl use_lvl
500 | use_lvl >= bind_lvl -- OK! Used later than bound
501 = return () -- E.g. \x -> [| $(f x) |]
503 | bind_lvl == outerLevel -- GHC restriction on top level splices
505 sep [ptext (sLit "GHC stage restriction:") <+> pp_thing,
506 nest 2 (vcat [ ptext (sLit "is used in a top-level splice or annotation,")
507 , ptext (sLit "and must be imported, not defined locally")])]
509 | otherwise -- Badly staged
510 = failWithTc $ -- E.g. \x -> $(f x)
511 ptext (sLit "Stage error:") <+> pp_thing <+>
512 hsep [ptext (sLit "is bound at stage") <+> ppr bind_lvl,
513 ptext (sLit "but used at stage") <+> ppr use_lvl]
515 topIdLvl :: Id -> ThLevel
516 -- Globals may either be imported, or may be from an earlier "chunk"
517 -- (separated by declaration splices) of this module. The former
518 -- *can* be used inside a top-level splice, but the latter cannot.
519 -- Hence we give the former impLevel, but the latter topLevel
523 -- By the time we are prcessing the $(f x), the binding for "x"
524 -- will be in the global env, not the local one.
525 topIdLvl id | isLocalId id = outerLevel
526 | otherwise = impLevel
528 tcMetaTy :: Name -> TcM Type
529 -- Given the name of a Template Haskell data type,
531 -- E.g. given the name "Expr" return the type "Expr"
532 tcMetaTy tc_name = do
533 t <- tcLookupTyCon tc_name
534 return (mkTyConApp t [])
537 -- Used *only* to indicate that we are inside a TH bracket during renaming
538 -- Tested by TcEnv.isBrackStage
539 -- See Note [Top-level Names in Template Haskell decl quotes]
540 thRnBrack = Brack (panic "thRnBrack1") (panic "thRnBrack2") (panic "thRnBrack3")
542 isBrackStage :: ThStage -> Bool
543 isBrackStage (Brack {}) = True
544 isBrackStage _other = False
546 thTopLevelId :: Id -> Bool
547 -- See Note [What is a top-level Id?] in TcSplice
548 thTopLevelId id = isGlobalId id || isExternalName (idName id)
552 %************************************************************************
556 %************************************************************************
559 tcGetDefaultTys :: Bool -- True <=> interactive context
560 -> TcM ([Type], -- Default types
561 (Bool, -- True <=> Use overloaded strings
562 Bool)) -- True <=> Use extended defaulting rules
563 tcGetDefaultTys interactive
564 = do { dflags <- getDOpts
565 ; let ovl_strings = xopt Opt_OverloadedStrings dflags
566 extended_defaults = interactive
567 || xopt Opt_ExtendedDefaultRules dflags
568 -- See also Trac #1974
569 flags = (ovl_strings, extended_defaults)
571 ; mb_defaults <- getDeclaredDefaultTys
572 ; case mb_defaults of {
573 Just tys -> return (tys, flags) ;
574 -- User-supplied defaults
577 -- No use-supplied default
578 -- Use [Integer, Double], plus modifications
579 { integer_ty <- tcMetaTy integerTyConName
580 ; checkWiredInTyCon doubleTyCon
581 ; string_ty <- tcMetaTy stringTyConName
582 ; let deflt_tys = opt_deflt extended_defaults unitTy -- Note [Default unitTy]
583 ++ [integer_ty, doubleTy]
584 ++ opt_deflt ovl_strings string_ty
585 ; return (deflt_tys, flags) } } }
587 opt_deflt True ty = [ty]
588 opt_deflt False _ = []
591 Note [Default unitTy]
592 ~~~~~~~~~~~~~~~~~~~~~
593 In interative mode (or with -XExtendedDefaultRules) we add () as the first type we
594 try when defaulting. This has very little real impact, except in the following case.
596 Text.Printf.printf "hello"
597 This has type (forall a. IO a); it prints "hello", and returns 'undefined'. We don't
598 want the GHCi repl loop to try to print that 'undefined'. The neatest thing is to
599 default the 'a' to (), rather than to Integer (which is what would otherwise happen;
600 and then GHCi doesn't attempt to print the (). So in interactive mode, we add
601 () to the list of defaulting types. See Trac #1200.
604 %************************************************************************
606 \subsection{The InstInfo type}
608 %************************************************************************
610 The InstInfo type summarises the information in an instance declaration
612 instance c => k (t tvs) where b
614 It is used just for *local* instance decls (not ones from interface files).
615 But local instance decls includes
618 as well as explicit user written ones.
623 iSpec :: Instance, -- Includes the dfun id. Its forall'd type
624 iBinds :: InstBindings a -- variables scope over the stuff in InstBindings!
627 iDFunId :: InstInfo a -> DFunId
628 iDFunId info = instanceDFunId (iSpec info)
631 = VanillaInst -- The normal case
632 (LHsBinds a) -- Bindings for the instance methods
633 [LSig a] -- User pragmas recorded for generating
634 -- specialised instances
635 Bool -- True <=> This code came from a standalone deriving clause
636 -- Used only to improve error messages
638 | NewTypeDerived -- Used for deriving instances of newtypes, where the
639 -- witness dictionary is identical to the argument
640 -- dictionary. Hence no bindings, no pragmas.
642 CoercionI -- The coercion maps from newtype to the representation type
643 -- (mentioning type variables bound by the forall'd iSpec variables)
644 -- E.g. newtype instance N [a] = N1 (Tree a)
645 -- co : N [a] ~ Tree a
647 TyCon -- The TyCon is the newtype N. If it's indexed, then it's the
648 -- representation TyCon, so that tyConDataCons returns [N1],
649 -- the "data constructor".
650 -- See Note [Newtype deriving and unused constructors]
653 pprInstInfo :: InstInfo a -> SDoc
654 pprInstInfo info = hang (ptext (sLit "instance"))
655 2 (sep [ ifPprDebug (pprForAll tvs)
656 , pprThetaArrow theta, ppr tau
657 , ptext (sLit "where")])
659 (tvs, theta, tau) = tcSplitSigmaTy (idType (iDFunId info))
662 pprInstInfoDetails :: OutputableBndr a => InstInfo a -> SDoc
663 pprInstInfoDetails info = pprInstInfo info $$ nest 2 (details (iBinds info))
665 details (VanillaInst b _ _) = pprLHsBinds b
666 details (NewTypeDerived {}) = text "Derived from the representation type"
668 simpleInstInfoClsTy :: InstInfo a -> (Class, Type)
669 simpleInstInfoClsTy info = case instanceHead (iSpec info) of
670 (_, _, cls, [ty]) -> (cls, ty)
671 _ -> panic "simpleInstInfoClsTy"
673 simpleInstInfoTy :: InstInfo a -> Type
674 simpleInstInfoTy info = snd (simpleInstInfoClsTy info)
676 simpleInstInfoTyCon :: InstInfo a -> TyCon
677 -- Gets the type constructor for a simple instance declaration,
678 -- i.e. one of the form instance (...) => C (T a b c) where ...
679 simpleInstInfoTyCon inst = tcTyConAppTyCon (simpleInstInfoTy inst)
682 Make a name for the dict fun for an instance decl. It's an *external*
683 name, like otber top-level names, and hence must be made with newGlobalBinder.
686 newDFunName :: Class -> [Type] -> SrcSpan -> TcM Name
687 newDFunName clas tys loc
688 = do { is_boot <- tcIsHsBoot
690 ; let info_string = occNameString (getOccName clas) ++
691 concatMap (occNameString.getDFunTyKey) tys
692 ; dfun_occ <- chooseUniqueOccTc (mkDFunOcc info_string is_boot)
693 ; newGlobalBinder mod dfun_occ loc }
696 Make a name for the representation tycon of a family instance. It's an
697 *external* name, like otber top-level names, and hence must be made with
701 newFamInstTyConName :: Name -> [Type] -> SrcSpan -> TcM Name
702 newFamInstTyConName tc_name tys loc
703 = do { mod <- getModule
704 ; let info_string = occNameString (getOccName tc_name) ++
705 concatMap (occNameString.getDFunTyKey) tys
706 ; occ <- chooseUniqueOccTc (mkInstTyTcOcc info_string)
707 ; newGlobalBinder mod occ loc }
710 Stable names used for foreign exports and annotations.
711 For stable names, the name must be unique (see #1533). If the
712 same thing has several stable Ids based on it, the
713 top-level bindings generated must not have the same name.
714 Hence we create an External name (doesn't change), and we
715 append a Unique to the string right here.
718 mkStableIdFromString :: String -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
719 mkStableIdFromString str sig_ty loc occ_wrapper = do
722 let uniq_str = showSDoc (pprUnique uniq) :: String
723 occ = mkVarOcc (str ++ '_' : uniq_str) :: OccName
724 gnm = mkExternalName uniq mod (occ_wrapper occ) loc :: Name
725 id = mkExportedLocalId gnm sig_ty :: Id
728 mkStableIdFromName :: Name -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
729 mkStableIdFromName nm = mkStableIdFromString (getOccString nm)
732 %************************************************************************
736 %************************************************************************
739 pprBinders :: [Name] -> SDoc
740 -- Used in error messages
741 -- Use quotes for a single one; they look a bit "busy" for several
742 pprBinders [bndr] = quotes (ppr bndr)
743 pprBinders bndrs = pprWithCommas ppr bndrs
745 notFound :: Name -> TcM TyThing
747 = do { (gbl,lcl) <- getEnvs
748 ; failWithTc (vcat[ptext (sLit "GHC internal error:") <+> quotes (ppr name) <+>
749 ptext (sLit "is not in scope during type checking, but it passed the renamer"),
750 ptext (sLit "tcg_type_env of environment:") <+> ppr (tcg_type_env gbl),
751 ptext (sLit "tcl_env of environment:") <+> ppr (tcl_env lcl)]
754 wrongThingErr :: String -> TcTyThing -> Name -> TcM a
755 wrongThingErr expected thing name
756 = failWithTc (pprTcTyThingCategory thing <+> quotes (ppr name) <+>
757 ptext (sLit "used as a") <+> text expected)