[Haskell-cafe] Overlapping Instances with Functional Dependencies
oleg at pobox.com
oleg at pobox.com
Mon Jul 11 19:39:03 EDT 2005
Daniel Brown wrote:
> class Baz a b | a -> b
> instance Baz (a -> b) (a -> [b])
> instance Baz a a
> ...but Baz fails with this error...
>
> When confronted with overlapping instances, the compiler chooses the
> most specific one (if it is unique), e.g. `Baz (a -> b) (a -> [b])` is
> more specific than `Baz a a`.
>
> But it seems that the combination of the two features is broken: if the
> most specific instance is chosen before checking the functional
> dependency, then the fundep is satisfied; if the fundep is checked
> before choosing the most specific instance, then it isn't.
There is a way to write your example in Haskell as it is. The key idea
is that functional dependencies can be given *per instance* rather than
per class. To assert such dependencies, you need the `TypeCast'
constraint, which is throughly discussed in the HList technical
report.
http://homepages.cwi.nl/~ralf/HList/
The following is the complete code for the example, which runs on GHC
6.4. We see that the functional dependencies work indeed: the compiler
figures out the types of test1 and test2 and test3 (and thus resolved
overloading) without any type signatures or other intervention on our
part.
{-# OPTIONS -fglasgow-exts #-}
{-# OPTIONS -fallow-undecidable-instances #-}
{-# OPTIONS -fallow-overlapping-instances #-}
module Foo where
{-
class Baz a b | a -> b
instance Baz (a -> b) (a -> [b])
instance Baz a a
-}
-- No functional dependencies here!
class Baz a b where baz :: a -> b
-- Rather, dependencies are here
instance TypeCast a r => Baz a r where
baz a = typeCast a
instance TypeCast (a -> [b]) r => Baz (a -> b) r where
baz f = let r = \a -> [f a] in typeCast r
-- Chooses the instance Baz a a
test1 = baz True
-- True
-- Chooses the instance Baz (a -> b) (a -> [b])
test2 = (baz show) (1::Int)
-- ["1"]
test3 x = (baz show) x
test3' = test3 (Just True)
-- ["Just True"]
-- copied verbatim from the HList library
class TypeCast a b | a -> b, b->a where typeCast :: a -> b
class TypeCast' t a b | t a -> b, t b -> a where typeCast' :: t->a->b
class TypeCast'' t a b | t a -> b, t b -> a where typeCast'' :: t->a->b
instance TypeCast' () a b => TypeCast a b where typeCast x = typeCast' () x
instance TypeCast'' t a b => TypeCast' t a b where typeCast' = typeCast''
instance TypeCast'' () a a where typeCast'' _ x = x
More information about the Haskell-Cafe
mailing list