summaryrefslogtreecommitdiff
path: root/libraries
diff options
context:
space:
mode:
authorARATA Mizuki <minorinoki@gmail.com>2021-01-14 22:58:45 +0900
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-03-17 19:05:13 -0400
commit540fa6b2cff3802877ff56a47ab3611e33a9ac86 (patch)
tree3cb8a8448170e96ec1d0fadee138cd6a4e58249b /libraries
parentf11954b16c07703b5444eda4a8ab16eadaedc7e6 (diff)
downloadhaskell-540fa6b2cff3802877ff56a47ab3611e33a9ac86.tar.gz
fromInteger :: Integer -> {Float,Double} now always round to nearest even
integerToFloat# and integerToDouble# were moved from ghc-bignum to base. GHC.Integer.floatFromInteger and doubleFromInteger were removed. Fixes #15926, #17231, #17782
Diffstat (limited to 'libraries')
-rw-r--r--libraries/base/GHC/Float.hs54
-rw-r--r--libraries/base/GHC/Integer.hs9
-rw-r--r--libraries/base/changelog.md3
-rw-r--r--libraries/ghc-bignum/src/GHC/Num/Integer.hs11
4 files changed, 56 insertions, 21 deletions
diff --git a/libraries/base/GHC/Float.hs b/libraries/base/GHC/Float.hs
index cb1ef6044c..e5ecc94045 100644
--- a/libraries/base/GHC/Float.hs
+++ b/libraries/base/GHC/Float.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE CPP
+{-# LANGUAGE BangPatterns
+ , CPP
, GHCForeignImportPrim
, NoImplicitPrelude
, MagicHash
@@ -299,6 +300,15 @@ instance Num Float where
{-# INLINE fromInteger #-}
fromInteger i = F# (integerToFloat# i)
+-- | Convert an Integer to a Float#
+integerToFloat# :: Integer -> Float#
+{-# NOINLINE integerToFloat# #-}
+integerToFloat# (IS i) = int2Float# i
+integerToFloat# i@(IP _) = case integerToBinaryFloat' i of
+ F# x -> x
+integerToFloat# (IN bn) = case integerToBinaryFloat' (IP bn) of
+ F# x -> negateFloat# x
+
-- | @since 2.01
instance Real Float where
toRational (F# x#) =
@@ -494,6 +504,14 @@ instance Num Double where
{-# INLINE fromInteger #-}
fromInteger i = D# (integerToDouble# i)
+-- | Convert an Integer to a Double#
+integerToDouble# :: Integer -> Double#
+{-# NOINLINE integerToDouble# #-}
+integerToDouble# (IS i) = int2Double# i
+integerToDouble# i@(IP _) = case integerToBinaryFloat' i of
+ D# x -> x
+integerToDouble# (IN bn) = case integerToBinaryFloat' (IP bn) of
+ D# x -> negateDouble# x
-- | @since 2.01
instance Real Double where
@@ -920,7 +938,39 @@ floatToDigits base x =
(map fromIntegral (reverse rds), k)
------------------------------------------------------------------------
--- Converting from a Rational to a RealFloa
+-- Converting from an Integer to a RealFloat
+------------------------------------------------------------------------
+
+{-# SPECIALISE integerToBinaryFloat' :: Integer -> Float,
+ Integer -> Double #-}
+-- | Converts a positive integer to a floating-point value.
+--
+-- The value nearest to the argument will be returned.
+-- If there are two such values, the one with an even significand will
+-- be returned (i.e. IEEE roundTiesToEven).
+--
+-- The argument must be strictly positive, and @floatRadix (undefined :: a)@ must be 2.
+integerToBinaryFloat' :: RealFloat a => Integer -> a
+integerToBinaryFloat' n = result
+ where
+ mantDigs = floatDigits result
+ k = I# (word2Int# (integerLog2# n))
+ result = if k < mantDigs then
+ encodeFloat n 0
+ else
+ let !e@(I# e#) = k - mantDigs + 1
+ q = n `unsafeShiftR` e
+ n' = case roundingMode# n (e# -# 1#) of
+ 0# -> q
+ 1# -> if integerToInt q .&. 1 == 0 then
+ q
+ else
+ q + 1
+ _ {- 2# -} -> q + 1
+ in encodeFloat n' e
+
+------------------------------------------------------------------------
+-- Converting from a Rational to a RealFloat
------------------------------------------------------------------------
{-
diff --git a/libraries/base/GHC/Integer.hs b/libraries/base/GHC/Integer.hs
index 598fe33c6d..070bd8fb61 100644
--- a/libraries/base/GHC/Integer.hs
+++ b/libraries/base/GHC/Integer.hs
@@ -23,8 +23,7 @@ module GHC.Integer (
#endif
-- * Helpers for 'RealFloat' type-class operations
- encodeFloatInteger, floatFromInteger,
- encodeDoubleInteger, decodeDoubleInteger, doubleFromInteger,
+ encodeFloatInteger, encodeDoubleInteger, decodeDoubleInteger,
-- * Arithmetic operations
plusInteger, minusInteger, timesInteger, negateInteger,
@@ -95,15 +94,9 @@ integerToInt64 = I.integerToInt64#
encodeFloatInteger :: Integer -> Int# -> Float#
encodeFloatInteger = I.integerEncodeFloat#
-floatFromInteger :: Integer -> Float#
-floatFromInteger = I.integerToFloat#
-
encodeDoubleInteger :: Integer -> Int# -> Double#
encodeDoubleInteger = I.integerEncodeDouble#
-doubleFromInteger :: Integer -> Double#
-doubleFromInteger = I.integerToDouble#
-
decodeDoubleInteger :: Double# -> (# Integer, Int# #)
decodeDoubleInteger = I.integerDecodeDouble#
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index 7900c9aad5..fcf9c0dde6 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -38,6 +38,9 @@
* Under POSIX, `System.IO.openFile` will no longer leak a file descriptor if it
is interrupted by an asynchronous exception (#19114, #19115).
+ * `fromInteger :: Integer -> Float/Double` now consistently round to the
+ nearest value, with ties to even.
+
## 4.15.0.0 *TBA*
* `openFile` now calls the `open` system call with an `interruptible` FFI
diff --git a/libraries/ghc-bignum/src/GHC/Num/Integer.hs b/libraries/ghc-bignum/src/GHC/Num/Integer.hs
index ae0d6af20b..6334e1636f 100644
--- a/libraries/ghc-bignum/src/GHC/Num/Integer.hs
+++ b/libraries/ghc-bignum/src/GHC/Num/Integer.hs
@@ -1084,22 +1084,11 @@ integerEncodeDouble# (IN b) e = negateDouble# (bigNatEncodeDouble# b e)
integerEncodeDouble :: Integer -> Int -> Double
integerEncodeDouble !m (I# e) = D# (integerEncodeDouble# m e)
--- | Encode an Integer (mantissa) into a Double#
-integerToDouble# :: Integer -> Double#
-{-# NOINLINE integerToDouble# #-}
-integerToDouble# !i = integerEncodeDouble# i 0#
-
--- | Encode an Integer (mantissa) into a Float#
-integerToFloat# :: Integer -> Float#
-{-# NOINLINE integerToFloat# #-}
-integerToFloat# !i = integerEncodeFloat# i 0#
-
-- | Encode (# Integer mantissa, Int# exponent #) into a Float#
--
-- TODO: Not sure if it's worth to write 'Float' optimized versions here
integerEncodeFloat# :: Integer -> Int# -> Float#
{-# NOINLINE integerEncodeFloat# #-}
-integerEncodeFloat# !m 0# = double2Float# (integerToDouble# m)
integerEncodeFloat# !m e = double2Float# (integerEncodeDouble# m e)
-- | Compute the number of digits of the Integer (without the sign) in the given base.