More type design questions

Konrad Hinsen hinsen@cnrs-orleans.fr
Mon, 18 Aug 2003 19:33:47 +0200


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 =3D Vector a a a
>    deriving (Show, Eq)
>
> instance Floating a =3D> Vect (Vector a) where
>    (<+>) (Vector x1 y1 z1) (Vector x2 y2 z2)
>           =3D Vector (x1+x2) (y1+y2) (z1+z2)
>
> instance Floating a =3D> Vect [Vector a] where
>    (<+>) l1 l2 =3D 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 pro=
blem=20
I had.  The full version of the class Vect is

class Vect v a where
  (<+>) :: Floating a =3D> v a -> v a -> v a
  (<->) :: Floating a =3D> v a -> v a -> v a
  (<*>) :: Floating a =3D> a -> v a -> v a

I need the parametrization on a in order to be able to define the type of=
=20
scalar multiplication.

I do have the choice of "class Vect v" or "class Vect v a", both seem to =
do=20
the same in this context, but in both cases "v" has the role of a type=20
constructor.

Konrad.