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.
10 InstInfo(..), pprInstInfo,
11 simpleInstInfoTy, simpleInstInfoTyCon, simpleDFunClassTyCon,
13 -- Instance environment
14 InstEnv, emptyInstEnv, extendInstEnv,
15 lookupInstEnv, InstLookupResult(..),
16 classInstEnv, classDataCon,
21 #include "HsVersions.h"
23 import RnHsSyn ( RenamedMonoBinds, RenamedSig )
25 import HscTypes ( InstEnv, ClsInstEnv, DFunId )
26 import Class ( Class )
27 import Var ( TyVar, Id )
28 import VarSet ( unionVarSet, mkVarSet )
29 import VarEnv ( TyVarSubstEnv )
30 import Maybes ( MaybeErr(..), returnMaB, failMaB, thenMaB, maybeToBool )
31 import Name ( getSrcLoc )
32 import SrcLoc ( SrcLoc )
33 import Type ( Type, ThetaType, splitTyConApp_maybe,
34 splitSigmaTy, splitDictTy,
37 import Class ( classTyCon )
38 import DataCon ( DataCon )
39 import TyCon ( TyCon, tyConDataCons )
41 import Unify ( matchTys, unifyTyListsX )
42 import UniqFM ( lookupWithDefaultUFM, addToUFM, emptyUFM )
44 import ErrUtils ( Message )
50 %************************************************************************
52 \subsection{The InstInfo type}
54 %************************************************************************
56 The InstInfo type summarises the information in an instance declaration
58 instance c => k (t tvs) where b
63 iClass :: Class, -- Class, k
64 iTyVars :: [TyVar], -- Type variables, tvs
65 iTys :: [Type], -- The types at which the class is being instantiated
66 iTheta :: ThetaType, -- inst_decl_theta: the original context, c, from the
67 -- instance declaration. It constrains (some of)
69 iLocal :: Bool, -- True <=> it's defined in this module
70 iDFunId :: DFunId, -- The dfun id
71 iBinds :: RenamedMonoBinds, -- Bindings, b
72 iLoc :: SrcLoc, -- Source location assoc'd with this instance's defn
73 iPrags :: [RenamedSig] -- User pragmas recorded for generating specialised instances
76 pprInstInfo info = vcat [ptext SLIT("InstInfo:") <+> ppr (idType (iDFunId info)),
77 nest 4 (ppr (iBinds info))]
79 simpleInstInfoTy :: InstInfo -> Type
80 simpleInstInfoTy (InstInfo {iTys = [ty]}) = ty
82 simpleInstInfoTyCon :: InstInfo -> TyCon
83 -- Gets the type constructor for a simple instance declaration,
84 -- i.e. one of the form instance (...) => C (T a b c) where ...
85 simpleInstInfoTyCon inst
86 = case splitTyConApp_maybe (simpleInstInfoTy inst) of
87 Just (tycon, _) -> tycon
89 isLocalInst :: InstInfo -> Bool
90 isLocalInst info = iLocal info
94 A tiny function which doesn't belong anywhere else.
95 It makes a nasty mutual-recursion knot if you put it in Class.
98 simpleDFunClassTyCon :: DFunId -> (Class, TyCon)
99 simpleDFunClassTyCon dfun
102 (_,_,dict_ty) = splitSigmaTy (idType dfun)
103 (clas, [ty]) = splitDictTy dict_ty
104 tycon = case splitTyConApp_maybe ty of
105 Just (tycon,_) -> tycon
107 classDataCon :: Class -> DataCon
108 classDataCon clas = case tyConDataCons (classTyCon clas) of
109 (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr
112 %************************************************************************
114 \subsection{Instance environments: InstEnv and ClsInstEnv}
116 %************************************************************************
118 The actual type declarations are in HscTypes.
121 emptyInstEnv :: InstEnv
122 emptyInstEnv = emptyUFM
124 classInstEnv :: InstEnv -> Class -> ClsInstEnv
125 classInstEnv env cls = lookupWithDefaultUFM env [] cls
128 A @ClsInstEnv@ lives inside a class, and identifies all the instances
129 of that class. The @Id@ inside a ClsInstEnv mapping is the dfun for
132 If class C maps to a list containing the item ([a,b], [t1,t2,t3], dfun), then
134 forall a b, C t1 t2 t3 can be constructed by dfun
136 or, to put it another way, we have
138 instance (...) => C t1 t2 t3, witnessed by dfun
140 There is an important consistency constraint in the elements of a ClsInstEnv:
142 * [a,b] must be a superset of the free vars of [t1,t2,t3]
144 * The dfun must itself be quantified over [a,b]
146 Thus, the @ClassInstEnv@ for @Eq@ might contain the following entry:
147 [a] ===> dfun_Eq_List :: forall a. Eq a => Eq [a]
148 The "a" in the pattern must be one of the forall'd variables in
153 Notes on overlapping instances
154 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
155 In some ClsInstEnvs, overlap is prohibited; that is, no pair of templates unify.
157 In others, overlap is permitted, but only in such a way that one can make
158 a unique choice when looking up. That is, overlap is only permitted if
159 one template matches the other, or vice versa. So this is ok:
167 If overlap is permitted, the list is kept most specific first, so that
168 the first lookup is the right choice.
171 For now we just use association lists.
173 \subsection{Avoiding a problem with overlapping}
175 Consider this little program:
178 class C a where c :: a
179 class C a => D a where d :: a
181 instance C Int where c = 17
182 instance D Int where d = 13
184 instance C a => C [a] where c = [c]
185 instance ({- C [a], -} D a) => D [a] where d = c
187 instance C [Int] where c = [37]
189 main = print (d :: [Int])
192 What do you think `main' prints (assuming we have overlapping instances, and
193 all that turned on)? Well, the instance for `D' at type `[a]' is defined to
194 be `c' at the same type, and we've got an instance of `C' at `[Int]', so the
195 answer is `[37]', right? (the generic `C [a]' instance shouldn't apply because
196 the `C [Int]' instance is more specific).
198 Ghc-4.04 gives `[37]', while ghc-4.06 gives `[17]', so 4.06 is wrong. That
199 was easy ;-) Let's just consult hugs for good measure. Wait - if I use old
200 hugs (pre-September99), I get `[17]', and stranger yet, if I use hugs98, it
201 doesn't even compile! What's going on!?
203 What hugs complains about is the `D [a]' instance decl.
206 ERROR "mj.hs" (line 10): Cannot build superclass instance
208 *** Context supplied : D a
209 *** Required superclass : C [a]
212 You might wonder what hugs is complaining about. It's saying that you
213 need to add `C [a]' to the context of the `D [a]' instance (as appears
214 in comments). But there's that `C [a]' instance decl one line above
215 that says that I can reduce the need for a `C [a]' instance to the
216 need for a `C a' instance, and in this case, I already have the
217 necessary `C a' instance (since we have `D a' explicitly in the
218 context, and `C' is a superclass of `D').
220 Unfortunately, the above reasoning indicates a premature commitment to the
221 generic `C [a]' instance. I.e., it prematurely rules out the more specific
222 instance `C [Int]'. This is the mistake that ghc-4.06 makes. The fix is to
223 add the context that hugs suggests (uncomment the `C [a]'), effectively
224 deferring the decision about which instance to use.
226 Now, interestingly enough, 4.04 has this same bug, but it's covered up
227 in this case by a little known `optimization' that was disabled in
228 4.06. Ghc-4.04 silently inserts any missing superclass context into
229 an instance declaration. In this case, it silently inserts the `C
230 [a]', and everything happens to work out.
232 (See `basicTypes/MkId:mkDictFunId' for the code in question. Search for
233 `Mark Jones', although Mark claims no credit for the `optimization' in
234 question, and would rather it stopped being called the `Mark Jones
237 So, what's the fix? I think hugs has it right. Here's why. Let's try
238 something else out with ghc-4.04. Let's add the following line:
243 Everyone raise their hand who thinks that `d :: [Int]' should give a
244 different answer from `d' :: [Int]'. Well, in ghc-4.04, it does. The
245 `optimization' only applies to instance decls, not to regular
246 bindings, giving inconsistent behavior.
248 Old hugs had this same bug. Here's how we fixed it: like GHC, the
249 list of instances for a given class is ordered, so that more specific
250 instances come before more generic ones. For example, the instance
251 list for C might contain:
252 ..., C Int, ..., C a, ...
253 When we go to look for a `C Int' instance we'll get that one first.
254 But what if we go looking for a `C b' (`b' is unconstrained)? We'll
255 pass the `C Int' instance, and keep going. But if `b' is
256 unconstrained, then we don't know yet if the more specific instance
257 will eventually apply. GHC keeps going, and matches on the generic `C
258 a'. The fix is to, at each step, check to see if there's a reverse
259 match, and if so, abort the search. This prevents hugs from
260 prematurely chosing a generic instance when a more specific one
266 @lookupInstEnv@ looks up in a @InstEnv@, using a one-way match. Since
267 the env is kept ordered, the first match must be the only one. The
268 thing we are looking up can have an arbitrary "flexi" part.
271 lookupInstEnv :: InstEnv -- The envt
272 -> Class -> [Type] -- Key
275 data InstLookupResult
276 = FoundInst -- There is a (template,substitution) pair
277 -- that makes the template match the key,
278 -- and no template is an instance of the key
281 | NoMatch Bool -- Boolean is true iff there is at least one
282 -- template that matches the key.
283 -- (but there are other template(s) that are
284 -- instances of the key, so we don't report
286 -- The NoMatch True case happens when we look up
288 -- in an InstEnv that has entries for
291 -- Then which we choose would depend on the way in which 'a'
292 -- is instantiated. So we say there is no match, but identify
293 -- it as ambiguous case in the hope of giving a better error msg.
294 -- See the notes above from Jeff Lewis
296 lookupInstEnv env key_cls key_tys
297 = find (classInstEnv env key_cls)
299 key_vars = tyVarsOfTypes key_tys
301 find [] = NoMatch False
302 find ((tpl_tyvars, tpl, val) : rest)
303 = case matchTys tpl_tyvars tpl key_tys of
305 case matchTys key_vars key_tys tpl of
307 Just (_, _) -> NoMatch (any_match rest)
308 Just (subst, leftovers) -> ASSERT( null leftovers )
311 any_match rest = or [ maybeToBool (matchTys tvs tpl key_tys)
312 | (tvs,tpl,_) <- rest
316 @addToClsInstEnv@ extends a @ClsInstEnv@, checking for overlaps.
318 A boolean flag controls overlap reporting.
320 True => overlap is permitted, but only if one template matches the other;
321 not if they unify but neither is
324 extendInstEnv :: DynFlags -> InstEnv -> [DFunId] -> (InstEnv, [Message])
325 -- Similar, but all we have is the DFuns
326 extendInstEnv dflags env infos
329 go env msgs [] = (env, msgs)
330 go env msgs (dfun:dfuns) = case addToInstEnv dflags env dfun of
331 Succeeded new_env -> go new_env msgs dfuns
332 Failed dfun' -> go env (msg:msgs) infos
334 msg = dupInstErr dfun dfun'
337 dupInstErr dfun1 dfun2
338 -- Overlapping/duplicate instances for given class; msg could be more glamourous
339 = hang (ptext SLIT("Duplicate or overlapping instance declarations:"))
340 2 (ppr_dfun dfun1 $$ ppr_dfun dfun2)
342 ppr_dfun dfun = ppr (getSrcLoc dfun) <> colon <+> ppr tau
344 (_,_,tau) = splitSigmaTy (idType dfun)
346 addToInstEnv :: DynFlags
348 -> MaybeErr InstEnv -- Success...
349 DFunId -- Failure: Offending overlap
351 addToInstEnv dflags inst_env dfun_id
352 = case insert_into (classInstEnv inst_env clas) of
353 Failed stuff -> Failed stuff
354 Succeeded new_env -> Succeeded (addToUFM inst_env clas new_env)
357 (ins_tvs, _, dict_ty) = splitSigmaTy (idType dfun_id)
358 (clas, ins_tys) = splitDictTy dict_ty
360 ins_tv_set = mkVarSet ins_tvs
361 ins_item = (ins_tv_set, ins_tys, dfun_id)
363 insert_into [] = returnMaB [ins_item]
364 insert_into env@(cur_item@(tpl_tvs, tpl_tys, val) : rest)
367 -- (a) they are the same, or
368 -- (b) they unify, and any sort of overlap is prohibited,
369 -- (c) they unify but neither is more specific than t'other
371 || (unifiable && not (dopt Opt_AllowOverlappingInstances dflags))
372 || (unifiable && not (ins_item_more_specific || cur_item_more_specific))
375 -- New item is an instance of current item, so drop it here
376 | ins_item_more_specific = returnMaB (ins_item : env)
378 -- Otherwise carry on
379 | otherwise = insert_into rest `thenMaB` \ rest' ->
380 returnMaB (cur_item : rest')
382 unifiable = maybeToBool (unifyTyListsX (ins_tv_set `unionVarSet` tpl_tvs) tpl_tys ins_tys)
383 ins_item_more_specific = maybeToBool (matchTys tpl_tvs tpl_tys ins_tys)
384 cur_item_more_specific = maybeToBool (matchTys ins_tv_set ins_tys tpl_tys)
385 identical = ins_item_more_specific && cur_item_more_specific