
Hello, Here's a simple module I'm playing about with.. {-# OPTIONS_GHC -fglasgow-exts #-} module Test(GT(..)) where -- GT class -- class Ord key => GT map key | map -> key where assocsAscending :: map a -> [(key,a)] -- Just 1 of many methods -- Instances of GT are instances of Eq -- instance (GT map key, Eq a) => Eq (map a) where map1 == map2 = assocsAscending map1 == assocsAscending map2 When I compile it I get this error.. Test.hs:9:0: Variable occurs more often in a constraint than in the instance head in the constraint: GT map key (Use -fallow-undecidable-instances to permit this) In the instance declaration for `Eq (map a)' But I can't see any problem here. If map and key are collectively instances of GT, and the fundep in GT fixes the type of key if type of map is known, and GT class has Ord constraint on key (and IIRC Ord class has an Eq constraint so key is a known instance of Eq), then why is this undecidable? Anyway, if I compile with -fallow-undecidable-instances I get this error instead.. Test.hs:10:16: Overlapping instances for Eq [(key, a)] arising from use of `==' at Test.hs:10:16-59 Matching instances: instance (Eq a) => Eq [a] -- Defined in GHC.Base instance (GT map key, Eq a) => Eq (map a) -- Defined at Test.hs:9:0 In the expression: (assocsAscending map1) == (assocsAscending map2) In the definition of `==': == map1 map2 = (assocsAscending map1) == (assocsAscending map2) In the definition for method `==' .. but I don't understand what that means (or to be more precise, what it seems to be saying makes no sense to me, so it's probably saying something else :-) How can my new instance overlap with the old (ghc) instance unless [] is also an instance of GT for some key type (which it isn't). Could someone explain? If I try making key a type arg of map (with no -fallow-undecidable-instances ).. {-# OPTIONS_GHC -fglasgow-exts #-} module Test(GT(..)) where -- GT class -- class Ord key => GT map key | map -> key where assocsAscending :: map key a -> [(key,a)] -- key is type arg of map -- Instances of GT are instances of Eq -- instance (GT map key, Eq a) => Eq (map key a) where map1 == map2 = assocsAscending map1 == assocsAscending map2 .. then I don't get the first error "Variable occurs more often in a constraint than in the instance head". But I still get the second ("Overlapping instances.."). But I don't really want to do this anyway as it as AFAICS it defeats the object of using the fundep in GT class. I also don't really understand why this second form should be decidable (presumably), whereas the first isn't. What extra information does the second provide that isn't already provided by the fundep in the first? If I also use the -fallow-overlapping-instances flag then both forms of this module compile, but with the warning.. Warning: orphan instances: instance [overlap ok] base:GHC.Base.Eq [.] = $f1 I'd be grateful if someone could take the time to explain what's going on here and (if possible) what I can or should do to get this code to compile (preferably without using undecidable or overlapping anything). Thanks -- Adrian Hey

On May 16, 2007, at 0:57 , Adrian Hey wrote:
-- GT class -- class Ord key => GT map key | map -> key where assocsAscending :: map a -> [(key,a)] -- Just 1 of many methods
-- Instances of GT are instances of Eq --
Instances of Ord are instances of Eq, so defining your own instance Eq for a subclass of Ord causes confusion. Specifically, depending on how the value is used, the compiler may not be able to decide between the standard Eq instance or your added one. "Don't do that." -- brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allbery@kf8nh.com system administrator [openafs,heimdal,too many hats] allbery@ece.cmu.edu electrical and computer engineering, carnegie mellon university KF8NH

Brandon S. Allbery KF8NH wrote:
On May 16, 2007, at 0:57 , Adrian Hey wrote:
-- GT class -- class Ord key => GT map key | map -> key where assocsAscending :: map a -> [(key,a)] -- Just 1 of many methods
-- Instances of GT are instances of Eq --
Instances of Ord are instances of Eq, so defining your own instance Eq for a subclass of Ord causes confusion. Specifically, depending on how the value is used, the compiler may not be able to decide between the standard Eq instance or your added one. "Don't do that."
I don't think I understand. How would you suggest I make Eq instances from GT? AFAICS it won't happen automatically without something like this. Or are you saying they shouldn't be instances of Eq? Perhaps it should be done separately on each and every type that is made an instance of GT, as Oleg has suggested. That seems a little awkward as they will all be essentially identical. (I thought one of the advantages of type classes was to avoid this kind of repetition.) Thanks -- Adrian Hey
participants (2)
-
Adrian Hey
-
Brandon S. Allbery KF8NH