3 TyThing(..), TyThingDetails(..), TcTyThing(..), TcId,
5 -- Instance environment, and InstInfo type
6 tcGetInstEnv, tcSetInstEnv,
7 InstInfo(..), pprInstInfo, pprInstInfoDetails,
8 simpleInstInfoTy, simpleInstInfoTyCon,
14 tcExtendGlobalTypeEnv,
15 tcLookupTyCon, tcLookupClass, tcLookupDataCon,
16 tcLookupGlobal_maybe, tcLookupGlobal, tcLookupGlobalId,
21 tcExtendTyVarEnv, tcExtendTyVarEnv2,
22 tcExtendLocalValEnv, tcExtendLocalValEnv2,
23 tcLookup, tcLookupLocalIds, tcLookup_maybe,
24 tcLookupId, tcLookupIdLvl,
25 lclEnvElts, getInLocalScope, findGlobals,
27 -- Instance environment
28 tcExtendLocalInstEnv, tcExtendInstEnv,
33 -- Global type variables
36 -- Template Haskell stuff
37 checkWellStaged, spliceOK, bracketOK, tcMetaTy, metaLevel,
41 newLocalName, newDFunName,
47 #include "HsVersions.h"
49 import RnHsSyn ( RenamedMonoBinds, RenamedSig )
50 import HsSyn ( RuleDecl(..), ifaceRuleDeclName )
52 import TcMType ( zonkTcType, zonkTcTyVar, zonkTcTyVarsAndFV )
53 import TcType ( Type, ThetaType, TcKind, TcTyVar, TcTyVarSet,
54 tyVarsOfType, tyVarsOfTypes, tcSplitDFunTy, mkGenTyConApp,
55 getDFunTyKey, tcTyConAppTyCon, tyVarBindingInfo,
56 tidyOpenType, tidyOpenTyVar
58 import qualified Type ( getTyVar_maybe )
59 import Rules ( extendRuleBase )
60 import Id ( idName, isLocalId, isDataConWrapId_maybe )
61 import Var ( TyVar, Id, idType )
64 import CoreSyn ( IdCoreRule )
65 import DataCon ( DataCon, dataConWrapId )
66 import TyCon ( TyCon, DataConDetails )
67 import Class ( Class, ClassOpItem )
68 import Name ( Name, NamedThing(..),
69 getSrcLoc, mkInternalName, nameIsLocalOrFrom
72 import OccName ( mkDFunOcc, occNameString )
73 import HscTypes ( DFunId, TypeEnv, extendTypeEnvList, lookupType,
74 TyThing(..), ExternalPackageState(..) )
75 import Rules ( RuleBase )
76 import BasicTypes ( EP )
77 import Module ( Module )
78 import InstEnv ( InstEnv, extendInstEnv )
79 import Maybes ( seqMaybe )
80 import SrcLoc ( SrcLoc )
82 import Maybe ( isJust )
83 import List ( partition )
87 %************************************************************************
91 %************************************************************************
94 instance Outputable Stage where
95 ppr Comp = text "Comp"
96 ppr (Brack l _ _) = text "Brack" <+> int l
97 ppr (Splice l) = text "Splice" <+> int l
100 metaLevel :: Stage -> Level
101 metaLevel Comp = topLevel
102 metaLevel (Splice l) = l
103 metaLevel (Brack l _ _) = l
106 checkWellStaged :: SDoc -- What the stage check is for
107 -> Level -- Binding level
108 -> Stage -- Use stage
109 -> TcM () -- Fail if badly staged, adding an error
110 checkWellStaged pp_thing bind_lvl use_stage
111 | bind_lvl <= use_lvl -- OK!
114 | bind_lvl == topLevel -- GHC restriction on top level splices
116 sep [ptext SLIT("GHC stage restriction:") <+> pp_thing,
117 nest 2 (ptext SLIT("is used in a top-level splice, and must be imported, not defined locally"))]
119 | otherwise -- Badly staged
121 ptext SLIT("Stage error:") <+> pp_thing <+>
122 hsep [ptext SLIT("is bound at stage") <+> ppr bind_lvl,
123 ptext SLIT("but used at stage") <+> ppr use_lvl]
125 use_lvl = metaLevel use_stage
128 topIdLvl :: Id -> Level
129 -- Globals may either be imported, or may be from an earlier "chunk"
130 -- (separated by declaration splices) of this module. The former
131 -- *can* be used inside a top-level splice, but the latter cannot.
132 -- Hence we give the former impLevel, but the latter topLevel
136 -- By the time we are prcessing the $(f x), the binding for "x"
137 -- will be in the global env, not the local one.
138 topIdLvl id | isLocalId id = topLevel
139 | otherwise = impLevel
141 -- Indicates the legal transitions on bracket( [| |] ).
142 bracketOK :: Stage -> Maybe Level
143 bracketOK (Brack _ _ _) = Nothing -- Bracket illegal inside a bracket
144 bracketOK stage = (Just (metaLevel stage + 1))
146 -- Indicates the legal transitions on splice($).
147 spliceOK :: Stage -> Maybe Level
148 spliceOK (Splice _) = Nothing -- Splice illegal inside splice
149 spliceOK stage = Just (metaLevel stage - 1)
151 tcMetaTy :: Name -> TcM Type
152 -- Given the name of a Template Haskell data type,
154 -- E.g. given the name "Expr" return the type "Expr"
156 = tcLookupTyCon tc_name `thenM` \ t ->
157 returnM (mkGenTyConApp t [])
158 -- Use mkGenTyConApp because it might be a synonym
162 %************************************************************************
164 \subsection{TyThingDetails}
166 %************************************************************************
168 This data type is used to help tie the knot
169 when type checking type and class declarations
172 data TyThingDetails = SynTyDetails Type
173 | DataTyDetails ThetaType (DataConDetails DataCon) [Id] (Maybe (EP Id))
174 | ClassDetails ThetaType [Id] [ClassOpItem] DataCon Name
175 -- The Name is the Name of the implicit TyCon for the class
176 | ForeignTyDetails -- Nothing yet
180 %************************************************************************
182 \subsection{Making new Ids}
184 %************************************************************************
189 newLocalName :: Name -> TcM Name
190 newLocalName name -- Make a clone
191 = newUnique `thenM` \ uniq ->
192 returnM (mkInternalName uniq (getOccName name) (getSrcLoc name))
195 Make a name for the dict fun for an instance decl. It's a *local*
196 name for the moment. The CoreTidy pass will externalise it. Even in
197 --make and ghci stuff, we rebuild the instance environment each time,
198 so the dfun id is internal to begin with, and external when compiling
202 newDFunName :: Class -> [Type] -> SrcLoc -> TcM Name
203 newDFunName clas (ty:_) loc
204 = newUnique `thenM` \ uniq ->
205 returnM (mkInternalName uniq (mkDFunOcc dfun_string) loc)
207 -- Any string that is somewhat unique will do
208 dfun_string = occNameString (getOccName clas) ++ occNameString (getDFunTyKey ty)
210 newDFunName clas [] loc = pprPanic "newDFunName" (ppr clas <+> ppr loc)
214 isLocalThing :: NamedThing a => Module -> a -> Bool
215 isLocalThing mod thing = nameIsLocalOrFrom mod (getName thing)
218 %************************************************************************
220 \subsection{The global environment}
222 %************************************************************************
225 tcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r
226 -- Given a mixture of Ids, TyCons, Classes, perhaps from the
227 -- module being compiled, perhaps from a package module,
228 -- extend the global environment, and update the EPS
229 tcExtendGlobalEnv things thing_inside
233 ; let mod = tcg_mod env
234 (lcl_things, pkg_things) = partition (isLocalThing mod) things
235 ge' = extendTypeEnvList (tcg_type_env env) lcl_things
236 eps' = eps { eps_PTE = extendTypeEnvList (eps_PTE eps) pkg_things }
238 ; setGblEnv (env {tcg_type_env = ge'}) thing_inside }
240 tcExtendGlobalValEnv :: [Id] -> TcM a -> TcM a
241 -- Same deal as tcExtendGlobalEnv, but for Ids
242 tcExtendGlobalValEnv ids thing_inside
243 = tcExtendGlobalEnv [AnId id | id <- ids] thing_inside
245 tcExtendGlobalTypeEnv :: TypeEnv -> TcM r -> TcM r
246 -- Top-level things of the interactive context
247 -- No need to extend the package env
248 tcExtendGlobalTypeEnv extra_env thing_inside
249 = do { env <- getGblEnv
250 ; let ge' = tcg_type_env env `plusNameEnv` extra_env
251 ; setGblEnv (env {tcg_type_env = ge'}) thing_inside }
256 tcLookupGlobal_maybe :: Name -> TcRn m (Maybe TyThing)
257 -- This is a rather heavily-used function, so I've inlined a few things (e.g. getEps)
258 -- Notice that for imported things we read the current version from the EPS
259 -- mutable variable. This is important in situations like
260 -- ...$(e1)...$(e2)...
261 -- where the code that e1 expands to might import some defns that
262 -- also turn out to be needed by the code that e2 expands to.
263 tcLookupGlobal_maybe name
264 = do { env <- getGblEnv
265 ; if nameIsLocalOrFrom (tcg_mod env) name then
266 -- Defined in this module
267 return (lookupNameEnv (tcg_type_env env) name)
269 do { env <- getTopEnv
270 ; eps <- readMutVar (top_eps env)
271 ; return (lookupType (top_hpt env) (eps_PTE eps) name) }}
274 A variety of global lookups, when we know what we are looking for.
277 tcLookupGlobal :: Name -> TcM TyThing
279 = tcLookupGlobal_maybe name `thenM` \ maybe_thing ->
281 Just thing -> returnM thing
282 other -> notFound "tcLookupGlobal" name
284 tcLookupGlobalId :: Name -> TcM Id
285 tcLookupGlobalId name
286 = tcLookupGlobal_maybe name `thenM` \ maybe_thing ->
288 Just (AnId id) -> returnM id
290 -- When typechecking Haskell source, occurrences of
291 -- data constructors use the "source name", which maps
292 -- to ADataCon; we want the wrapper instead
293 Just (ADataCon dc) -> returnM (dataConWrapId dc)
295 other -> notFound "tcLookupGlobal (id)" name
297 tcLookupDataCon :: Name -> TcM DataCon
298 tcLookupDataCon con_name
299 = tcLookupGlobal_maybe con_name `thenM` \ maybe_thing ->
301 Just (ADataCon data_con) -> returnM data_con
302 other -> notFound "tcLookupDataCon" con_name
304 tcLookupClass :: Name -> TcM Class
306 = tcLookupGlobal_maybe name `thenM` \ maybe_clas ->
308 Just (AClass clas) -> returnM clas
309 other -> notFound "tcLookupClass" name
311 tcLookupTyCon :: Name -> TcM TyCon
313 = tcLookupGlobal_maybe name `thenM` \ maybe_tc ->
315 Just (ATyCon tc) -> returnM tc
316 other -> notFound "tcLookupTyCon" name
319 getInGlobalScope :: TcRn m (Name -> Bool)
320 -- Get all things in the global environment; used for deciding what
321 -- rules to suck in. Anything defined in this module (nameIsLocalOrFrom)
322 -- is certainly in the envt, so we don't bother to look.
324 = do { mod <- getModule
327 ; return (\n -> nameIsLocalOrFrom mod n ||
328 isJust (lookupType hpt (eps_PTE eps) n)) }
332 %************************************************************************
334 \subsection{The local environment}
336 %************************************************************************
339 tcLookup_maybe :: Name -> TcM (Maybe TcTyThing)
341 = getLclEnv `thenM` \ local_env ->
342 case lookupNameEnv (tcl_env local_env) name of
343 Just thing -> returnM (Just thing)
344 Nothing -> tcLookupGlobal_maybe name `thenM` \ mb_res ->
345 returnM (case mb_res of
346 Just thing -> Just (AGlobal thing)
349 tcLookup :: Name -> TcM TcTyThing
351 = tcLookup_maybe name `thenM` \ maybe_thing ->
353 Just thing -> returnM thing
354 other -> notFound "tcLookup" name
355 -- Extract the IdInfo from an IfaceSig imported from an interface file
357 tcLookupId :: Name -> TcM Id
358 -- Used when we aren't interested in the binding level
360 = tcLookup name `thenM` \ thing ->
362 ATcId tc_id lvl -> returnM tc_id
363 AGlobal (AnId id) -> returnM id
364 AGlobal (ADataCon dc) -> returnM (dataConWrapId dc)
365 -- C.f. tcLookupGlobalId
366 other -> pprPanic "tcLookupId" (ppr name)
368 tcLookupIdLvl :: Name -> TcM (Id, Level)
370 = tcLookup name `thenM` \ thing ->
372 ATcId tc_id lvl -> returnM (tc_id, lvl)
373 AGlobal (AnId id) -> returnM (id, topIdLvl id)
374 AGlobal (ADataCon dc) -> returnM (dataConWrapId dc, impLevel)
375 other -> pprPanic "tcLookupIdLvl" (ppr name)
377 tcLookupLocalIds :: [Name] -> TcM [TcId]
378 -- We expect the variables to all be bound, and all at
379 -- the same level as the lookup. Only used in one place...
381 = getLclEnv `thenM` \ env ->
382 returnM (map (lookup (tcl_env env) (metaLevel (tcl_level env))) ns)
385 = case lookupNameEnv lenv name of
386 Just (ATcId id lvl1) -> ASSERT( lvl == lvl1 ) id
387 other -> pprPanic "tcLookupLocalIds" (ppr name)
389 lclEnvElts :: TcLclEnv -> [TcTyThing]
390 lclEnvElts env = nameEnvElts (tcl_env env)
392 getInLocalScope :: TcM (Name -> Bool)
394 getInLocalScope = getLclEnv `thenM` \ env ->
396 lcl_env = tcl_env env
398 return (`elemNameEnv` lcl_env)
402 tcExtendKindEnv :: [(Name,TcKind)] -> TcM r -> TcM r
403 tcExtendKindEnv pairs thing_inside
404 = updLclEnv upd thing_inside
406 upd lcl_env = lcl_env { tcl_env = extend (tcl_env lcl_env) }
407 extend env = extendNameEnvList env [(n, AThing k) | (n,k) <- pairs]
408 -- No need to extend global tyvars for kind checking
410 tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
411 tcExtendTyVarEnv tvs thing_inside
412 = tc_extend_tv_env [(getName tv, ATyVar tv) | tv <- tvs] tvs thing_inside
414 tcExtendTyVarEnv2 :: [(TyVar,TcTyVar)] -> TcM r -> TcM r
415 tcExtendTyVarEnv2 tv_pairs thing_inside
416 = tc_extend_tv_env [(getName tv1, ATyVar tv2) | (tv1,tv2) <- tv_pairs]
417 [tv | (_,tv) <- tv_pairs]
420 tc_extend_tv_env binds tyvars thing_inside
421 = getLclEnv `thenM` \ env@(TcLclEnv {tcl_env = le, tcl_tyvars = gtvs}) ->
423 le' = extendNameEnvList le binds
424 new_tv_set = mkVarSet tyvars
426 -- It's important to add the in-scope tyvars to the global tyvar set
428 -- f (x::r) = let g y = y::r in ...
429 -- Here, g mustn't be generalised. This is also important during
430 -- class and instance decls, when we mustn't generalise the class tyvars
431 -- when typechecking the methods.
432 tc_extend_gtvs gtvs new_tv_set `thenM` \ gtvs' ->
433 setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs'}) thing_inside
438 tcExtendLocalValEnv :: [TcId] -> TcM a -> TcM a
439 tcExtendLocalValEnv ids thing_inside
440 = getLclEnv `thenM` \ env ->
442 extra_global_tyvars = tyVarsOfTypes [idType id | id <- ids]
443 lvl = metaLevel (tcl_level env)
444 extra_env = [(idName id, ATcId id lvl) | id <- ids]
445 le' = extendNameEnvList (tcl_env env) extra_env
447 tc_extend_gtvs (tcl_tyvars env) extra_global_tyvars `thenM` \ gtvs' ->
448 setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs'}) thing_inside
450 tcExtendLocalValEnv2 :: [(Name,TcId)] -> TcM a -> TcM a
451 tcExtendLocalValEnv2 names_w_ids thing_inside
452 = getLclEnv `thenM` \ env ->
454 extra_global_tyvars = tyVarsOfTypes [idType id | (name,id) <- names_w_ids]
455 lvl = metaLevel (tcl_level env)
456 extra_env = [(name, ATcId id lvl) | (name,id) <- names_w_ids]
457 le' = extendNameEnvList (tcl_env env) extra_env
459 tc_extend_gtvs (tcl_tyvars env) extra_global_tyvars `thenM` \ gtvs' ->
460 setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs'}) thing_inside
465 -----------------------
466 -- findGlobals looks at the value environment and finds values
467 -- whose types mention the offending type variable. It has to be
468 -- careful to zonk the Id's type first, so it has to be in the monad.
469 -- We must be careful to pass it a zonked type variable, too.
471 findGlobals :: TcTyVarSet
473 -> TcM (TidyEnv, [SDoc])
475 findGlobals tvs tidy_env
476 = getLclEnv `thenM` \ lcl_env ->
477 go tidy_env [] (lclEnvElts lcl_env)
479 go tidy_env acc [] = returnM (tidy_env, acc)
480 go tidy_env acc (thing : things)
481 = find_thing ignore_it tidy_env thing `thenM` \ (tidy_env1, maybe_doc) ->
483 Just d -> go tidy_env1 (d:acc) things
484 Nothing -> go tidy_env1 acc things
486 ignore_it ty = not (tvs `intersectsVarSet` tyVarsOfType ty)
488 -----------------------
489 find_thing ignore_it tidy_env (ATcId id _)
490 = zonkTcType (idType id) `thenM` \ id_ty ->
491 if ignore_it id_ty then
492 returnM (tidy_env, Nothing)
494 (tidy_env', tidy_ty) = tidyOpenType tidy_env id_ty
495 msg = sep [ppr id <+> dcolon <+> ppr tidy_ty,
496 nest 2 (parens (ptext SLIT("bound at") <+>
497 ppr (getSrcLoc id)))]
499 returnM (tidy_env', Just msg)
501 find_thing ignore_it tidy_env (ATyVar tv)
502 = zonkTcTyVar tv `thenM` \ tv_ty ->
503 if ignore_it tv_ty then
504 returnM (tidy_env, Nothing)
506 (tidy_env1, tv1) = tidyOpenTyVar tidy_env tv
507 (tidy_env2, tidy_ty) = tidyOpenType tidy_env1 tv_ty
508 msg = sep [ppr tv1 <+> eq_stuff, nest 2 bound_at]
510 eq_stuff | Just tv' <- Type.getTyVar_maybe tv_ty, tv == tv' = empty
511 | otherwise = equals <+> ppr tv_ty
512 -- It's ok to use Type.getTyVar_maybe because ty is zonked by now
514 bound_at = tyVarBindingInfo tv
516 returnM (tidy_env2, Just msg)
520 %************************************************************************
522 \subsection{The global tyvars}
524 %************************************************************************
527 tc_extend_gtvs gtvs extra_global_tvs
528 = readMutVar gtvs `thenM` \ global_tvs ->
529 newMutVar (global_tvs `unionVarSet` extra_global_tvs)
532 @tcGetGlobalTyVars@ returns a fully-zonked set of tyvars free in the environment.
533 To improve subsequent calls to the same function it writes the zonked set back into
537 tcGetGlobalTyVars :: TcM TcTyVarSet
539 = getLclEnv `thenM` \ (TcLclEnv {tcl_tyvars = gtv_var}) ->
540 readMutVar gtv_var `thenM` \ gbl_tvs ->
541 zonkTcTyVarsAndFV (varSetElems gbl_tvs) `thenM` \ gbl_tvs' ->
542 writeMutVar gtv_var gbl_tvs' `thenM_`
547 %************************************************************************
549 \subsection{The instance environment}
551 %************************************************************************
553 The TcGblEnv holds a mutable variable containing the current full, instance environment.
554 The ExtendInstEnv functions extend this environment by side effect, in case we are
555 sucking in new instance declarations deep in the body of a TH splice, which are needed
556 in another TH splice. The tcg_insts field of the TcGblEnv contains just the dfuns
560 tcGetInstEnv :: TcM InstEnv
561 tcGetInstEnv = getGblEnv `thenM` \ env ->
562 readMutVar (tcg_inst_env env)
564 tcSetInstEnv :: InstEnv -> TcM a -> TcM a
565 -- Horribly imperative;
566 -- but used only when temporarily enhancing the instance
567 -- envt during 'deriving' context inference
568 tcSetInstEnv ie thing_inside
569 = getGblEnv `thenM` \ env ->
571 ie_var = tcg_inst_env env
573 readMutVar ie_var `thenM` \ old_ie ->
574 writeMutVar ie_var ie `thenM_`
575 thing_inside `thenM` \ result ->
576 writeMutVar ie_var old_ie `thenM_`
579 tcExtendInstEnv :: [DFunId] -> TcM a -> TcM a
580 -- Add instances from local or imported
581 -- instances, and refresh the instance-env cache
582 tcExtendInstEnv dfuns thing_inside
583 = do { dflags <- getDOpts
586 ; let ie_var = tcg_inst_env env
587 ; inst_env <- readMutVar ie_var
589 -- Extend the total inst-env with the new dfuns
590 (inst_env', errs) = extendInstEnv dflags inst_env dfuns
592 -- Sort the ones from this module from the others
593 (lcl_dfuns, pkg_dfuns) = partition (isLocalThing mod) dfuns
596 -- And add the pieces to the right places
597 (eps_inst_env', _) = extendInstEnv dflags (eps_inst_env eps) pkg_dfuns
598 eps' = eps { eps_inst_env = eps_inst_env' }
600 env' = env { tcg_insts = lcl_dfuns ++ tcg_insts env }
604 ; writeMutVar ie_var inst_env'
606 ; setGblEnv env' thing_inside }
608 tcExtendLocalInstEnv :: [InstInfo] -> TcM a -> TcM a
609 -- Special case for local instance decls
610 tcExtendLocalInstEnv infos thing_inside
611 = do { dflags <- getDOpts
613 ; let ie_var = tcg_inst_env env
614 ; inst_env <- readMutVar ie_var
616 dfuns = map iDFunId infos
617 (inst_env', errs) = extendInstEnv dflags inst_env dfuns
618 env' = env { tcg_insts = dfuns ++ tcg_insts env }
621 ; writeMutVar ie_var inst_env'
622 ; setGblEnv env' thing_inside }
625 = traceTc (text "Adding instances:" <+> vcat (map pp dfuns))
627 pp dfun = ppr dfun <+> dcolon <+> ppr (idType dfun)
631 %************************************************************************
635 %************************************************************************
638 tcExtendRules :: [RuleDecl Id] -> TcM a -> TcM a
639 -- Just pop the new rules into the EPS and envt resp
640 -- All the rules come from an interface file, not soruce
641 -- Nevertheless, some may be for this module, if we read
642 -- its interface instead of its source code
643 tcExtendRules rules thing_inside
647 (lcl_rules, pkg_rules) = partition is_local_rule rules
648 is_local_rule = isLocalThing mod . ifaceRuleDeclName
651 core_rules = [(id,rule) | IfaceRuleOut id rule <- pkg_rules]
652 eps' = eps { eps_rule_base = addIfaceRules (eps_rule_base eps) core_rules }
653 -- All the rules from an interface are of the IfaceRuleOut form
655 env' = env { tcg_rules = lcl_rules ++ tcg_rules env }
658 ; setGblEnv env' thing_inside }
660 addIfaceRules :: RuleBase -> [IdCoreRule] -> RuleBase
661 addIfaceRules rule_base rules
662 = foldl extendRuleBase rule_base rules
666 %************************************************************************
668 \subsection{The InstInfo type}
670 %************************************************************************
672 The InstInfo type summarises the information in an instance declaration
674 instance c => k (t tvs) where b
676 It is used just for *local* instance decls (not ones from interface files).
677 But local instance decls includes
680 as well as explicit user written ones.
685 iDFunId :: DFunId, -- The dfun id
686 iBinds :: InstBindings
690 = VanillaInst -- The normal case
691 RenamedMonoBinds -- Bindings
692 [RenamedSig] -- User pragmas recorded for generating
693 -- specialised instances
695 | NewTypeDerived -- Used for deriving instances of newtypes, where the
696 [Type] -- witness dictionary is identical to the argument
697 -- dictionary. Hence no bindings, no pragmas
698 -- The [Type] are the representation types
699 -- See notes in TcDeriv
701 pprInstInfo info = vcat [ptext SLIT("InstInfo:") <+> ppr (idType (iDFunId info))]
703 pprInstInfoDetails (InstInfo { iBinds = VanillaInst b _ }) = ppr b
704 pprInstInfoDetails (InstInfo { iBinds = NewTypeDerived _}) = text "Derived from the representation type"
706 simpleInstInfoTy :: InstInfo -> Type
707 simpleInstInfoTy info = case tcSplitDFunTy (idType (iDFunId info)) of
708 (_, _, _, [ty]) -> ty
710 simpleInstInfoTyCon :: InstInfo -> TyCon
711 -- Gets the type constructor for a simple instance declaration,
712 -- i.e. one of the form instance (...) => C (T a b c) where ...
713 simpleInstInfoTyCon inst = tcTyConAppTyCon (simpleInstInfoTy inst)
717 %************************************************************************
721 %************************************************************************
724 badCon con_id = quotes (ppr con_id) <+> ptext SLIT("is not a data constructor")
726 notFound wheRe name = failWithTc (text wheRe <> colon <+> quotes (ppr name) <+>
727 ptext SLIT("is not in scope"))