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.
12 emptyInstEnv, extendInstEnv,
14 classInstances, simpleDFunClassTyCon, checkFunDeps
17 #include "HsVersions.h"
19 import Class ( Class, classTvsFds )
20 import Var ( Id, isTcTyVar )
23 import TcType ( Type, tcTyConAppTyCon, tcIsTyVarTy,
24 tcSplitDFunTy, tyVarsOfTypes, isExistentialTyVar,
25 matchTys, unifyTyListsX
27 import FunDeps ( checkClsFD )
28 import TyCon ( TyCon )
30 import UniqFM ( UniqFM, lookupUFM, emptyUFM, addToUFM_C )
33 import Util ( notNull )
34 import Maybe ( isJust )
38 %************************************************************************
40 \subsection{The key types}
42 %************************************************************************
46 type InstEnv = UniqFM ClsInstEnv -- Maps Class to instances for that class
49 = ClsIE [InstEnvElt] -- The instances for a particular class, in any order
50 Bool -- True <=> there is an instance of form C a b c
51 -- If *not* then the common case of looking up
52 -- (C a b c) can fail immediately
53 -- NB: use tcIsTyVarTy: don't look through newtypes!!
55 type InstEnvElt = (TyVarSet, [Type], DFunId)
56 -- INVARIANTs: see notes below
58 emptyInstEnv :: InstEnv
59 emptyInstEnv = emptyUFM
61 classInstances :: InstEnv -> Class -> [InstEnvElt]
62 classInstances env cls = case lookupUFM env cls of
63 Just (ClsIE insts _) -> insts
66 extendInstEnv :: InstEnv -> DFunId -> InstEnv
67 extendInstEnv inst_env dfun_id
68 = addToUFM_C add inst_env clas (ClsIE [ins_item] ins_tyvar)
70 add (ClsIE cur_insts cur_tyvar) _ = ClsIE (ins_item : cur_insts)
71 (ins_tyvar || cur_tyvar)
72 (ins_tvs, _, clas, ins_tys) = tcSplitDFunTy (idType dfun_id)
73 ins_tv_set = mkVarSet ins_tvs
74 ins_item = (ins_tv_set, ins_tys, dfun_id)
75 ins_tyvar = all tcIsTyVarTy ins_tys
78 pprInstEnv :: InstEnv -> SDoc
80 = vcat [ brackets (pprWithCommas ppr (varSetElems tyvars)) <+>
81 brackets (pprWithCommas ppr tys) <+> ppr dfun
82 | ClsIE cls_inst_env _ <- eltsUFM env
83 , (tyvars, tys, dfun) <- cls_inst_env
87 simpleDFunClassTyCon :: DFunId -> (Class, TyCon)
88 simpleDFunClassTyCon dfun
91 (_,_,clas,[ty]) = tcSplitDFunTy (idType dfun)
92 tycon = tcTyConAppTyCon ty
95 %************************************************************************
97 \subsection{Instance environments: InstEnv and ClsInstEnv}
99 %************************************************************************
101 A @ClsInstEnv@ all the instances of that class. The @Id@ inside a
102 ClsInstEnv mapping is the dfun for that instance.
104 If class C maps to a list containing the item ([a,b], [t1,t2,t3], dfun), then
106 forall a b, C t1 t2 t3 can be constructed by dfun
108 or, to put it another way, we have
110 instance (...) => C t1 t2 t3, witnessed by dfun
112 There is an important consistency constraint in the elements of a ClsInstEnv:
114 * [a,b] must be a superset of the free vars of [t1,t2,t3]
116 * The dfun must itself be quantified over [a,b]
118 * More specific instances come before less specific ones,
121 Thus, the @ClassInstEnv@ for @Eq@ might contain the following entry:
122 [a] ===> dfun_Eq_List :: forall a. Eq a => Eq [a]
123 The "a" in the pattern must be one of the forall'd variables in
128 Notes on overlapping instances
129 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
130 In some ClsInstEnvs, overlap is prohibited; that is, no pair of templates unify.
132 In others, overlap is permitted, but only in such a way that one can make
133 a unique choice when looking up. That is, overlap is only permitted if
134 one template matches the other, or vice versa. So this is ok:
142 If overlap is permitted, the list is kept most specific first, so that
143 the first lookup is the right choice.
146 For now we just use association lists.
148 \subsection{Avoiding a problem with overlapping}
150 Consider this little program:
153 class C a where c :: a
154 class C a => D a where d :: a
156 instance C Int where c = 17
157 instance D Int where d = 13
159 instance C a => C [a] where c = [c]
160 instance ({- C [a], -} D a) => D [a] where d = c
162 instance C [Int] where c = [37]
164 main = print (d :: [Int])
167 What do you think `main' prints (assuming we have overlapping instances, and
168 all that turned on)? Well, the instance for `D' at type `[a]' is defined to
169 be `c' at the same type, and we've got an instance of `C' at `[Int]', so the
170 answer is `[37]', right? (the generic `C [a]' instance shouldn't apply because
171 the `C [Int]' instance is more specific).
173 Ghc-4.04 gives `[37]', while ghc-4.06 gives `[17]', so 4.06 is wrong. That
174 was easy ;-) Let's just consult hugs for good measure. Wait - if I use old
175 hugs (pre-September99), I get `[17]', and stranger yet, if I use hugs98, it
176 doesn't even compile! What's going on!?
178 What hugs complains about is the `D [a]' instance decl.
181 ERROR "mj.hs" (line 10): Cannot build superclass instance
183 *** Context supplied : D a
184 *** Required superclass : C [a]
187 You might wonder what hugs is complaining about. It's saying that you
188 need to add `C [a]' to the context of the `D [a]' instance (as appears
189 in comments). But there's that `C [a]' instance decl one line above
190 that says that I can reduce the need for a `C [a]' instance to the
191 need for a `C a' instance, and in this case, I already have the
192 necessary `C a' instance (since we have `D a' explicitly in the
193 context, and `C' is a superclass of `D').
195 Unfortunately, the above reasoning indicates a premature commitment to the
196 generic `C [a]' instance. I.e., it prematurely rules out the more specific
197 instance `C [Int]'. This is the mistake that ghc-4.06 makes. The fix is to
198 add the context that hugs suggests (uncomment the `C [a]'), effectively
199 deferring the decision about which instance to use.
201 Now, interestingly enough, 4.04 has this same bug, but it's covered up
202 in this case by a little known `optimization' that was disabled in
203 4.06. Ghc-4.04 silently inserts any missing superclass context into
204 an instance declaration. In this case, it silently inserts the `C
205 [a]', and everything happens to work out.
207 (See `basicTypes/MkId:mkDictFunId' for the code in question. Search for
208 `Mark Jones', although Mark claims no credit for the `optimization' in
209 question, and would rather it stopped being called the `Mark Jones
212 So, what's the fix? I think hugs has it right. Here's why. Let's try
213 something else out with ghc-4.04. Let's add the following line:
218 Everyone raise their hand who thinks that `d :: [Int]' should give a
219 different answer from `d' :: [Int]'. Well, in ghc-4.04, it does. The
220 `optimization' only applies to instance decls, not to regular
221 bindings, giving inconsistent behavior.
223 Old hugs had this same bug. Here's how we fixed it: like GHC, the
224 list of instances for a given class is ordered, so that more specific
225 instances come before more generic ones. For example, the instance
226 list for C might contain:
227 ..., C Int, ..., C a, ...
228 When we go to look for a `C Int' instance we'll get that one first.
229 But what if we go looking for a `C b' (`b' is unconstrained)? We'll
230 pass the `C Int' instance, and keep going. But if `b' is
231 unconstrained, then we don't know yet if the more specific instance
232 will eventually apply. GHC keeps going, and matches on the generic `C
233 a'. The fix is to, at each step, check to see if there's a reverse
234 match, and if so, abort the search. This prevents hugs from
235 prematurely chosing a generic instance when a more specific one
240 BUT NOTE [Nov 2001]: we must actually *unify* not reverse-match in
241 this test. Suppose the instance envt had
242 ..., forall a b. C a a b, ..., forall a b c. C a b c, ...
243 (still most specific first)
244 Now suppose we are looking for (C x y Int), where x and y are unconstrained.
245 C x y Int doesn't match the template {a,b} C a a b
247 C a a b match the template {x,y} C x y Int
248 But still x and y might subsequently be unified so they *do* match.
250 Simple story: unify, don't match.
253 %************************************************************************
255 \subsection{Looking up an instance}
257 %************************************************************************
259 @lookupInstEnv@ looks up in a @InstEnv@, using a one-way match. Since
260 the env is kept ordered, the first match must be the only one. The
261 thing we are looking up can have an arbitrary "flexi" part.
264 lookupInstEnv :: DynFlags
265 -> (InstEnv -- External package inst-env
266 ,InstEnv) -- Home-package inst-env
267 -> Class -> [Type] -- What we are looking for
268 -> ([(TyVarSubstEnv, InstEnvElt)], -- Successful matches
269 [Id]) -- These don't match but do unify
270 -- The second component of the tuple happens when we look up
272 -- in an InstEnv that has entries for
275 -- Then which we choose would depend on the way in which 'a'
276 -- is instantiated. So we report that Foo [b] is a match (mapping b->a)
277 -- but Foo [Int] is a unifier. This gives the caller a better chance of
278 -- giving a suitable error messagen
280 lookupInstEnv dflags (pkg_ie, home_ie) cls tys
281 | not (null all_unifs) = (all_matches, all_unifs) -- This is always an error situation,
282 -- so don't attempt to pune the matches
283 | otherwise = (pruned_matches, [])
285 all_tvs = all tcIsTyVarTy tys
286 incoherent_ok = dopt Opt_AllowIncoherentInstances dflags
287 overlap_ok = dopt Opt_AllowOverlappingInstances dflags
288 (home_matches, home_unifs) = lookup_inst_env home_ie cls tys all_tvs
289 (pkg_matches, pkg_unifs) = lookup_inst_env pkg_ie cls tys all_tvs
290 all_matches = home_matches ++ pkg_matches
291 all_unifs | incoherent_ok = [] -- Don't worry about these if incoherent is ok!
292 | otherwise = home_unifs ++ pkg_unifs
294 pruned_matches | overlap_ok = foldr insert_overlapping [] all_matches
295 | otherwise = all_matches
297 lookup_inst_env :: InstEnv -- The envt
298 -> Class -> [Type] -- What we are looking for
299 -> Bool -- All the [Type] are tyvars
300 -> ([(TyVarSubstEnv, InstEnvElt)], -- Successful matches
301 [Id]) -- These don't match but do unify
302 lookup_inst_env env key_cls key_tys key_all_tvs
303 = case lookupUFM env key_cls of
304 Nothing -> ([],[]) -- No instances for this class
305 Just (ClsIE insts has_tv_insts)
306 | key_all_tvs && not has_tv_insts -> ([],[]) -- Short cut for common case
307 -- The thing we are looking up is of form (C a b c), and
308 -- the ClsIE has no instances of that form, so don't bother to search
309 | otherwise -> find insts [] []
311 key_vars = filterVarSet not_existential (tyVarsOfTypes key_tys)
312 not_existential tv = not (isTcTyVar tv && isExistentialTyVar tv)
313 -- The key_tys can contain skolem constants, and we can guarantee that those
314 -- are never going to be instantiated to anything, so we should not involve
315 -- them in the unification test. Example:
316 -- class Foo a where { op :: a -> Int }
317 -- instance Foo a => Foo [a] -- NB overlap
318 -- instance Foo [Int] -- NB overlap
319 -- data T = forall a. Foo a => MkT a
321 -- f (MkT x) = op [x,x]
322 -- The op [x,x] means we need (Foo [a]). Without the filterVarSet we'd
323 -- complain, saying that the choice of instance depended on the instantiation
324 -- of 'a'; but of course it isn't *going* to be instantiated.
326 find [] ms us = (ms, us)
327 find (item@(tpl_tyvars, tpl, dfun_id) : rest) ms us
328 = case matchTys tpl_tyvars tpl key_tys of
329 Just (subst, leftovers) -> ASSERT( null leftovers )
330 find rest ((subst,item):ms) us
332 -- Does not match, so next check whether the things unify
333 -- [see notes about overlapping instances above]
334 -> ASSERT( not (key_vars `intersectsVarSet` tpl_tyvars) )
335 -- Unification will break badly if the variables overlap
336 -- They shouldn't because we allocate separate uniques for them
337 case unifyTyListsX (key_vars `unionVarSet` tpl_tyvars) key_tys tpl of
338 Just _ -> find rest ms (dfun_id:us)
339 Nothing -> find rest ms us
341 insert_overlapping :: (TyVarSubstEnv, InstEnvElt) -> [(TyVarSubstEnv, InstEnvElt)]
342 -> [(TyVarSubstEnv, InstEnvElt)]
343 -- Add a new solution, knocking out strictly less specific ones
344 insert_overlapping new_item [] = [new_item]
345 insert_overlapping new_item (item:items)
346 | new_beats_old && old_beats_new = item : insert_overlapping new_item items
347 -- Duplicate => keep both for error report
348 | new_beats_old = insert_overlapping new_item items
350 | old_beats_new = item : items
352 | otherwise = item : insert_overlapping new_item items
355 new_beats_old = new_item `beats` item
356 old_beats_new = item `beats` new_item
358 (_, (tvs1, tys1, _)) `beats` (_, (tvs2, tys2, _))
359 = isJust (matchTys tvs2 tys2 tys1) -- A beats B if A is more specific than B
360 -- I.e. if B can be instantiated to match A
364 %************************************************************************
366 Functional dependencies
368 %************************************************************************
370 Here is the bad case:
371 class C a b | a->b where ...
372 instance C Int Bool where ...
373 instance C Int Char where ...
375 The point is that a->b, so Int in the first parameter must uniquely
376 determine the second. In general, given the same class decl, and given
378 instance C s1 s2 where ...
379 instance C t1 t2 where ...
381 Then the criterion is: if U=unify(s1,t1) then U(s2) = U(t2).
383 Matters are a little more complicated if there are free variables in
386 class D a b c | a -> b
387 instance D a b => D [(a,a)] [b] Int
388 instance D a b => D [a] [b] Bool
390 The instance decls don't overlap, because the third parameter keeps
391 them separate. But we want to make sure that given any constraint
397 checkFunDeps :: (InstEnv, InstEnv) -> DFunId
398 -> Maybe [DFunId] -- Nothing <=> ok
399 -- Just dfs <=> conflict with dfs
400 -- Check wheher adding DFunId would break functional-dependency constraints
401 checkFunDeps (pkg_ie, home_ie) dfun
402 | null bad_fundeps = Nothing
403 | otherwise = Just bad_fundeps
405 (ins_tvs, _, clas, ins_tys) = tcSplitDFunTy (idType dfun)
406 ins_tv_set = mkVarSet ins_tvs
407 cls_inst_env = classInstances home_ie clas ++ classInstances pkg_ie clas
408 bad_fundeps = badFunDeps cls_inst_env clas ins_tv_set ins_tys
410 badFunDeps :: [InstEnvElt] -> Class
411 -> TyVarSet -> [Type] -- Proposed new instance type
413 badFunDeps cls_inst_env clas ins_tv_set ins_tys
414 = [ dfun_id | fd <- fds,
415 (tvs, tys, dfun_id) <- cls_inst_env,
416 notNull (checkClsFD (tvs `unionVarSet` ins_tv_set) fd clas_tvs tys ins_tys)
419 (clas_tvs, fds) = classTvsFds clas