Type Class Magic [Re: Type tree traversals]

[Brandon Michael Moore]

One part of the solution that I didn't like is that the constraint on a
method had to explicitly list all the classes that declared that method.
That hampers generating the binding a class at a time, so I fixed it. I
still don't match the type of the method against the types declared, but
that shouldn't be too hard to add.

Thanks for all your help, oleg.

Brandon

-----Classes.hs
{-# OPTIONS -fglasgow-exts -fallow-undecidable-instances
-fallow-overlapping-instances #-}
module Classes where

--marker types for the classes
data Object = Object
data ClassA = ClassA
data ClassB = ClassB
data ClassC = ClassC
data ClassD = ClassD
data ClassE = ClassE

--marker types for the methods
data Foo = Foo
instance SubClass () Foo
foo :: (HasMethod Foo obj args result) => obj -> args -> result
foo = call Foo
data Bar = Bar
instance SubClass () Bar
bar :: (HasMethod Bar obj args result) => obj -> args -> result
bar = call Bar
data Baz = Baz
instance SubClass () Baz
baz :: (HasMethod Baz obj azgs result) => obj -> azgs -> result
baz = call Baz

--class and instances to record classes interface and ancestors
--notice the information about which methods a class declares
--is only stored here
class Interface super sub | sub -> super
instance Interface () Object
instance Interface (Foo,(Bar,(Object,()))) ClassA
instance Interface (Foo,(Baz,(Object,()))) ClassB
instance Interface (ClassA,()) ClassC
instance Interface (ClassB,()) ClassD
instance Interface (ClassA,(ClassB,(ClassC,()))) ClassE

--Ancestors Have Method
--the "worker type class" to search for ancestors
class AHM objs method

instance AHM (t,x) t
instance (AHM cls t) => AHM ((),cls) t
instance (Interface items c, AHM (items,cs) t) => AHM (c,cs) t
instance (AHM (a,(b,cls)) t) => AHM ((a,b),cls) t

--now we can express the constraint that a class inherits a method
class HasMethod method obj args result where
  call :: method -> obj -> args -> result

instance (Interface items cls, AHM items method) => HasMethod method cls
args result where
  call method obj args = undefined