[Haskell-cafe] Issue with IsFunction/Vspace in GHC 6.10.1
Claus Reinke
claus.reinke at talk21.com
Thu Apr 2 18:38:13 EDT 2009
{-# LANGUAGE ScopedTypeVariables #-}
without, the 'f's in the instance are independent.
Claus
----- Original Message -----
From: "Jacques Carette" <carette at mcmaster.ca>
To: <haskell-cafe at haskell.org>
Sent: Thursday, April 02, 2009 10:15 PM
Subject: [Haskell-cafe] Issue with IsFunction/Vspace in GHC 6.10.1
>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
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
More information about the Haskell-Cafe
mailing list