[Haskell-cafe] Problem with fundeps.

[oleg at pobox.com]

On Sun, 2 Jan 2005 karczma at info.unicaen.fr wrote:

> I tried to generalize one of my old
> packages for quantum *abstract* computations, where state vectors are
> defined as functional objects, whose codomain has some arithmetic.
> It is easy to see that you can define (f <+> g) = \x -> f x + g x
> etc. 

The problem that you were trying to solve can be solved, and has been
solved. Please refer to the message on keyword arguments:
	http://www.haskell.org/pipermail/haskell/2004-August/014416.html

Functional dependencies _are_ kept. Here's one of the tests

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

it typechecks and computes. Perhaps this solution also solves the
problems in the numericprelude. The compiler is GHCi 6.2.1

{-# OPTIONS -fglasgow-exts #-}
{-# OPTIONS -fallow-undecidable-instances #-}
{-# OPTIONS -fallow-overlapping-instances #-}

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 IsFunction (x->y) HTrue
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