[Haskell-cafe] Equality constraints and RankNTypes - how do I
assist type inference
DavidA
polyomino at f2s.com
Fri Aug 20 16:08:07 EDT 2010
Hi,
I have the following code, using equality constraints and (I believe) RankNTypes:
{-# LANGUAGE MultiParamTypeClasses, TypeFamilies,
RankNTypes, ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
-- import Math.Algebra.Group.PermutationGroup
-- Vector space over field k with basis b
data Vect k b = V [(b,k)] deriving (Eq,Show)
data TensorBasis a b = T a b deriving (Eq, Ord, Show)
-- Tensor product of two vector spaces
type Tensor u v =
(u ~ Vect k a, v ~ Vect k b) => Vect k (TensorBasis a b) -- **
class Algebra k v where -- "v is a k-algebra"
unit :: k -> v
mult :: Tensor v v -> v
type GroupAlgebra k = Vect k Int -- (Permutation Int)
instance Num k => Algebra k (GroupAlgebra k) where
unit 0 = V []
unit x = V [(1,x)]
mult (V ts) = V [(g*h,x) | (T g h, x) <- ts]
Everything is fine except for the last line,
which causes the following error message:
Couldn't match expected type `Tensor
(GroupAlgebra k) (GroupAlgebra k)'
against inferred type `Vect k1 b'
In the pattern: V ts
In the definition of `mult':
mult (V ts) = V [(g * h, x) | (T g h, x) <- ts]
In the instance declaration for `Algebra k (GroupAlgebra k)'
But according to me, I've told it that these two types are the same at the line
marked -- **
How do I help it out with type inference? (It, in this case, is GHCi 6.12.1)
Any ideas?
More information about the Haskell-Cafe
mailing list