[Haskell-cafe] What's wrong with my Haskell code?
Arthur Baars
arthurb at cs.uu.nl
Tue Apr 13 13:47:15 EDT 2004
It is because you use 'div' instead of '/'.
div :: Integral a => a -> a -> a
(/) :: Fractional a => a -> a -> a
Rationals are instance of the class Fractional, but not of Integral
Prelude> :i Fractional
class Num a => Fractional a where
(/) :: a -> a -> a
recip :: a -> a
fromRational :: Rational -> a
fromDouble :: Double -> a
-- instances:
instance Fractional Float
instance Fractional Double
instance Integral a => Fractional (Ratio a)
Hope this helps,
Arthur
On 13-apr-04, at 20:44, Meihui Fan wrote:
> when loading the following code, hugs escaped and reported that
>
> ERROR "cal24.hs":10 - Instance of Integral (Ratio Integer) required
> for definition of Main.eval
>
> I don't know why and how to solve it, anyone help me?
>
> data ETree = Add ETree ETree
> | Sub ETree ETree
> | Mul ETree ETree
> | Div ETree ETree
> | Node Integer
> deriving Show
>
> eval :: ETree->Maybe Rational
> eval (Node x) = Just (fromInteger x)
> eval (Add t1 t2) = do { x<-eval t1; y<-eval t2;
> if x>=y then return (x+y) else Nothing }
> eval (Sub t1 t2) = do { x<-eval t1; y<-eval t2; return (x-y) }
> eval (Mul t1 t2) = do { x<-eval t1; y<-eval t2;
> if x>=y then return (x*y) else Nothing }
> eval (Div t1 t2) = do { x<-eval t1; y<-eval t2;
> if y/=0 then return (x `div` y) else Nothing }
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
More information about the Haskell-Cafe
mailing list