Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/fcd6aefec896047dcb9425c5852128d6606ca0ce >--------------------------------------------------------------- commit fcd6aefec896047dcb9425c5852128d6606ca0ce Author: Ian Lynagh <[email protected]> Date: Thu Sep 15 22:03:19 2011 +0100 Remove the Eq superclass of Num >--------------------------------------------------------------- Data/Bits.hs | 2 +- Foreign/C/Error.hs | 18 ++++++++++-------- Foreign/Marshal/Utils.hs | 2 +- GHC/Event/Internal.hs | 2 +- GHC/Num.lhs | 2 +- Numeric.hs | 6 +++--- Text/Read/Lex.hs | 6 +++--- 7 files changed, 20 insertions(+), 18 deletions(-) diff --git a/Data/Bits.hs b/Data/Bits.hs index 855436d..22a6e41 100644 --- a/Data/Bits.hs +++ b/Data/Bits.hs @@ -73,7 +73,7 @@ Minimal complete definition: '.&.', '.|.', 'xor', 'complement', ('shift' or ('shiftL' and 'shiftR')), ('rotate' or ('rotateL' and 'rotateR')), 'bitSize' and 'isSigned'. -} -class Num a => Bits a where +class (Eq a, Num a) => Bits a where -- | Bitwise \"and\" (.&.) :: a -> a -> a diff --git a/Foreign/C/Error.hs b/Foreign/C/Error.hs index 6d3ef80..76ebe27 100644 --- a/Foreign/C/Error.hs +++ b/Foreign/C/Error.hs @@ -401,34 +401,36 @@ throwErrnoIfRetryMayBlock_ pred loc f on_block -- | Throw an 'IOError' corresponding to the current value of 'getErrno' -- if the 'IO' action returns a result of @-1@. -- -throwErrnoIfMinus1 :: Num a => String -> IO a -> IO a +throwErrnoIfMinus1 :: (Eq a, Num a) => String -> IO a -> IO a throwErrnoIfMinus1 = throwErrnoIf (== -1) -- | as 'throwErrnoIfMinus1', but discards the result. -- -throwErrnoIfMinus1_ :: Num a => String -> IO a -> IO () +throwErrnoIfMinus1_ :: (Eq a, Num a) => String -> IO a -> IO () throwErrnoIfMinus1_ = throwErrnoIf_ (== -1) -- | Throw an 'IOError' corresponding to the current value of 'getErrno' -- if the 'IO' action returns a result of @-1@, but retries in case of -- an interrupted operation. -- -throwErrnoIfMinus1Retry :: Num a => String -> IO a -> IO a +throwErrnoIfMinus1Retry :: (Eq a, Num a) => String -> IO a -> IO a throwErrnoIfMinus1Retry = throwErrnoIfRetry (== -1) -- | as 'throwErrnoIfMinus1', but discards the result. -- -throwErrnoIfMinus1Retry_ :: Num a => String -> IO a -> IO () +throwErrnoIfMinus1Retry_ :: (Eq a, Num a) => String -> IO a -> IO () throwErrnoIfMinus1Retry_ = throwErrnoIfRetry_ (== -1) -- | as 'throwErrnoIfMinus1Retry', but checks for operations that would block. -- -throwErrnoIfMinus1RetryMayBlock :: Num a => String -> IO a -> IO b -> IO a +throwErrnoIfMinus1RetryMayBlock :: (Eq a, Num a) + => String -> IO a -> IO b -> IO a throwErrnoIfMinus1RetryMayBlock = throwErrnoIfRetryMayBlock (== -1) -- | as 'throwErrnoIfMinus1RetryMayBlock', but discards the result. -- -throwErrnoIfMinus1RetryMayBlock_ :: Num a => String -> IO a -> IO b -> IO () +throwErrnoIfMinus1RetryMayBlock_ :: (Eq a, Num a) + => String -> IO a -> IO b -> IO () throwErrnoIfMinus1RetryMayBlock_ = throwErrnoIfRetryMayBlock_ (== -1) -- | Throw an 'IOError' corresponding to the current value of 'getErrno' @@ -481,13 +483,13 @@ throwErrnoPathIfNull = throwErrnoPathIf (== nullPtr) -- | as 'throwErrnoIfMinus1', but exceptions include the given path when -- appropriate. -- -throwErrnoPathIfMinus1 :: Num a => String -> FilePath -> IO a -> IO a +throwErrnoPathIfMinus1 :: (Eq a, Num a) => String -> FilePath -> IO a -> IO a throwErrnoPathIfMinus1 = throwErrnoPathIf (== -1) -- | as 'throwErrnoIfMinus1_', but exceptions include the given path when -- appropriate. -- -throwErrnoPathIfMinus1_ :: Num a => String -> FilePath -> IO a -> IO () +throwErrnoPathIfMinus1_ :: (Eq a, Num a) => String -> FilePath -> IO a -> IO () throwErrnoPathIfMinus1_ = throwErrnoPathIf_ (== -1) -- conversion of an "errno" value into IO error diff --git a/Foreign/Marshal/Utils.hs b/Foreign/Marshal/Utils.hs index d3ab1fd..ba8afcc 100644 --- a/Foreign/Marshal/Utils.hs +++ b/Foreign/Marshal/Utils.hs @@ -108,7 +108,7 @@ fromBool True = 1 -- |Convert a Boolean in numeric representation to a Haskell value -- -toBool :: Num a => a -> Bool +toBool :: (Eq a, Num a) => a -> Bool toBool = (/= 0) diff --git a/GHC/Event/Internal.hs b/GHC/Event/Internal.hs index b5d7c0f..00209fc 100644 --- a/GHC/Event/Internal.hs +++ b/GHC/Event/Internal.hs @@ -129,7 +129,7 @@ delete (Backend bState _ _ bDelete) = bDelete bState -- 'getErrno' is not 'eINTR'. If the result value is -1 and -- 'getErrno' returns 'eINTR' 0 is returned. Otherwise the result -- value is returned. -throwErrnoIfMinus1NoRetry :: Num a => String -> IO a -> IO a +throwErrnoIfMinus1NoRetry :: (Eq a, Num a) => String -> IO a -> IO a throwErrnoIfMinus1NoRetry loc f = do res <- f if res == -1 diff --git a/GHC/Num.lhs b/GHC/Num.lhs index 9a1a38f..a9d0fa2 100644 --- a/GHC/Num.lhs +++ b/GHC/Num.lhs @@ -57,7 +57,7 @@ default () -- Double isn't available yet, -- | Basic numeric class. -- -- Minimal complete definition: all except 'negate' or @(-)@ -class (Eq a) => Num a where +class Num a where (+), (-), (*) :: a -> a -> a -- | Unary negation. negate :: a -> a diff --git a/Numeric.hs b/Numeric.hs index edaeb02..167aa7b 100644 --- a/Numeric.hs +++ b/Numeric.hs @@ -90,16 +90,16 @@ readInt :: Num a readInt base isDigit valDigit = readP_to_S (L.readIntP base isDigit valDigit) -- | Read an unsigned number in octal notation. -readOct :: Num a => ReadS a +readOct :: (Eq a, Num a) => ReadS a readOct = readP_to_S L.readOctP -- | Read an unsigned number in decimal notation. -readDec :: Num a => ReadS a +readDec :: (Eq a, Num a) => ReadS a readDec = readP_to_S L.readDecP -- | Read an unsigned number in hexadecimal notation. -- Both upper or lower case letters are allowed. -readHex :: Num a => ReadS a +readHex :: (Eq a, Num a) => ReadS a readHex = readP_to_S L.readHexP -- | Reads an /unsigned/ 'RealFrac' value, diff --git a/Text/Read/Lex.hs b/Text/Read/Lex.hs index 310c715..199aa9b 100644 --- a/Text/Read/Lex.hs +++ b/Text/Read/Lex.hs @@ -413,7 +413,7 @@ fracExp exp mant (d:ds) = exp' `seq` mant' `seq` fracExp exp' mant' ds exp' = exp - 1 mant' = mant * 10 + fromIntegral d -valDig :: Num a => a -> Char -> Maybe Int +valDig :: (Eq a, Num a) => a -> Char -> Maybe Int valDig 8 c | '0' <= c && c <= '7' = Just (ord c - ord '0') | otherwise = Nothing @@ -441,13 +441,13 @@ readIntP base isDigit valDigit = do s <- munch1 isDigit return (val base 0 (map valDigit s)) -readIntP' :: Num a => a -> ReadP a +readIntP' :: (Eq a, Num a) => a -> ReadP a readIntP' base = readIntP base isDigit valDigit where isDigit c = maybe False (const True) (valDig base c) valDigit c = maybe 0 id (valDig base c) -readOctP, readDecP, readHexP :: Num a => ReadP a +readOctP, readDecP, readHexP :: (Eq a, Num a) => ReadP a readOctP = readIntP' 8 readDecP = readIntP' 10 readHexP = readIntP' 16 _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
