confusion

Ben Ben <neb@one.net>
Sun, 13 May 2001 03:33:54 -0500


Dear hugs maintainers,

I spent a few hours today writing code to manipulate polynomials for a
project. The polynomials are of type

newtype Polynomial a = Polynomial [a] deriving (Eq)

and I have defined an instance of Num as follows
instance Num a => Num (Polynomial a) where
		 fromInteger x   = toPolynomial [fromInteger x]
		 negate xs       = toPolynomial (map negate (fromPolynomial xs))
		 x + y           = toPolynomial (fromPolynomial x `polyA` fromPolynomial y)
		 x * y           = toPolynomial (fromPolynomial x `polyM` fromPolynomial y)

where polyA and polyM are appropriately defined. I also have defined,

(@@)   :: (Num a) => Polynomial a -> a -> a
f @@ g = applyrec (fromPolynomial f) g 0
   where
	 applyrec (f:fs) g m = f * g^m + applyrec fs g (m+1)
	 applyrec  []    _ _ = 0

I originally wrote this to find values of the polynomials for a given
integer. ie Polynomial [1,2,3] @@ 3 = 1 + 2*3 + 3*3^2

I also had to write a polynomial composition function, but I realized that
one can use @@ for this since a polynomial is a Num. In fact this works in
hugs when I type it, Polynomial [1,2,3] @@ Polynomial [3,2,1]. But I need to
do more complicated things with this, something like

set   = [0..t]
poly = [ toPolynomial [x1,x2] | x1<-set, x2<-set ]
compo = [ f@@g | f <- poly, g <- poly, f /= g ]

However this doesn't work and fails with an error:

ERROR "/home/brain/school/current/poly.hs" (line 7): Type error in application
*** Expression     : f @@ g
*** Term           : f
*** Type           : Polynomial Integer
*** Does not match : Polynomial (Polynomial Integer)

My question is the following. Why is it performing the operaton for me in
some cases and not in others? Is there a way to say that the type of
manipulation that I want to do is ok?

Thank you,

Ben.