
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 :-).
participants (1)
-
Arie Peterson