summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authortaylorfausak <taylor@fausak.me>2019-10-03 22:44:17 -0400
committerMarge Bot <ben+marge-bot@smart-cactus.org>2019-11-01 04:54:47 -0400
commit3932fb97f59d78a91aaf99e7ea3ae04e6a5a10ea (patch)
tree88d2f0dbe414ac154d53768cafaaf0e79c7b41e9
parentdc4876421386b406dd43a6015f09d92c3e9fb7d8 (diff)
downloadhaskell-3932fb97f59d78a91aaf99e7ea3ae04e6a5a10ea.tar.gz
Fix rounding around 0
-rw-r--r--libraries/base/GHC/Real.hs15
1 files changed, 9 insertions, 6 deletions
diff --git a/libraries/base/GHC/Real.hs b/libraries/base/GHC/Real.hs
index 67ccf77596..b0f419896d 100644
--- a/libraries/base/GHC/Real.hs
+++ b/libraries/base/GHC/Real.hs
@@ -509,12 +509,15 @@ instance (Integral a) => RealFrac (Ratio a) where
properFraction (x:%y) = (fromInteger (toInteger q), r:%y)
where (q,r) = quotRem x y
round r =
- let (n, f) = properFraction r
- in case (compare (abs f) 0.5, odd n) of
- (LT, _) -> n
- (EQ, False) -> n
- (EQ, True) -> n + signum n
- (GT, _) -> n + signum n
+ let
+ (n, f) = properFraction r
+ x = if r < 0 then -1 else 1
+ in
+ case (compare (abs f) 0.5, odd n) of
+ (LT, _) -> n
+ (EQ, False) -> n
+ (EQ, True) -> n + x
+ (GT, _) -> n + x
-- | @since 2.0.1
instance (Show a) => Show (Ratio a) where