Re: change in overlapping instance behavior between GHC 6.12 and GHC 7 causes compilation failure

Hello,
I have narrowed this down further to a single file. And created a trac
bug for it:
http://hackage.haskell.org/trac/ghc/ticket/4485
This is (the only thing?) holding up HSP and happstack moving to GHC 7.
- jeremy
On Tue, Nov 2, 2010 at 5:36 PM, Jeremy Shaw
Hello,
I have a module, XMLGenerator, which has some overlapping instances. I have a second module, Test, which imports that module and also adds some more overlapping instances.
Both modules contain {-# LANGUAGE OverlappingInstances #-} at the top.
Under some old version of 6.13 (and probably 6.12), if I put both modules in the same directory and try to load Test.hs, it gets the error:
Test.hs:16:15: Overlapping instances for EmbedAsChild (M IO) (XMLGenT m (XML m)) arising from a use of `asChild' at Test.hs:16:15-21 Matching instances: instance (m1 ~ m, EmbedAsChild m c) => EmbedAsChild m (XMLGenT m1 c) -- Defined at XMLGenerator.hs:16:10-68 instance (XML m ~ x, XMLGen m) => EmbedAsChild m x -- Defined at XMLGenerator.hs:19:10-51 In the first argument of `($)', namely `asChild' In the expression: asChild $ (genElement "foo") In the definition of `asChild': asChild b = asChild $ (genElement "foo")
If I put the XMLGenerator module in a separate package, dummy-hsx, and the Test modules links against it, I still get the error.
*but* if I add:
Extensions: OverlappingInstances
to the dummy-hsx.cabal file, then Test.hs compiles just fine! So, for starters, I do not understand why that happens.
Under GHC 7.0rc1, modifying the .cabal file has no effect. Instead I always get the error:
Test.hs:16:15: Overlapping instances for EmbedAsChild (M IO) (XMLGenT m (XML m)) arising from a use of `asChild' Matching instances: instance [overlap ok] (m1 ~ m, EmbedAsChild m c) => EmbedAsChild m (XMLGenT m1 c) -- Defined in XMLGenerator (The choice depends on the instantiation of `m' To pick the first instance above, use -XIncoherentInstances when compiling the other instance declarations)
Adding the IncoherentInstances flag does make it compile -- but I have never enabled that flag and not regretted it.
What changed between GHC 6.12 and GHC 7.0? Is there a some solution besides using IncoherentInstances in every module that imports XMLGenerator?
I have attached XMLGenerator.hs, Test.hs, and dummy-hsx.cabal.
thanks! - jeremy

I'm not sure whether to reply to the list(s) or the ticket; maybe if you think my comments are valid they can be copied to the ticket. From looking, it seems to me that you do have overlapping instances, and I wonder if it's actually a 6.12 bug for accepting the code, not a 7 bug for rejecting it. I took your XMLGenerator.lhs file from the ticket and loaded it in GHC 6.12; it loaded fine. Then I looked through and squinted at this instance:
instance (EmbedAsChild m c, m1 ~ m) => EmbedAsChild m (XMLGenT m1 c)
That looked to me like a long-winded way of saying:
instance (EmbedAsChild m c) => EmbedAsChild m (XMLGenT m c)
Unless I'm missing something? So I made that change, then loaded it again. Suddenly I have overlapping instances in 6.12: XMLGenerator.lhs:64:16: Overlapping instances for EmbedAsChild (IdentityT IO) (XMLGenT m (XML m)) arising from a use of `asChild' at XMLGenerator.lhs:64:16-22 Matching instances: instance [overlap ok] (XML m ~ x, XMLGen m) => EmbedAsChild m x -- Defined at XMLGenerator.lhs:37:11-52 instance [overlap ok] (EmbedAsChild m c) => EmbedAsChild m (XMLGenT m c) -- Defined at XMLGenerator.lhs:31:11-60 It seems to me that the two instances can overlap; consider if I define an instance for XMLGen:
data WhateverM instance XMLGen WhateverM where type XML WhateverM = XMLGenT WhateverM ()
At that point your instances would overlap if I want an instance for EmbedAsChild WhateverM (XMLGenT WhateverM ()). My understanding of the way type-classes are checked is that since that instance could exist somewhere in a different module, we must reject the two instances for EmbedAsChild. (Or rather: ignoring the head of the instance declarations, the instances can overlap.) But I may be wrong! So my guess is you've always had overlapping instances (assuming this code is representative of your original), and my hypothesis is that the use of "~" in one of the instances was somehow stopping GHC 6.12 from spotting this. Thoughts (and corrections!) welcome. Thanks, Neil. On 08/11/10 23:30, Jeremy Shaw wrote:
Hello,
I have narrowed this down further to a single file. And created a trac bug for it:
http://hackage.haskell.org/trac/ghc/ticket/4485
This is (the only thing?) holding up HSP and happstack moving to GHC 7.
- jeremy
On Tue, Nov 2, 2010 at 5:36 PM, Jeremy Shaw
wrote: Hello,
I have a module, XMLGenerator, which has some overlapping instances. I have a second module, Test, which imports that module and also adds some more overlapping instances.
Both modules contain {-# LANGUAGE OverlappingInstances #-} at the top.
Under some old version of 6.13 (and probably 6.12), if I put both modules in the same directory and try to load Test.hs, it gets the error:
Test.hs:16:15: Overlapping instances for EmbedAsChild (M IO) (XMLGenT m (XML m)) arising from a use of `asChild' at Test.hs:16:15-21 Matching instances: instance (m1 ~ m, EmbedAsChild m c) => EmbedAsChild m (XMLGenT m1 c) -- Defined at XMLGenerator.hs:16:10-68 instance (XML m ~ x, XMLGen m) => EmbedAsChild m x -- Defined at XMLGenerator.hs:19:10-51 In the first argument of `($)', namely `asChild' In the expression: asChild $ (genElement "foo") In the definition of `asChild': asChild b = asChild $ (genElement "foo")
If I put the XMLGenerator module in a separate package, dummy-hsx, and the Test modules links against it, I still get the error.
*but* if I add:
Extensions: OverlappingInstances
to the dummy-hsx.cabal file, then Test.hs compiles just fine! So, for starters, I do not understand why that happens.
Under GHC 7.0rc1, modifying the .cabal file has no effect. Instead I always get the error:
Test.hs:16:15: Overlapping instances for EmbedAsChild (M IO) (XMLGenT m (XML m)) arising from a use of `asChild' Matching instances: instance [overlap ok] (m1 ~ m, EmbedAsChild m c) => EmbedAsChild m (XMLGenT m1 c) -- Defined in XMLGenerator (The choice depends on the instantiation of `m' To pick the first instance above, use -XIncoherentInstances when compiling the other instance declarations)
Adding the IncoherentInstances flag does make it compile -- but I have never enabled that flag and not regretted it.
What changed between GHC 6.12 and GHC 7.0? Is there a some solution besides using IncoherentInstances in every module that imports XMLGenerator?
I have attached XMLGenerator.hs, Test.hs, and dummy-hsx.cabal.
thanks! - jeremy
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

On 09/11/10 11:53, Neil Brown wrote:
XMLGenerator.lhs:64:16: Overlapping instances for EmbedAsChild (IdentityT IO) (XMLGenT m (XML m)) arising from a use of `asChild' at XMLGenerator.lhs:64:16-22 Matching instances: instance [overlap ok] (XML m ~ x, XMLGen m) => EmbedAsChild m x -- Defined at XMLGenerator.lhs:37:11-52 instance [overlap ok] (EmbedAsChild m c) => EmbedAsChild m (XMLGenT m c) -- Defined at XMLGenerator.lhs:31:11-60
I think I should expand slightly more on this bit, especially since I chopped off the useful line "The choice depends on the instantiation of `m'". The problem is that depending on the choice of m in the instance (the "EmbedAsChild (IdentityT IO) (XMLGenT m (XML m))" part), you may or may not match the second overlapping instance. If you choose m=IdentityT IO then it matches the second instance, if you choose anything else then it won't, so GHC can't tell at this point which instance to choose. Which makes them not just overlapping, but also leaves no clear choice (which is why it prompts you to use IncoherentInstances). When you typed the genElement "foo" part explicitly and gave a type to the monad m, that fixed the ambiguity. So I think it's not even that you needed incoherent instances, you have an unresolvable ambiguity if the type of m is left to be inferred. So I still think the question is why the old instance with the "~" worked fine. (Does this help, or am I telling you what you've already worked out for yourself?) Thanks, Neil.

instance (EmbedAsChild m c, m1 ~ m) => EmbedAsChild m (XMLGenT m1 c)
That looked to me like a long-winded way of saying:
instance (EmbedAsChild m c) => EmbedAsChild m (XMLGenT m c)
Unless I'm missing something?
These two instances are not equivalent: - the first matches even if m and m1 differ, causing a type-error. - the second matches only if m~m1 Claus {-# LANGUAGE OverlappingInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MultiParamTypeClasses #-} class C a b where c :: a -> b -> Bool instance C a a where c _ _ = True instance C a b where c _ _ = False class D a b where d :: a -> b -> Bool instance a~b=>D a b where d _ _ = True -- instance D a b where d _ _ = False -- would be a duplicate instance {- *Main> c () () True *Main> c () True False *Main> d () () True *Main> d () True <interactive>:1:0: Couldn't match expected type `Bool' against inferred type `()' When generalising the type(s) for `it' -}
participants (3)
-
Claus Reinke
-
Jeremy Shaw
-
Neil Brown