overlapping instances

Simon Peyton-Jones simonpj at microsoft.com
Mon Oct 20 16:00:36 EDT 2003


First thing to say is that I'm changing the way in which overlapping
instance errors are reported.  At the moment (ghc 6.0, 6.2) you get an
overlap error if there *might* be an overlap problem. For example:

overlap.hs:23:
    Overlapping instance declarations:
      overlap.hs:23: Convertable a String
      overlap.hs:26: Convertable String a

The error is because if the compiler later tried to resolve the
constraint (Convertible String String), it would not know which to
choose.  This is over-eager really.  If it tried to resolve (Convertible
String Bool) there would be no question of which to choose.  GHC 6.4
will report overlap problems lazily, when they actually arise, rather
than when they *might* arise.  

You actually saw;

Overlapping instance declarations:
     Serialise.hs:16: Convertable String a
     Convertable.hs:7: Convertable a a

If the compiler tried to resolve (Convertible String String) it would
not know which of the two to use.  Hence the error.


You also ask:

| I do not understand why GHC can't choose between C [Int] (whenever f
is
| parametrised with Int) or C [a] (whenever f is parametrised with
anything
| else).

GHC has to make the choice once and for all when compiling f, so it
can't take advantage of knowing the type at which f is called.

Simon



| -----Original Message-----
| From: glasgow-haskell-users-bounces at haskell.org
[mailto:glasgow-haskell-users-
| bounces at haskell.org] On Behalf Of Arie Peterson
| Sent: 15 October 2003 21:49
| To: glasgow-haskell-users at haskell.org
| Subject: overlapping instances
| 
| Hi all,
| 
| In an attempt to design a elegant way to serialise things to any
serialised
| form, I came up with the following exotic solution:
| 
| ###
| {-# OPTIONS -fallow-undecidable-instances
-fallow-overlapping-instances #-}
| module Convertable where
| 
| class Convertable a b where
|    convert :: a -> b
| 
| instance Convertable a a where
|    convert = id
| 
| instance (Convertable a b,Convertable b c) => Convertable a c where
|    convert = (convert :: b -> c) . (convert :: a -> b)
| 
| class (Convertable a b,Convertable b a) => Equivalent a b
| ###
| 
| Happily surprised to see GHC swallow this, I continued by adding
| 
| ###
| {-# OPTIONS -fallow-undecidable-instances
-fallow-overlapping-instances #-}
| module Serialise where
| 
| import Convertable
| import Data.PackedString (PackedString,packString,unpackPS)
| 
| instance Convertable String PackedString where
|    convert = packString
| 
| instance Convertable PackedString String where
|    convert = unpackPS
| 
| instance (Show a) => Convertable a String where
|    convert = show
| 
| instance (Read a) => Convertable String a where
|    convert = read
| ###
| 
| But now GHC complains about overlapping instances:
| "Overlapping instance declarations:
|      Serialise.hs:16: Convertable String a
|      Convertable.hs:7: Convertable a a"
| Why can't GHC decide that the "Convertable String a" instance is more
specific?
| Apparently, there is no problem with the combination of "Convertable a
a"
| and "Convertable a String": if I leave out "read", all is well. What
is the
| difference with the above?
| 
| In the manual one can find:
| "GHC is also conservative about committing to an overlapping instance.
For
| example:
|    class C a where { op :: a -> a }
|    instance C [Int] where ...  instance C a => C [a] where ...
|    f :: C b => [b] -> [b]  f x = op x
|  From the RHS of f we get the constraint C [b]. But GHC does not
commit to
| the second instance declaration, because in a paricular call of f, b
might
| be instantiate to Int, so the first instance declaration would be
| appropriate. So GHC rejects the program. If you add
| -fallow-incoherent-instances GHC will instead silently pick the second
| instance, without complaining about the problem of subsequent
instantiations."
| I do not understand why GHC can't choose between C [Int] (whenever f
is
| parametrised with Int) or C [a] (whenever f is parametrised with
anything
| else). (While checking the type of f, it is clear that the constraint
C [b]
| is always met.) (Adding -fallow-incoherent-instances did not change
anything.)
| 
| Thanks a lot for putting up with my English and my dubious type
| constructions :-).
| 
| Regards,
| 
| Arie Peterson
| 
| BTW: I would like to use this opportunity to express my content: I
think
| haskell is a wonderful language (never, ever anymore javascript :s)
and GHC
| is a, uhm, glorious compiler :-).
| 
| 
| _______________________________________________
| Glasgow-haskell-users mailing list
| Glasgow-haskell-users at haskell.org
| http://www.haskell.org/mailman/listinfo/glasgow-haskell-users




More information about the Glasgow-haskell-users mailing list