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, pprInstEnv,
13 lookupInstEnv, InstLookupResult(..),
14 classInstEnv, simpleDFunClassTyCon
17 #include "HsVersions.h"
19 import Class ( Class )
21 import VarSet ( TyVarSet, unionVarSet, mkVarSet, varSetElems )
22 import VarEnv ( TyVarSubstEnv )
23 import Maybes ( MaybeErr(..), returnMaB, failMaB, thenMaB, maybeToBool )
24 import Name ( getSrcLoc )
25 import Type ( Type, tyConAppTyCon,
26 splitSigmaTy, splitDFunTy, tyVarsOfTypes
29 import TyCon ( TyCon )
31 import Unify ( matchTys, unifyTyListsX )
32 import UniqFM ( UniqFM, lookupWithDefaultUFM, addToUFM, emptyUFM, eltsUFM )
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 = tyConAppTyCon ty
59 pprInstEnv :: InstEnv -> SDoc
61 = vcat [ brackets (pprWithCommas ppr (varSetElems tyvars)) <+>
62 brackets (pprWithCommas ppr tys) <+> ppr dfun
63 | cls_inst_env <- eltsUFM env
64 , (tyvars, tys, dfun) <- cls_inst_env
68 %************************************************************************
70 \subsection{Instance environments: InstEnv and ClsInstEnv}
72 %************************************************************************
74 The actual type declarations are in HscTypes.
77 emptyInstEnv :: InstEnv
78 emptyInstEnv = emptyUFM
80 classInstEnv :: InstEnv -> Class -> ClsInstEnv
81 classInstEnv env cls = lookupWithDefaultUFM env [] cls
84 A @ClsInstEnv@ lives inside a class, and identifies all the instances
85 of that class. The @Id@ inside a ClsInstEnv mapping is the dfun for
88 If class C maps to a list containing the item ([a,b], [t1,t2,t3], dfun), then
90 forall a b, C t1 t2 t3 can be constructed by dfun
92 or, to put it another way, we have
94 instance (...) => C t1 t2 t3, witnessed by dfun
96 There is an important consistency constraint in the elements of a ClsInstEnv:
98 * [a,b] must be a superset of the free vars of [t1,t2,t3]
100 * The dfun must itself be quantified over [a,b]
102 Thus, the @ClassInstEnv@ for @Eq@ might contain the following entry:
103 [a] ===> dfun_Eq_List :: forall a. Eq a => Eq [a]
104 The "a" in the pattern must be one of the forall'd variables in
109 Notes on overlapping instances
110 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
111 In some ClsInstEnvs, overlap is prohibited; that is, no pair of templates unify.
113 In others, overlap is permitted, but only in such a way that one can make
114 a unique choice when looking up. That is, overlap is only permitted if
115 one template matches the other, or vice versa. So this is ok:
123 If overlap is permitted, the list is kept most specific first, so that
124 the first lookup is the right choice.
127 For now we just use association lists.
129 \subsection{Avoiding a problem with overlapping}
131 Consider this little program:
134 class C a where c :: a
135 class C a => D a where d :: a
137 instance C Int where c = 17
138 instance D Int where d = 13
140 instance C a => C [a] where c = [c]
141 instance ({- C [a], -} D a) => D [a] where d = c
143 instance C [Int] where c = [37]
145 main = print (d :: [Int])
148 What do you think `main' prints (assuming we have overlapping instances, and
149 all that turned on)? Well, the instance for `D' at type `[a]' is defined to
150 be `c' at the same type, and we've got an instance of `C' at `[Int]', so the
151 answer is `[37]', right? (the generic `C [a]' instance shouldn't apply because
152 the `C [Int]' instance is more specific).
154 Ghc-4.04 gives `[37]', while ghc-4.06 gives `[17]', so 4.06 is wrong. That
155 was easy ;-) Let's just consult hugs for good measure. Wait - if I use old
156 hugs (pre-September99), I get `[17]', and stranger yet, if I use hugs98, it
157 doesn't even compile! What's going on!?
159 What hugs complains about is the `D [a]' instance decl.
162 ERROR "mj.hs" (line 10): Cannot build superclass instance
164 *** Context supplied : D a
165 *** Required superclass : C [a]
168 You might wonder what hugs is complaining about. It's saying that you
169 need to add `C [a]' to the context of the `D [a]' instance (as appears
170 in comments). But there's that `C [a]' instance decl one line above
171 that says that I can reduce the need for a `C [a]' instance to the
172 need for a `C a' instance, and in this case, I already have the
173 necessary `C a' instance (since we have `D a' explicitly in the
174 context, and `C' is a superclass of `D').
176 Unfortunately, the above reasoning indicates a premature commitment to the
177 generic `C [a]' instance. I.e., it prematurely rules out the more specific
178 instance `C [Int]'. This is the mistake that ghc-4.06 makes. The fix is to
179 add the context that hugs suggests (uncomment the `C [a]'), effectively
180 deferring the decision about which instance to use.
182 Now, interestingly enough, 4.04 has this same bug, but it's covered up
183 in this case by a little known `optimization' that was disabled in
184 4.06. Ghc-4.04 silently inserts any missing superclass context into
185 an instance declaration. In this case, it silently inserts the `C
186 [a]', and everything happens to work out.
188 (See `basicTypes/MkId:mkDictFunId' for the code in question. Search for
189 `Mark Jones', although Mark claims no credit for the `optimization' in
190 question, and would rather it stopped being called the `Mark Jones
193 So, what's the fix? I think hugs has it right. Here's why. Let's try
194 something else out with ghc-4.04. Let's add the following line:
199 Everyone raise their hand who thinks that `d :: [Int]' should give a
200 different answer from `d' :: [Int]'. Well, in ghc-4.04, it does. The
201 `optimization' only applies to instance decls, not to regular
202 bindings, giving inconsistent behavior.
204 Old hugs had this same bug. Here's how we fixed it: like GHC, the
205 list of instances for a given class is ordered, so that more specific
206 instances come before more generic ones. For example, the instance
207 list for C might contain:
208 ..., C Int, ..., C a, ...
209 When we go to look for a `C Int' instance we'll get that one first.
210 But what if we go looking for a `C b' (`b' is unconstrained)? We'll
211 pass the `C Int' instance, and keep going. But if `b' is
212 unconstrained, then we don't know yet if the more specific instance
213 will eventually apply. GHC keeps going, and matches on the generic `C
214 a'. The fix is to, at each step, check to see if there's a reverse
215 match, and if so, abort the search. This prevents hugs from
216 prematurely chosing a generic instance when a more specific one
222 @lookupInstEnv@ looks up in a @InstEnv@, using a one-way match. Since
223 the env is kept ordered, the first match must be the only one. The
224 thing we are looking up can have an arbitrary "flexi" part.
227 lookupInstEnv :: InstEnv -- The envt
228 -> Class -> [Type] -- Key
231 data InstLookupResult
232 = FoundInst -- There is a (template,substitution) pair
233 -- that makes the template match the key,
234 -- and no template is an instance of the key
237 | NoMatch Bool -- Boolean is true iff there is at least one
238 -- template that matches the key.
239 -- (but there are other template(s) that are
240 -- instances of the key, so we don't report
242 -- The NoMatch True case happens when we look up
244 -- in an InstEnv that has entries for
247 -- Then which we choose would depend on the way in which 'a'
248 -- is instantiated. So we say there is no match, but identify
249 -- it as ambiguous case in the hope of giving a better error msg.
250 -- See the notes above from Jeff Lewis
252 lookupInstEnv env key_cls key_tys
253 = find (classInstEnv env key_cls)
255 key_vars = tyVarsOfTypes key_tys
257 find [] = NoMatch False
258 find ((tpl_tyvars, tpl, val) : rest)
259 = case matchTys tpl_tyvars tpl key_tys of
261 case matchTys key_vars key_tys tpl of
263 Just (_, _) -> NoMatch (any_match rest)
264 Just (subst, leftovers) -> ASSERT( null leftovers )
267 any_match rest = or [ maybeToBool (matchTys tvs tpl key_tys)
268 | (tvs,tpl,_) <- rest
272 @addToClsInstEnv@ extends a @ClsInstEnv@, checking for overlaps.
274 A boolean flag controls overlap reporting.
276 True => overlap is permitted, but only if one template matches the other;
277 not if they unify but neither is
280 extendInstEnv :: DynFlags -> InstEnv -> [DFunId] -> (InstEnv, [Message])
281 -- Similar, but all we have is the DFuns
282 extendInstEnv dflags env infos
285 go env msgs [] = (env, msgs)
286 go env msgs (dfun:dfuns) = case addToInstEnv dflags env dfun of
287 Succeeded new_env -> go new_env msgs dfuns
288 Failed dfun' -> go env (msg:msgs) dfuns
290 msg = dupInstErr dfun dfun'
293 dupInstErr dfun1 dfun2
294 -- Overlapping/duplicate instances for given class; msg could be more glamourous
295 = hang (ptext SLIT("Duplicate or overlapping instance declarations:"))
296 2 (ppr_dfun dfun1 $$ ppr_dfun dfun2)
298 ppr_dfun dfun = ppr (getSrcLoc dfun) <> colon <+> ppr tau
300 (_,_,tau) = splitSigmaTy (idType dfun)
302 addToInstEnv :: DynFlags
304 -> MaybeErr InstEnv -- Success...
305 DFunId -- Failure: Offending overlap
307 addToInstEnv dflags inst_env dfun_id
308 = case insert_into (classInstEnv inst_env clas) of
309 Failed stuff -> Failed stuff
310 Succeeded new_env -> Succeeded (addToUFM inst_env clas new_env)
313 (ins_tvs, _, clas, ins_tys) = splitDFunTy (idType dfun_id)
315 ins_tv_set = mkVarSet ins_tvs
316 ins_item = (ins_tv_set, ins_tys, dfun_id)
318 insert_into [] = returnMaB [ins_item]
319 insert_into env@(cur_item@(tpl_tvs, tpl_tys, val) : rest)
322 -- (a) they are the same, or
323 -- (b) they unify, and any sort of overlap is prohibited,
324 -- (c) they unify but neither is more specific than t'other
326 || (unifiable && not (dopt Opt_AllowOverlappingInstances dflags))
327 || (unifiable && not (ins_item_more_specific || cur_item_more_specific))
330 -- New item is an instance of current item, so drop it here
331 | ins_item_more_specific = returnMaB (ins_item : env)
333 -- Otherwise carry on
334 | otherwise = insert_into rest `thenMaB` \ rest' ->
335 returnMaB (cur_item : rest')
337 unifiable = maybeToBool (unifyTyListsX (ins_tv_set `unionVarSet` tpl_tvs) tpl_tys ins_tys)
338 ins_item_more_specific = maybeToBool (matchTys tpl_tvs tpl_tys ins_tys)
339 cur_item_more_specific = maybeToBool (matchTys ins_tv_set ins_tys tpl_tys)
340 identical = ins_item_more_specific && cur_item_more_specific