[Haskell-beginners] class and instance question
Stephen Blackheath [to Haskell-Beginners]
mutilating.cauliflowers.stephen at blacksapphire.com
Thu May 20 15:21:26 EDT 2010
Scott,
Here's a type families solution (see below).
*Main> ((2,3) :: (Int, Int)) <+> (10,10)
(12,13)
*Main>
I think TypeSynonymInstances are best avoided if possible, otherwise the
two types are not really interchangeable. It's certainly not needed for
this, anyway.
Steve
{-# LANGUAGE TypeFamilies, FlexibleInstances, FlexibleContexts #-}
infixl 6 <+>
infixl 6 <->
infixl 7 *>
infixl 7 <*
class Num (Elt v) => BasicVector v where
type Elt v :: *
(<+>) :: v -> v -> v
(<->) :: v -> v -> v
(*>) :: Elt v -> v -> v
(<*) :: v -> Elt v -> v
v1 <-> v2 = v1 <+> fromInteger (-1) *> v2
v1 <* c = c *> v1
c *> v1 = v1 <* c
type Vector2D a = (a,a)
instance Num a => BasicVector (a, a) where
type Elt (a, a) = a
(ax,ay) <+> (bx,by) = (ax+bx,ay+by)
c *> (ax,ay) = (c*ax,c*ay)
On 21/05/10 03:30, Brent Yorgey wrote:
> On Thu, May 20, 2010 at 06:35:34AM -0400, Walck, Scott wrote:
>> Hi folks,
>>
>>
>> NewVectorShort.hs:19:0:
>> Type synonym `Vector2D' should have 1 argument, but has been given 0
>> In the instance declaration for `BasicVector Vector2D'
>> Failed, modules loaded: none.
>
> The problem is simply that type synonyms must always be fully applied, so given
>
> type Vector2D a = (a,a)
>
> you cannot declare an instance for Vector2D, since Vector2D is not
> applied to an argument. The solution is to make Vector2D a newtype:
>
> newtype Vector2D a = V2D (a,a)
>
> Of course, this means you'll need to wrap and unwrap V2D constructors
> in various places, which can be a bit annoying, but such is the price
> of progress.
>
> For another take on encoding vector stuff in Haskell, see the
> vector-space package on Hackage.
>
> -Brent
>
>>
>> I don't understand how what I'm trying to do is different from, say, the Monad instance for Maybe.
>> (Maybe a) is a type, and (Vector2D a) is a type.
>>
>> Thanks,
>>
>> Scott
>>
>>
>>
>> {-# LANGUAGE TypeSynonymInstances #-}
>>
>> infixl 6 <+>
>> infixl 6 <->
>> infixl 7 *>
>> infixl 7 <*
>>
>> class BasicVector v where
>> (<+>) :: v a -> v a -> v a
>> (<->) :: v a -> v a -> v a
>> (*>) :: Num a => a -> v a -> v a
>> (<*) :: Num a => v a -> a -> v a
>> v1 <-> v2 = v1 <+> fromInteger (-1) *> v2
>> v1 <* c = c *> v1
>> c *> v1 = v1 <* c
>>
>> type Vector2D a = (a,a)
>>
>> instance BasicVector Vector2D where
>> (ax,ay) <+> (bx,by) = (ax+bx,ay+by)
>> c *> (ax,ay) = (c*ax,c*ay)
>>
>>
>>
>>
>>
>> _______________________________________________
>> Beginners mailing list
>> Beginners at haskell.org
>> http://www.haskell.org/mailman/listinfo/beginners
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
>
More information about the Beginners
mailing list