More type design questions

Andre Pang ozone@algorithm.com.au
Tue, 19 Aug 2003 04:04:19 +1000


On Tuesday, August 19, 2003, at 03:33  AM, Konrad Hinsen wrote:

> On Monday 18 August 2003 19:10, Andre Pang wrote:
>
>> This seems to work (with -fglasgow-exts):
>>
>> module Foo where
>>
>> class Vect v where
>>    (<+>) :: v -> v -> v
>>
>> data Vector a = Vector a a a
>>    deriving (Show, Eq)
>>
>> instance Floating a => Vect (Vector a) where
>>    (<+>) (Vector x1 y1 z1) (Vector x2 y2 z2)
>>           = Vector (x1+x2) (y1+y2) (z1+z2)
>>
>> instance Floating a => Vect [Vector a] where
>>    (<+>) l1 l2 = zipWith (<+>) l1 l2
>>
>> *Foo> (Vector 5 6 7) <+> (Vector 1 2 3)
>> Vector 6.0 8.0 10.0
>> *Foo> [Vector 1 2 3, Vector 10 20 30] <+> [Vector 100 200 300, Vector 
>> 4
>> 5 6]
>> [Vector 101.0 202.0 303.0,Vector 14.0 25.0 36.0]
>>
>> ... or does example not do something which you want it to do?
>
> Well, yes, because my original example was cut down to illustrate the 
> problem
> I had.  The full version of the class Vect is
>
> class Vect v a where
>   (<+>) :: Floating a => v a -> v a -> v a
>   (<->) :: Floating a => v a -> v a -> v a
>   (<*>) :: Floating a => a -> v a -> v a
>
> I need the parametrization on a in order to be able to define the type 
> of
> scalar multiplication.
>
> I do have the choice of "class Vect v" or "class Vect v a", both seem 
> to do
> the same in this context, but in both cases "v" has the role of a type
> constructor.

Ah.  What about the code I gave above, and in addition to that:

class (Floating a, Vect v) => VectMult v a where
   (<*>) :: a -> v -> v

instance VectMult (Vector Float) Float where
   (<*>) n (Vector x y z) = Vector (n*x) (n*y) (n*z)

?


-- 
% Andre Pang : trust.in.love.to.save