[Haskell-cafe] Context for type parameters of type constructors
Henning Thielemann
iakd0 at clusterf.urz.uni-halle.de
Mon Mar 29 18:00:57 EST 2004
Sorry for sending this twice, but it seems to me that the newsgroup
fa.haskell only logs the discussion of haskell and haskell-cafe.
---------- Forwarded message ----------
Date: Mon, 29 Mar 2004 01:18:27 -0800
From: googlegroups at henning-thielemann.de (Henning Thielemann)
Newsgroups: fa.haskell
Subject: Context for type parameters of type constructors
NNTP-Posting-Host: 134.102.210.249
Message-ID: <a17fb6f7.0403290118.786ede0d at posting.google.com>
I have a problem with type classes that can be illustrated
with the following example:
I want to declare a class for vector like data.
'Vector' is not meant as a synonyme for 'array'
but a 'vector' shall be a mathematical object
that allows for some linear operations,
namely summing and scaling.
Thus I setup a type constructor VectorSpace
in the following way:
> module VectorSpace
> where
>
> class VectorSpace v where
> zero :: v a
> add :: v a -> v a -> v a
> scale :: a -> v a -> v a
I haven't added context requirements like (Num a)
to the signatures of 'zero', 'add', 'scale'
because I cannot catch all requirements
that instances may need.
The problematic part is the 'scale' operation
because it needs both a scalar value and a vector.
Without the 'scale' operation
'v' could be simply a type (*)
rather than a type constructor (* -> *).
Now let's try some instances:
> data (Num a) => VList a = VList [a]
>
> instance VectorSpace VList where
> zero = VList (repeat 0)
> add (VList x) (VList y) = VList (zipWith (+) x y)
> scale s (VList x) = VList (map (s*) x)
>
> data (Num a) => VFunc b a = VFunc (b->a)
>
> instance VectorSpace (VFunc b) where
> zero = VFunc (\_ -> 0)
> add (VFunc f) (VFunc g) = VFunc (\x -> (f x) + (g x))
> scale s (VFunc f) = VFunc (\x -> s*(f x))
But now GHC complains:
$ ghc -c VectorSpace.lhs
VectorSpace.lhs:37:
Could not deduce (Num a) from the context (VectorSpace VList)
arising from the literal `0' at VectorSpace.lhs:30
Probable fix:
Add (Num a) to the class or instance method `zero'
In the first argument of `repeat', namely `0'
In the first argument of `VList', namely `(repeat 0)'
In the definition of `zero': zero = VList (repeat 0)
...
I hoped that when I declare VList within the context (Num a)
then it is always asserted
that a VList is built on a Num type.
If it is necessary to add (Num a) somewhere in the instance declaration -
then where?
Btw. I'm using
$ ghc --version
The Glorious Glasgow Haskell Compilation System, version 6.0
More information about the Haskell-Cafe
mailing list