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 -- Instance environment
11 InstEnv, emptyInstEnv, extendInstEnv,
12 lookupInstEnv, InstLookupResult(..),
13 classInstEnv, classDataCon, simpleDFunClassTyCon
16 #include "HsVersions.h"
18 import HscTypes ( InstEnv, ClsInstEnv, DFunId )
19 import Class ( Class )
21 import VarSet ( 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 Class ( classTyCon )
30 import DataCon ( DataCon )
31 import TyCon ( TyCon, tyConDataCons )
33 import Unify ( matchTys, unifyTyListsX )
34 import UniqFM ( lookupWithDefaultUFM, addToUFM, emptyUFM )
36 import ErrUtils ( Message )
42 A tiny function which doesn't belong anywhere else.
43 It makes a nasty mutual-recursion knot if you put it in Class.
46 simpleDFunClassTyCon :: DFunId -> (Class, TyCon)
47 simpleDFunClassTyCon dfun
50 (_,_,clas,[ty]) = splitDFunTy (idType dfun)
51 tycon = case splitTyConApp_maybe ty of
52 Just (tycon,_) -> tycon
54 classDataCon :: Class -> DataCon
55 classDataCon clas = case tyConDataCons (classTyCon clas) of
56 (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr
59 %************************************************************************
61 \subsection{Instance environments: InstEnv and ClsInstEnv}
63 %************************************************************************
65 The actual type declarations are in HscTypes.
68 emptyInstEnv :: InstEnv
69 emptyInstEnv = emptyUFM
71 classInstEnv :: InstEnv -> Class -> ClsInstEnv
72 classInstEnv env cls = lookupWithDefaultUFM env [] cls
75 A @ClsInstEnv@ lives inside a class, and identifies all the instances
76 of that class. The @Id@ inside a ClsInstEnv mapping is the dfun for
79 If class C maps to a list containing the item ([a,b], [t1,t2,t3], dfun), then
81 forall a b, C t1 t2 t3 can be constructed by dfun
83 or, to put it another way, we have
85 instance (...) => C t1 t2 t3, witnessed by dfun
87 There is an important consistency constraint in the elements of a ClsInstEnv:
89 * [a,b] must be a superset of the free vars of [t1,t2,t3]
91 * The dfun must itself be quantified over [a,b]
93 Thus, the @ClassInstEnv@ for @Eq@ might contain the following entry:
94 [a] ===> dfun_Eq_List :: forall a. Eq a => Eq [a]
95 The "a" in the pattern must be one of the forall'd variables in
100 Notes on overlapping instances
101 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
102 In some ClsInstEnvs, overlap is prohibited; that is, no pair of templates unify.
104 In others, overlap is permitted, but only in such a way that one can make
105 a unique choice when looking up. That is, overlap is only permitted if
106 one template matches the other, or vice versa. So this is ok:
114 If overlap is permitted, the list is kept most specific first, so that
115 the first lookup is the right choice.
118 For now we just use association lists.
120 \subsection{Avoiding a problem with overlapping}
122 Consider this little program:
125 class C a where c :: a
126 class C a => D a where d :: a
128 instance C Int where c = 17
129 instance D Int where d = 13
131 instance C a => C [a] where c = [c]
132 instance ({- C [a], -} D a) => D [a] where d = c
134 instance C [Int] where c = [37]
136 main = print (d :: [Int])
139 What do you think `main' prints (assuming we have overlapping instances, and
140 all that turned on)? Well, the instance for `D' at type `[a]' is defined to
141 be `c' at the same type, and we've got an instance of `C' at `[Int]', so the
142 answer is `[37]', right? (the generic `C [a]' instance shouldn't apply because
143 the `C [Int]' instance is more specific).
145 Ghc-4.04 gives `[37]', while ghc-4.06 gives `[17]', so 4.06 is wrong. That
146 was easy ;-) Let's just consult hugs for good measure. Wait - if I use old
147 hugs (pre-September99), I get `[17]', and stranger yet, if I use hugs98, it
148 doesn't even compile! What's going on!?
150 What hugs complains about is the `D [a]' instance decl.
153 ERROR "mj.hs" (line 10): Cannot build superclass instance
155 *** Context supplied : D a
156 *** Required superclass : C [a]
159 You might wonder what hugs is complaining about. It's saying that you
160 need to add `C [a]' to the context of the `D [a]' instance (as appears
161 in comments). But there's that `C [a]' instance decl one line above
162 that says that I can reduce the need for a `C [a]' instance to the
163 need for a `C a' instance, and in this case, I already have the
164 necessary `C a' instance (since we have `D a' explicitly in the
165 context, and `C' is a superclass of `D').
167 Unfortunately, the above reasoning indicates a premature commitment to the
168 generic `C [a]' instance. I.e., it prematurely rules out the more specific
169 instance `C [Int]'. This is the mistake that ghc-4.06 makes. The fix is to
170 add the context that hugs suggests (uncomment the `C [a]'), effectively
171 deferring the decision about which instance to use.
173 Now, interestingly enough, 4.04 has this same bug, but it's covered up
174 in this case by a little known `optimization' that was disabled in
175 4.06. Ghc-4.04 silently inserts any missing superclass context into
176 an instance declaration. In this case, it silently inserts the `C
177 [a]', and everything happens to work out.
179 (See `basicTypes/MkId:mkDictFunId' for the code in question. Search for
180 `Mark Jones', although Mark claims no credit for the `optimization' in
181 question, and would rather it stopped being called the `Mark Jones
184 So, what's the fix? I think hugs has it right. Here's why. Let's try
185 something else out with ghc-4.04. Let's add the following line:
190 Everyone raise their hand who thinks that `d :: [Int]' should give a
191 different answer from `d' :: [Int]'. Well, in ghc-4.04, it does. The
192 `optimization' only applies to instance decls, not to regular
193 bindings, giving inconsistent behavior.
195 Old hugs had this same bug. Here's how we fixed it: like GHC, the
196 list of instances for a given class is ordered, so that more specific
197 instances come before more generic ones. For example, the instance
198 list for C might contain:
199 ..., C Int, ..., C a, ...
200 When we go to look for a `C Int' instance we'll get that one first.
201 But what if we go looking for a `C b' (`b' is unconstrained)? We'll
202 pass the `C Int' instance, and keep going. But if `b' is
203 unconstrained, then we don't know yet if the more specific instance
204 will eventually apply. GHC keeps going, and matches on the generic `C
205 a'. The fix is to, at each step, check to see if there's a reverse
206 match, and if so, abort the search. This prevents hugs from
207 prematurely chosing a generic instance when a more specific one
213 @lookupInstEnv@ looks up in a @InstEnv@, using a one-way match. Since
214 the env is kept ordered, the first match must be the only one. The
215 thing we are looking up can have an arbitrary "flexi" part.
218 lookupInstEnv :: InstEnv -- The envt
219 -> Class -> [Type] -- Key
222 data InstLookupResult
223 = FoundInst -- There is a (template,substitution) pair
224 -- that makes the template match the key,
225 -- and no template is an instance of the key
228 | NoMatch Bool -- Boolean is true iff there is at least one
229 -- template that matches the key.
230 -- (but there are other template(s) that are
231 -- instances of the key, so we don't report
233 -- The NoMatch True case happens when we look up
235 -- in an InstEnv that has entries for
238 -- Then which we choose would depend on the way in which 'a'
239 -- is instantiated. So we say there is no match, but identify
240 -- it as ambiguous case in the hope of giving a better error msg.
241 -- See the notes above from Jeff Lewis
243 lookupInstEnv env key_cls key_tys
244 = find (classInstEnv env key_cls)
246 key_vars = tyVarsOfTypes key_tys
248 find [] = NoMatch False
249 find ((tpl_tyvars, tpl, val) : rest)
250 = case matchTys tpl_tyvars tpl key_tys of
252 case matchTys key_vars key_tys tpl of
254 Just (_, _) -> NoMatch (any_match rest)
255 Just (subst, leftovers) -> ASSERT( null leftovers )
258 any_match rest = or [ maybeToBool (matchTys tvs tpl key_tys)
259 | (tvs,tpl,_) <- rest
263 @addToClsInstEnv@ extends a @ClsInstEnv@, checking for overlaps.
265 A boolean flag controls overlap reporting.
267 True => overlap is permitted, but only if one template matches the other;
268 not if they unify but neither is
271 extendInstEnv :: DynFlags -> InstEnv -> [DFunId] -> (InstEnv, [Message])
272 -- Similar, but all we have is the DFuns
273 extendInstEnv dflags env infos
276 go env msgs [] = (env, msgs)
277 go env msgs (dfun:dfuns) = case addToInstEnv dflags env dfun of
278 Succeeded new_env -> go new_env msgs dfuns
279 Failed dfun' -> go env (msg:msgs) dfuns
281 msg = dupInstErr dfun dfun'
284 dupInstErr dfun1 dfun2
285 -- Overlapping/duplicate instances for given class; msg could be more glamourous
286 = hang (ptext SLIT("Duplicate or overlapping instance declarations:"))
287 2 (ppr_dfun dfun1 $$ ppr_dfun dfun2)
289 ppr_dfun dfun = ppr (getSrcLoc dfun) <> colon <+> ppr tau
291 (_,_,tau) = splitSigmaTy (idType dfun)
293 addToInstEnv :: DynFlags
295 -> MaybeErr InstEnv -- Success...
296 DFunId -- Failure: Offending overlap
298 addToInstEnv dflags inst_env dfun_id
299 = case insert_into (classInstEnv inst_env clas) of
300 Failed stuff -> Failed stuff
301 Succeeded new_env -> Succeeded (addToUFM inst_env clas new_env)
304 (ins_tvs, _, clas, ins_tys) = splitDFunTy (idType dfun_id)
306 ins_tv_set = mkVarSet ins_tvs
307 ins_item = (ins_tv_set, ins_tys, dfun_id)
309 insert_into [] = returnMaB [ins_item]
310 insert_into env@(cur_item@(tpl_tvs, tpl_tys, val) : rest)
313 -- (a) they are the same, or
314 -- (b) they unify, and any sort of overlap is prohibited,
315 -- (c) they unify but neither is more specific than t'other
317 || (unifiable && not (dopt Opt_AllowOverlappingInstances dflags))
318 || (unifiable && not (ins_item_more_specific || cur_item_more_specific))
321 -- New item is an instance of current item, so drop it here
322 | ins_item_more_specific = returnMaB (ins_item : env)
324 -- Otherwise carry on
325 | otherwise = insert_into rest `thenMaB` \ rest' ->
326 returnMaB (cur_item : rest')
328 unifiable = maybeToBool (unifyTyListsX (ins_tv_set `unionVarSet` tpl_tvs) tpl_tys ins_tys)
329 ins_item_more_specific = maybeToBool (matchTys tpl_tvs tpl_tys ins_tys)
330 cur_item_more_specific = maybeToBool (matchTys ins_tv_set ins_tys tpl_tys)
331 identical = ins_item_more_specific && cur_item_more_specific