overlapping instances
Arie Peterson
ariep at xs4all.nl
Wed Oct 15 23:48:40 EDT 2003
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 :-).
More information about the Glasgow-haskell-users
mailing list