2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[InstEnv]{Utilities for typechecking instance declarations}
6 The bits common to TcInstDcls and TcDeriv.
10 DFunId, ClsInstEnv, InstEnv,
12 emptyInstEnv, extendInstEnv,
13 lookupInstEnv, InstLookupResult(..),
14 classInstEnv, simpleDFunClassTyCon
17 #include "HsVersions.h"
19 import Class ( Class )
21 import VarSet ( TyVarSet, unionVarSet, mkVarSet )
22 import VarEnv ( TyVarSubstEnv )
23 import Maybes ( MaybeErr(..), returnMaB, failMaB, thenMaB, maybeToBool )
24 import Name ( getSrcLoc )
25 import Type ( Type, splitTyConApp_maybe,
26 splitSigmaTy, splitDFunTy, tyVarsOfTypes
29 import TyCon ( TyCon )
31 import Unify ( matchTys, unifyTyListsX )
32 import UniqFM ( UniqFM, lookupWithDefaultUFM, addToUFM, emptyUFM )
34 import ErrUtils ( Message )
39 %************************************************************************
41 \subsection{The key types}
43 %************************************************************************
48 type InstEnv = UniqFM ClsInstEnv -- Maps Class to instances for that class
50 type ClsInstEnv = [(TyVarSet, [Type], DFunId)] -- The instances for a particular class
52 simpleDFunClassTyCon :: DFunId -> (Class, TyCon)
53 simpleDFunClassTyCon dfun
56 (_,_,clas,[ty]) = splitDFunTy (idType dfun)
57 tycon = case splitTyConApp_maybe ty of
58 Just (tycon,_) -> tycon
61 %************************************************************************
63 \subsection{Instance environments: InstEnv and ClsInstEnv}
65 %************************************************************************
67 The actual type declarations are in HscTypes.
70 emptyInstEnv :: InstEnv
71 emptyInstEnv = emptyUFM
73 classInstEnv :: InstEnv -> Class -> ClsInstEnv
74 classInstEnv env cls = lookupWithDefaultUFM env [] cls
77 A @ClsInstEnv@ lives inside a class, and identifies all the instances
78 of that class. The @Id@ inside a ClsInstEnv mapping is the dfun for
81 If class C maps to a list containing the item ([a,b], [t1,t2,t3], dfun), then
83 forall a b, C t1 t2 t3 can be constructed by dfun
85 or, to put it another way, we have
87 instance (...) => C t1 t2 t3, witnessed by dfun
89 There is an important consistency constraint in the elements of a ClsInstEnv:
91 * [a,b] must be a superset of the free vars of [t1,t2,t3]
93 * The dfun must itself be quantified over [a,b]
95 Thus, the @ClassInstEnv@ for @Eq@ might contain the following entry:
96 [a] ===> dfun_Eq_List :: forall a. Eq a => Eq [a]
97 The "a" in the pattern must be one of the forall'd variables in
102 Notes on overlapping instances
103 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
104 In some ClsInstEnvs, overlap is prohibited; that is, no pair of templates unify.
106 In others, overlap is permitted, but only in such a way that one can make
107 a unique choice when looking up. That is, overlap is only permitted if
108 one template matches the other, or vice versa. So this is ok:
116 If overlap is permitted, the list is kept most specific first, so that
117 the first lookup is the right choice.
120 For now we just use association lists.
122 \subsection{Avoiding a problem with overlapping}
124 Consider this little program:
127 class C a where c :: a
128 class C a => D a where d :: a
130 instance C Int where c = 17
131 instance D Int where d = 13
133 instance C a => C [a] where c = [c]
134 instance ({- C [a], -} D a) => D [a] where d = c
136 instance C [Int] where c = [37]
138 main = print (d :: [Int])
141 What do you think `main' prints (assuming we have overlapping instances, and
142 all that turned on)? Well, the instance for `D' at type `[a]' is defined to
143 be `c' at the same type, and we've got an instance of `C' at `[Int]', so the
144 answer is `[37]', right? (the generic `C [a]' instance shouldn't apply because
145 the `C [Int]' instance is more specific).
147 Ghc-4.04 gives `[37]', while ghc-4.06 gives `[17]', so 4.06 is wrong. That
148 was easy ;-) Let's just consult hugs for good measure. Wait - if I use old
149 hugs (pre-September99), I get `[17]', and stranger yet, if I use hugs98, it
150 doesn't even compile! What's going on!?
152 What hugs complains about is the `D [a]' instance decl.
155 ERROR "mj.hs" (line 10): Cannot build superclass instance
157 *** Context supplied : D a
158 *** Required superclass : C [a]
161 You might wonder what hugs is complaining about. It's saying that you
162 need to add `C [a]' to the context of the `D [a]' instance (as appears
163 in comments). But there's that `C [a]' instance decl one line above
164 that says that I can reduce the need for a `C [a]' instance to the
165 need for a `C a' instance, and in this case, I already have the
166 necessary `C a' instance (since we have `D a' explicitly in the
167 context, and `C' is a superclass of `D').
169 Unfortunately, the above reasoning indicates a premature commitment to the
170 generic `C [a]' instance. I.e., it prematurely rules out the more specific
171 instance `C [Int]'. This is the mistake that ghc-4.06 makes. The fix is to
172 add the context that hugs suggests (uncomment the `C [a]'), effectively
173 deferring the decision about which instance to use.
175 Now, interestingly enough, 4.04 has this same bug, but it's covered up
176 in this case by a little known `optimization' that was disabled in
177 4.06. Ghc-4.04 silently inserts any missing superclass context into
178 an instance declaration. In this case, it silently inserts the `C
179 [a]', and everything happens to work out.
181 (See `basicTypes/MkId:mkDictFunId' for the code in question. Search for
182 `Mark Jones', although Mark claims no credit for the `optimization' in
183 question, and would rather it stopped being called the `Mark Jones
186 So, what's the fix? I think hugs has it right. Here's why. Let's try
187 something else out with ghc-4.04. Let's add the following line:
192 Everyone raise their hand who thinks that `d :: [Int]' should give a
193 different answer from `d' :: [Int]'. Well, in ghc-4.04, it does. The
194 `optimization' only applies to instance decls, not to regular
195 bindings, giving inconsistent behavior.
197 Old hugs had this same bug. Here's how we fixed it: like GHC, the
198 list of instances for a given class is ordered, so that more specific
199 instances come before more generic ones. For example, the instance
200 list for C might contain:
201 ..., C Int, ..., C a, ...
202 When we go to look for a `C Int' instance we'll get that one first.
203 But what if we go looking for a `C b' (`b' is unconstrained)? We'll
204 pass the `C Int' instance, and keep going. But if `b' is
205 unconstrained, then we don't know yet if the more specific instance
206 will eventually apply. GHC keeps going, and matches on the generic `C
207 a'. The fix is to, at each step, check to see if there's a reverse
208 match, and if so, abort the search. This prevents hugs from
209 prematurely chosing a generic instance when a more specific one
215 @lookupInstEnv@ looks up in a @InstEnv@, using a one-way match. Since
216 the env is kept ordered, the first match must be the only one. The
217 thing we are looking up can have an arbitrary "flexi" part.
220 lookupInstEnv :: InstEnv -- The envt
221 -> Class -> [Type] -- Key
224 data InstLookupResult
225 = FoundInst -- There is a (template,substitution) pair
226 -- that makes the template match the key,
227 -- and no template is an instance of the key
230 | NoMatch Bool -- Boolean is true iff there is at least one
231 -- template that matches the key.
232 -- (but there are other template(s) that are
233 -- instances of the key, so we don't report
235 -- The NoMatch True case happens when we look up
237 -- in an InstEnv that has entries for
240 -- Then which we choose would depend on the way in which 'a'
241 -- is instantiated. So we say there is no match, but identify
242 -- it as ambiguous case in the hope of giving a better error msg.
243 -- See the notes above from Jeff Lewis
245 lookupInstEnv env key_cls key_tys
246 = find (classInstEnv env key_cls)
248 key_vars = tyVarsOfTypes key_tys
250 find [] = NoMatch False
251 find ((tpl_tyvars, tpl, val) : rest)
252 = case matchTys tpl_tyvars tpl key_tys of
254 case matchTys key_vars key_tys tpl of
256 Just (_, _) -> NoMatch (any_match rest)
257 Just (subst, leftovers) -> ASSERT( null leftovers )
260 any_match rest = or [ maybeToBool (matchTys tvs tpl key_tys)
261 | (tvs,tpl,_) <- rest
265 @addToClsInstEnv@ extends a @ClsInstEnv@, checking for overlaps.
267 A boolean flag controls overlap reporting.
269 True => overlap is permitted, but only if one template matches the other;
270 not if they unify but neither is
273 extendInstEnv :: DynFlags -> InstEnv -> [DFunId] -> (InstEnv, [Message])
274 -- Similar, but all we have is the DFuns
275 extendInstEnv dflags env infos
278 go env msgs [] = (env, msgs)
279 go env msgs (dfun:dfuns) = case addToInstEnv dflags env dfun of
280 Succeeded new_env -> go new_env msgs dfuns
281 Failed dfun' -> go env (msg:msgs) dfuns
283 msg = dupInstErr dfun dfun'
286 dupInstErr dfun1 dfun2
287 -- Overlapping/duplicate instances for given class; msg could be more glamourous
288 = hang (ptext SLIT("Duplicate or overlapping instance declarations:"))
289 2 (ppr_dfun dfun1 $$ ppr_dfun dfun2)
291 ppr_dfun dfun = ppr (getSrcLoc dfun) <> colon <+> ppr tau
293 (_,_,tau) = splitSigmaTy (idType dfun)
295 addToInstEnv :: DynFlags
297 -> MaybeErr InstEnv -- Success...
298 DFunId -- Failure: Offending overlap
300 addToInstEnv dflags inst_env dfun_id
301 = case insert_into (classInstEnv inst_env clas) of
302 Failed stuff -> Failed stuff
303 Succeeded new_env -> Succeeded (addToUFM inst_env clas new_env)
306 (ins_tvs, _, clas, ins_tys) = splitDFunTy (idType dfun_id)
308 ins_tv_set = mkVarSet ins_tvs
309 ins_item = (ins_tv_set, ins_tys, dfun_id)
311 insert_into [] = returnMaB [ins_item]
312 insert_into env@(cur_item@(tpl_tvs, tpl_tys, val) : rest)
315 -- (a) they are the same, or
316 -- (b) they unify, and any sort of overlap is prohibited,
317 -- (c) they unify but neither is more specific than t'other
319 || (unifiable && not (dopt Opt_AllowOverlappingInstances dflags))
320 || (unifiable && not (ins_item_more_specific || cur_item_more_specific))
323 -- New item is an instance of current item, so drop it here
324 | ins_item_more_specific = returnMaB (ins_item : env)
326 -- Otherwise carry on
327 | otherwise = insert_into rest `thenMaB` \ rest' ->
328 returnMaB (cur_item : rest')
330 unifiable = maybeToBool (unifyTyListsX (ins_tv_set `unionVarSet` tpl_tvs) tpl_tys ins_tys)
331 ins_item_more_specific = maybeToBool (matchTys tpl_tvs tpl_tys ins_tys)
332 cur_item_more_specific = maybeToBool (matchTys ins_tv_set ins_tys tpl_tys)
333 identical = ins_item_more_specific && cur_item_more_specific