Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/3b46b7b0634d021b91bee8dde848c71956c05f04 >--------------------------------------------------------------- commit 3b46b7b0634d021b91bee8dde848c71956c05f04 Author: Ian Lynagh <[email protected]> Date: Thu Sep 15 20:42:22 2011 +0100 Remove the Show superclass of Num >--------------------------------------------------------------- Data/Data.hs | 4 ++-- GHC/Num.lhs | 2 +- GHC/Real.lhs | 2 +- Numeric.hs | 6 +++--- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/Data/Data.hs b/Data/Data.hs index d04f37c..5de1eaf 100644 --- a/Data/Data.hs +++ b/Data/Data.hs @@ -767,7 +767,7 @@ mkPrimCon dt str cr = Constr mkIntConstr :: DataType -> Integer -> Constr mkIntConstr = mkIntegralConstr -mkIntegralConstr :: (Integral a) => DataType -> a -> Constr +mkIntegralConstr :: (Integral a, Show a) => DataType -> a -> Constr mkIntegralConstr dt i = case datarep dt of IntRep -> mkPrimCon dt (show i) (IntConstr (toInteger i)) _ -> error "Data.Data.mkIntegralConstr" @@ -777,7 +777,7 @@ mkIntegralConstr dt i = case datarep dt of mkFloatConstr :: DataType -> Double -> Constr mkFloatConstr dt = mkRealConstr dt . toRational -mkRealConstr :: (Real a) => DataType -> a -> Constr +mkRealConstr :: (Real a, Show a) => DataType -> a -> Constr mkRealConstr dt f = case datarep dt of FloatRep -> mkPrimCon dt (show f) (FloatConstr (toRational f)) _ -> error "Data.Data.mkRealConstr" diff --git a/GHC/Num.lhs b/GHC/Num.lhs index 148bdfa..9a1a38f 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, Show a) => Num a where +class (Eq a) => Num a where (+), (-), (*) :: a -> a -> a -- | Unary negation. negate :: a -> a diff --git a/GHC/Real.lhs b/GHC/Real.lhs index 4bc1d09..49f8487 100644 --- a/GHC/Real.lhs +++ b/GHC/Real.lhs @@ -362,7 +362,7 @@ instance (Integral a) => RealFrac (Ratio a) where properFraction (x:%y) = (fromInteger (toInteger q), r:%y) where (q,r) = quotRem x y -instance (Integral a) => Show (Ratio a) where +instance (Integral a, Show a) => Show (Ratio a) where {-# SPECIALIZE instance Show Rational #-} showsPrec p (x:%y) = showParen (p > ratioPrec) $ showsPrec ratioPrec1 x . diff --git a/Numeric.hs b/Numeric.hs index 8989f96..edaeb02 100644 --- a/Numeric.hs +++ b/Numeric.hs @@ -198,7 +198,7 @@ showGFloat d x = showString (formatRealFloat FFGeneric d x) -- | Shows a /non-negative/ 'Integral' number using the base specified by the -- first argument, and the character representation specified by the second. -showIntAtBase :: Integral a => a -> (Int -> Char) -> a -> ShowS +showIntAtBase :: (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS showIntAtBase base toChr n0 r0 | base <= 1 = error ("Numeric.showIntAtBase: applied to unsupported base " ++ show base) | n0 < 0 = error ("Numeric.showIntAtBase: applied to negative number " ++ show n0) @@ -213,9 +213,9 @@ showIntAtBase base toChr n0 r0 r' = c : r -- | Show /non-negative/ 'Integral' numbers in base 16. -showHex :: Integral a => a -> ShowS +showHex :: (Integral a,Show a) => a -> ShowS showHex = showIntAtBase 16 intToDigit -- | Show /non-negative/ 'Integral' numbers in base 8. -showOct :: Integral a => a -> ShowS +showOct :: (Integral a, Show a) => a -> ShowS showOct = showIntAtBase 8 intToDigit _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
