Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/3a3ab8080104b6f6dacf03e4413c592532c9f22e >--------------------------------------------------------------- commit 3a3ab8080104b6f6dacf03e4413c592532c9f22e Author: Simon Marlow <[email protected]> Date: Tue Jul 3 11:16:40 2012 +0100 Add RatioZeroDenominator to ArithException, and use it instead of error As per discussion on the libraries list. >--------------------------------------------------------------- GHC/Err.lhs | 5 +++++ GHC/Exception.lhs | 2 ++ GHC/Real.lhs | 6 +++--- 3 files changed, 10 insertions(+), 3 deletions(-) diff --git a/GHC/Err.lhs b/GHC/Err.lhs index 5352a06..ed1dcb9 100644 --- a/GHC/Err.lhs +++ b/GHC/Err.lhs @@ -27,6 +27,7 @@ module GHC.Err ( absentErr -- :: a , divZeroError -- :: a + , ratioZeroDenominatorError -- :: a , overflowError -- :: a , error -- :: String -> a @@ -82,6 +83,10 @@ in the libraries before the Exception type has been defined yet. divZeroError :: a divZeroError = throw DivideByZero +{-# NOINLINE ratioZeroDenominatorError #-} +ratioZeroDenominatorError :: a +ratioZeroDenominatorError = throw RatioZeroDenominator + {-# NOINLINE overflowError #-} overflowError :: a overflowError = throw Overflow diff --git a/GHC/Exception.lhs b/GHC/Exception.lhs index 74f8fea..76a9eb4 100644 --- a/GHC/Exception.lhs +++ b/GHC/Exception.lhs @@ -182,6 +182,7 @@ data ArithException | LossOfPrecision | DivideByZero | Denormal + | RatioZeroDenominator deriving (Eq, Ord, Typeable) instance Exception ArithException @@ -192,5 +193,6 @@ instance Show ArithException where showsPrec _ LossOfPrecision = showString "loss of precision" showsPrec _ DivideByZero = showString "divide by zero" showsPrec _ Denormal = showString "denormal" + showsPrec _ RatioZeroDenominator = showString "Ratio has zero denominator" \end{code} diff --git a/GHC/Real.lhs b/GHC/Real.lhs index d4e407e..a011989 100644 --- a/GHC/Real.lhs +++ b/GHC/Real.lhs @@ -92,7 +92,7 @@ their greatest common divisor. \begin{code} reduce :: (Integral a) => a -> a -> Ratio a {-# SPECIALISE reduce :: Integer -> Integer -> Rational #-} -reduce _ 0 = error "Ratio.%: zero denominator" +reduce _ 0 = ratioZeroDenominatorError reduce x y = (x `quot` d) :% (y `quot` d) where d = gcd x y \end{code} @@ -412,7 +412,7 @@ instance (Integral a) => Num (Ratio a) where instance (Integral a) => Fractional (Ratio a) where {-# SPECIALIZE instance Fractional Rational #-} (x:%y) / (x':%y') = (x*y') % (y*x') - recip (0:%_) = error "Ratio.%: zero denominator" + recip (0:%_) = ratioZeroDenominatorError recip (x:%y) | x < 0 = negate y :% negate x | otherwise = y :% x @@ -628,7 +628,7 @@ x ^^ n = if n >= 0 then x^n else recip (x^(negate n)) | e > 0 = (n ^ e) :% (d ^ e) | e == 0 = 1 :% 1 | n > 0 = (d ^ (negate e)) :% (n ^ (negate e)) - | n == 0 = error "Ratio.%: zero denominator" + | n == 0 = ratioZeroDenominatorError | otherwise = let nn = d ^ (negate e) dd = (negate n) ^ (negate e) in if even e then (nn :% dd) else (negate nn :% dd) _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
