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.
15 #include "HsVersions.h"
17 import RnHsSyn ( RenamedMonoBinds, RenamedSig )
19 import CmdLineOpts ( opt_AllowOverlappingInstances )
21 import Inst ( InstanceMapper )
23 import Bag ( bagToList, Bag )
24 import Class ( Class )
25 import Var ( TyVar, Id, idName )
26 import InstEnv ( InstEnv, emptyInstEnv, addToInstEnv )
27 import Maybes ( MaybeErr(..), mkLookupFunDef )
28 import Name ( getSrcLoc, nameModule, isLocallyDefined )
29 import SrcLoc ( SrcLoc )
30 import Type ( ThetaType, Type, ClassContext )
31 import PprType ( pprConstraint )
32 import Class ( classTyCon )
33 import DataCon ( DataCon )
34 import TyCon ( tyConDataCons )
35 import Unique ( Unique, getUnique )
36 import Util ( equivClassesByUniq )
40 instance c => k (t tvs) where b
46 [TyVar] -- Type variables, tvs
47 [Type] -- The types at which the class is being instantiated
48 ClassContext -- inst_decl_theta: the original context, c, from the
49 -- instance declaration. It constrains (some of)
52 RenamedMonoBinds -- Bindings, b
53 SrcLoc -- Source location assoc'd with this instance's defn
54 [RenamedSig] -- User pragmas recorded for generating specialised instances
58 %************************************************************************
60 \subsection{Creating instance related Ids}
62 %************************************************************************
64 A tiny function which doesn't belong anywhere else.
65 It makes a nasty mutual-recursion knot if you put it in Class.
68 classDataCon :: Class -> DataCon
69 classDataCon clas = case tyConDataCons (classTyCon clas) of
70 (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr
73 %************************************************************************
75 \subsection{Converting instance info into suitable InstEnvs}
77 %************************************************************************
80 buildInstanceEnvs :: Bag InstInfo
81 -> NF_TcM s InstanceMapper
83 buildInstanceEnvs info
85 i_uniq :: InstInfo -> Unique
86 i_uniq (InstInfo c _ _ _ _ _ _ _) = getUnique c
88 info_by_class = equivClassesByUniq i_uniq (bagToList info)
90 mapNF_Tc buildInstanceEnv info_by_class `thenNF_Tc` \ inst_env_entries ->
92 class_lookup_fn = mkLookupFunDef (==) inst_env_entries emptyInstEnv
94 returnNF_Tc class_lookup_fn
98 buildInstanceEnv :: [InstInfo] -- Non-empty, and all for same class
99 -> NF_TcM s (Class, InstEnv)
101 buildInstanceEnv inst_infos@((InstInfo clas _ _ _ _ _ _ _) : _)
102 = foldrNF_Tc addClassInstance
104 inst_infos `thenNF_Tc` \ class_inst_env ->
105 returnNF_Tc (clas, class_inst_env)
108 @addClassInstance@ adds the appropriate stuff to the @ClassInstEnv@
109 based on information from a single instance declaration. It complains
110 about any overlap with an existing instance.
119 (InstInfo clas inst_tyvars inst_tys _
122 = -- Add the instance to the class's instance environment
123 case addToInstEnv opt_AllowOverlappingInstances
124 class_inst_env inst_tyvars inst_tys dfun_id of
125 Failed (tys', dfun_id') -> addErrTc (dupInstErr clas (inst_tys, dfun_id)
128 returnNF_Tc class_inst_env
130 Succeeded class_inst_env' -> returnNF_Tc class_inst_env'
134 dupInstErr clas info1@(tys1, dfun1) info2@(tys2, dfun2)
135 -- Overlapping/duplicate instances for given class; msg could be more glamourous
136 = hang (ptext SLIT("Duplicate or overlapping instance declarations"))
137 4 (sep [ptext SLIT("for") <+> quotes (pprConstraint clas tys1),
138 nest 4 (sep [ppr_loc dfun1, ptext SLIT("and") <+> ppr_loc dfun2])])
141 | isLocallyDefined dfun = ptext SLIT("defined at") <+> ppr (getSrcLoc dfun)
142 | otherwise = ptext SLIT("imported from module") <+> quotes (ppr (nameModule (idName dfun)))