[Haskell-cafe] Issue with IsFunction/Vspace in GHC 6.10.1

[Jacques Carette]

I was playing with some of Oleg's code (at end for convenience).  After 
minor adjustments for ghc 6.10.1, it still didn't work.  The error 
message is quite puzzling too, as it suggests adding exactly the 
constraint which is present...  Any ideas?

Jacques

-- Oleg's definition of a vector space class, based on IsFunction and
-- TypeCast.  See http://okmij.org/ftp/Haskell/isFunction.lhs
-- for the January 2003 message, which works in GHC 6.2.1 and 6.4
-- code below *works* in 6.8.1 AFAIK
{-# LANGUAGE EmptyDataDecls, MultiParamTypeClasses, 
FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverlappingInstances #-}

module Q where

class Vspace a v | v -> a
    where
    (<+>) :: v -> v -> v
    (*>)  :: a -> v -> v

instance (IsFunction v f, Vspace' f a v) => Vspace a v
  where
  (<+>) = doplus (undefined::f)
  (*>)  = dostar (undefined::f)

class Vspace' f a v | f v -> a
    where
    doplus :: f -> v -> v -> v
    dostar :: f -> a -> v -> v

instance Num a => Vspace' HFalse a a where
 doplus _ = (+)
 dostar _  = (*)
 -- etc.  No problem.

instance (IsFunction v f, Vspace' f a v, Vspace a v)
    => Vspace' HTrue a (c->v) where
 doplus _ f g = \x -> f x <+> g x
 dostar _ a f x = a *> (f x)


test1 = (1::Int) <+> 2
test2 = ((\x -> x <+> (10::Int)) <+> (\x -> x <+> (10::Int))) 1
test3 = ((\x y -> x <+> y) <+> (\x y -> (x <+> y) <+> x)) (1::Int) (2::Int)

test4 = ((\x y -> x <+> y) <+> (\x y -> ((2 *> x) <+> (3 *> y))))
    (1::Int) (2::Int)

data HTrue
data HFalse

class IsFunction a b | a -> b
instance TypeCast f HTrue => IsFunction (x->y) f
instance TypeCast f HFalse => IsFunction a f

-- literally lifted 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