Type tree traversals [Re: Modeling multiple inheritance]

[Brandon Michael Moore]

This seems to work. The type checker picks one rule to use at each point
so you can't get backtracking, but you explicitly build the sequence of
base classes, and use the overloading resolution to stop if we find our
goal. This is clever.

It looks like prolog could be interesting. My first introduction to
functional programming was Unlambda (and I didn't run screaming), and it
seems the Haskell type class system is being my introduction to logic
programming. I get into paradigms the oddest ways.

Let's see if I understand the algorithm. It looks like the instances for
HasBarMethods implement a search through the ancestors of a class, with an
axiom that stops if the topmost class on the stack is the one we are
looking for, discards the top class if is Object or (), unpacks it if it
is a tuple, otherwise replaces it with the tuple of parents.

I've modified the code to express searches for multiple base classes, but
the list of classes defining a method needs to be hardcoded. I want a
solution that doesn't require any global analysis of the interface I'm
generating bindings for. I think I could do something similar with
explicitly iterating over all the methods on all the classes I hit,
with special merker types for each method name, but I haven't worked it
out yet.

P.S to implementors: backtracking search in the type class resolution
would make this sort of thing much easier to code

Brandon

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

data Object = Object
data ClassA = ClassA
data ClassB = ClassB
data ClassC = ClassC
data ClassD = ClassD

class SubClass super sub | sub -> super

instance SubClass (Object,()) ClassA
instance SubClass (Object,()) ClassB
instance SubClass (ClassA,()) ClassC
instance SubClass (ClassB,()) ClassD

{-  O
   / \
  A   B
  |   |
  C   D
-}

class HasBarMethod cls args result where
  bar :: cls -> args -> result
instance HasAncestors cls (ClassA,(ClassB,())) => HasBarMethod cls args
result where
  bar obj args = undefined
instance HasBarMethod ClassA args result where
  bar obj args = undefined
instance HasBarMethod ClassB args result where
  bar obj args = undefined

class HasFooMethod cls args result where
  foo :: cls -> args -> result
instance HasAncestor cls ClassA => HasFooMethod cls args result where
  foo obj args = undefined
instance HasFooMethod ClassA args result where
  foo obj args = undefined

class HasBazMethod cls args result where
  baz :: cls -> args -> result
instance HasAncestor cls ClassB => HasBazMethod cls args result where
  baz obj args = undefined
instance HasBazMethod ClassB args result where
  baz obj args = undefined

class HasAncestor cls t
--instance (SubClass supers cls,HasAncestorS supers t) =>
	HasAncestor cls t
instance (SubClass supers cls, HasAncestorS cls supers (t,())) =>
	HasAncestor cls t

class HasAncestors cls ts
instance (SubClass supers cls, HasAncestorS cls supers ts) =>
	HasAncestors cls ts


class HasAncestorS start cls c

instance HasAncestorS start (t,x) (t,y)
instance (HasAncestorS start cls (t,ts)) =>
	HasAncestorS start (Object,cls) (t,ts)
instance (HasAncestorS start cls (t,ts)) =>
	HasAncestorS start ((),cls) (t,ts)
instance (SubClass supers c, HasAncestorS start (supers,cls) ts) =>
    	HasAncestorS start (c,cls) ts
instance (SubClass supers start, HasAncestorS start supers ts) =>
	HasAncestorS start () (t,ts)


instance (HasAncestorS start (a,(b,cls)) (t,ts)) =>
	HasAncestorS start ((a,b),cls) (t,ts)

------then in GHCI
--test bar
*Classes> bar ClassA 0
*** Exception: Prelude.undefined
*Classes> bar ClassA 0
*** Exception: Prelude.undefined
*Classes> bar ClassB 0
*** Exception: Prelude.undefined
*Classes> bar ClassC 0
*** Exception: Prelude.undefined
*Classes> bar ClassD 0
*** Exception: Prelude.undefined
--test foo
*Classes> foo ClassA 0
*** Exception: Prelude.undefined
*Classes> foo ClassB 0

<interactive>:1:
    No instance for (HasAncestorS ClassB (Object, ()) ())
      arising from use of `foo' at <interactive>:1
    In the definition of `it': it = foo ClassB 0
*Classes> foo ClassC 0
*** Exception: Prelude.undefined
*Classes> foo ClassD 0

<interactive>:1:
    No instance for (HasAncestorS ClassD (ClassB, ()) ())
      arising from use of `foo' at <interactive>:1
    In the definition of `it': it = foo ClassD 0
--test baz
*Classes> baz ClassA 0

<interactive>:1:
    No instance for (HasAncestorS ClassA (Object, ()) ())
      arising from use of `baz' at <interactive>:1
    In the definition of `it': it = baz ClassA 0
*Classes> baz ClassB 0
*** Exception: Prelude.undefined
*Classes> baz ClassC 0

<interactive>:1:
    No instance for (HasAncestorS ClassC (ClassA, ()) ())
      arising from use of `baz' at <interactive>:1
    In the definition of `it': it = baz ClassC 0
*Classes> baz ClassD 0
*** Exception: Prelude.undefined