2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[TcInstUtil]{Utilities for typechecking instance declarations}
6 The bits common to TcInstDcls and TcDeriv.
12 instInfoClass, simpleInstInfoTy, simpleInstInfoTyCon, classDataCon,
16 #include "HsVersions.h"
18 import RnHsSyn ( RenamedMonoBinds, RenamedSig )
19 import HsTypes ( toHsType )
21 import CmdLineOpts ( opt_AllowOverlappingInstances )
23 import TcEnv ( InstEnv, emptyInstEnv, addToInstEnv )
24 import Bag ( bagToList, Bag )
25 import Class ( Class )
26 import Var ( TyVar, Id, idName )
27 import Maybes ( MaybeErr(..) )
28 import Name ( getSrcLoc, nameModule, isLocallyDefined, toRdrName )
29 import SrcLoc ( SrcLoc )
30 import Type ( Type, ThetaType, splitTyConApp_maybe, mkSigmaTy, mkDictTy )
31 import PprType ( pprConstraint )
32 import Class ( classTyCon )
33 import DataCon ( DataCon )
34 import TyCon ( TyCon, tyConDataCons )
38 instance c => k (t tvs) where b
44 [TyVar] -- Type variables, tvs
45 [Type] -- The types at which the class is being instantiated
46 ThetaType -- inst_decl_theta: the original context, c, from the
47 -- instance declaration. It constrains (some of)
50 RenamedMonoBinds -- Bindings, b
51 SrcLoc -- Source location assoc'd with this instance's defn
52 [RenamedSig] -- User pragmas recorded for generating specialised instances
54 pprInstInfo (InstInfo clas tvs tys inst_decl_theta _ mbinds _ _)
55 = vcat [ptext SLIT("InstInfo:") <+> ppr (mkSigmaTy tvs inst_decl_theta (mkDictTy clas tys)),
58 instInfoClass :: InstInfo -> Class
59 instInfoClass (InstInfo clas _ _ _ _ _ _ _) = clas
61 simpleInstInfoTy :: InstInfo -> Type
62 simpleInstInfoTy (InstInfo _ _ [ty] _ _ _ _ _) = ty
64 simpleInstInfoTyCon :: InstInfo -> TyCon
65 -- Gets the type constructor for a simple instance declaration,
66 -- i.e. one of the form instance (...) => C (T a b c) where ...
67 simpleInstInfoTyCon inst
68 = case splitTyConApp_maybe (simpleInstInfoTy inst) of
69 Just (tycon, _) -> tycon
73 %************************************************************************
75 \subsection{Creating instance related Ids}
77 %************************************************************************
79 A tiny function which doesn't belong anywhere else.
80 It makes a nasty mutual-recursion knot if you put it in Class.
83 classDataCon :: Class -> DataCon
84 classDataCon clas = case tyConDataCons (classTyCon clas) of
85 (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr
88 %************************************************************************
90 \subsection{Converting instance info into suitable InstEnvs}
92 %************************************************************************
95 buildInstanceEnv :: Bag InstInfo -> NF_TcM InstEnv
97 buildInstanceEnv info = --pprTrace "BuildInstanceEnv" (ppr info)
98 foldrNF_Tc addClassInstance emptyInstEnv (bagToList info)
101 @addClassInstance@ adds the appropriate stuff to the @ClassInstEnv@
102 based on information from a single instance declaration. It complains
103 about any overlap with an existing instance.
112 (InstInfo clas inst_tyvars inst_tys _
115 = -- Add the instance to the class's instance environment
116 case addToInstEnv opt_AllowOverlappingInstances
117 inst_env clas inst_tyvars inst_tys dfun_id of
118 Failed (tys', dfun_id') -> addErrTc (dupInstErr clas (inst_tys, dfun_id)
123 Succeeded inst_env' -> returnNF_Tc inst_env'
127 dupInstErr clas info1@(tys1, dfun1) info2@(tys2, dfun2)
128 -- Overlapping/duplicate instances for given class; msg could be more glamourous
129 = hang (ptext SLIT("Duplicate or overlapping instance declarations"))
130 4 (sep [ptext SLIT("for") <+> quotes (pprConstraint clas tys1),
131 nest 4 (sep [ppr_loc dfun1, ptext SLIT("and") <+> ppr_loc dfun2])])
134 | isLocallyDefined dfun = ptext SLIT("defined at") <+> ppr (getSrcLoc dfun)
135 | otherwise = ptext SLIT("imported from module") <+> quotes (ppr (nameModule (idName dfun)))