I still have to see a good reason to use "-fallow-incoherent-instances".
The motivation came from SPJ for the following example:
type Inte a = (Integer,a) instance Show a => Show [Inte a]
data Bar b = Bar [b]
instance Show b => Show (Bar b) where
show (Bar x1) = show x1This only compiles with the additional -fallow-incoherent-instances flag. However, if the first bit is put in Module B1 and the second in module A1, then module B1 does not need -fallow-incoherent-instances and module A1 (surprise!) does not even need -fglasgow-exts to go through. Rather module A1 yields an error if called with -fglasgow-exts and -fallow-overlapping-instances alone:
A1.hs:9:
Could not unambiguously deduce (Show [b])
from the context (Show (Bar b), Show b)
arising from use of `show' at A1.hs:9
The choice of (overlapping) instance declaration
depends on the instantiation of `b'
Probable fix:
Add (Show [b]) to the class or instance method `show'
Or add an instance declaration for (Show [b])
In the definition of `show': show (Bar x1) = show x1
In the definition for method `show'
In the instance declaration for `Show (Bar b)'So instead of adding the flag -fallow-incoherent-instances also the flag
-fno-allow-overlapping-instances lets A1 go through. Thus globally setting -fallow-overlapping-instances is already a problem.
Christian
P.S. The unfortunate instance originally comes from module Data.Graph.Inductive.Internal.RootPath
-- type LPath a = [LNode a]
instance Eq a => Eq (LPath a)
{-# OPTIONS -fglasgow-exts -fallow-overlapping-instances #-}
module A1 where
import B1
data Bar b = Bar [b]
instance Show b => Show (Bar b) where
show (Bar x1) = show x1
{-# OPTIONS -fglasgow-exts -fallow-overlapping-instances #-}
module B1 where
type Inte a = (Integer,a)
instance Show a => Show [Inte a]
_______________________________________________ Glasgow-haskell-users mailing list [EMAIL PROTECTED] http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
