x^y. Reply

Toralf Wittner wittner@uni-duesseldorf.de
Wed, 19 Dec 2001 15:11:06 +0100


On Wednesday, 19. December 2001 09:12, S.D.Mechveliani wrote:
[...]
> But if you still need  Integer | Double,  you can, for example,
> introduce a new type of a disjoint union of the above two, and then,
> to compute like this:
>                       pow (Intg 2) 2     -->  Intg 4
>                       pow (Intg 2) (-2)  -->  D 0.25
>                       pow (D 2.0)  (-2)  -->  D 0.25
> This is achieved by
>
>   data PowerDom = Intg Integer | D Double  deriving(Eq,Show)
>
>   pow :: PowerDom -> Integer -> PowerDom
>   pow x n = p x n
>     where
>     p (Intg m) n = if  n > 0  then  Intg $ powerInteger m n
>                    else  D $ powerDouble (fromInteger m :: Double) n
>     p(D d)     n = D $ powerDouble d n
>
>     powerInteger m n = m^n  :: Integer
>
>     powerDouble :: Double -> Integer -> Double
>     powerDouble    d         n       =  ... usual way for float
>
> - something like this.

This seems to be what I want. I tried it this way:

module Main where
import System

main = do
	[a1, a2] <- getArgs
	let x = read a1	
	let y = read a2 in
		putStrLn (show x ++ " ^ " ++ show y ++ " = " ++ show (pow x y))

data PowerNum = INT Integer | DBL Double deriving (Eq, Show, Read)

pow :: PowerNum -> Integer -> PowerNum
pow x y = z x y where

	z (INT x) y = 	if y > 0 then
				INT $ powInteger x y
			else
				DBL $ powDouble (fromInteger x) y

	z (DBL x) y =	DBL $ powDouble x y

	powInteger x y
		| x == 0	= 0
		| y == 0	= 1
		| y >  0	= x * powInteger x (y - 1)
	
	powDouble x y
		| x == 0	= 0
		| y == 0	= 1
		| y >  0	= 1 / x * powDouble x (y - 1)



While GHC compiled this code I get a runtime error: 

Fail: Prelude.read: no parse

and HUGS reports:

ERROR: Illegal Haskell 98 class constraint in inferred type
*** Expression : pow 1 2
*** Type       : Num PowerNum => PowerNum


Could you tell me what I did wrong? Thank you very much!
Toralf

>
>
> -----------------
> Serge Mechveliani
> mechvel@botik.ru