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

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.