diff options
| -rw-r--r-- | compiler/GHC/Builtin/Names.hs | 20 | ||||
| -rw-r--r-- | libraries/base/GHC/Float.hs | 54 | ||||
| -rw-r--r-- | libraries/base/GHC/Integer.hs | 9 | ||||
| -rw-r--r-- | libraries/base/changelog.md | 3 | ||||
| -rw-r--r-- | libraries/ghc-bignum/src/GHC/Num/Integer.hs | 11 |
5 files changed, 65 insertions, 32 deletions
diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs index 2836c82e72..4779ca8de2 100644 --- a/compiler/GHC/Builtin/Names.hs +++ b/compiler/GHC/Builtin/Names.hs @@ -384,8 +384,6 @@ basicKnownKeyNames integerModName, integerDivModName, integerQuotRemName, - integerToFloatName, - integerToDoubleName, integerEncodeFloatName, integerEncodeDoubleName, integerGcdName, @@ -438,6 +436,8 @@ basicKnownKeyNames bignatFromWordListName, -- Float/Double + integerToFloatName, + integerToDoubleName, rationalToFloatName, rationalToDoubleName, @@ -1197,8 +1197,6 @@ integerFromNaturalName , integerModName , integerDivModName , integerQuotRemName - , integerToFloatName - , integerToDoubleName , integerEncodeFloatName , integerEncodeDoubleName , integerGcdName @@ -1324,8 +1322,6 @@ integerDivName = bniVarQual "integerDiv" integerDivIdK integerModName = bniVarQual "integerMod" integerModIdKey integerDivModName = bniVarQual "integerDivMod#" integerDivModIdKey integerQuotRemName = bniVarQual "integerQuotRem#" integerQuotRemIdKey -integerToFloatName = bniVarQual "integerToFloat#" integerToFloatIdKey -integerToDoubleName = bniVarQual "integerToDouble#" integerToDoubleIdKey integerEncodeFloatName = bniVarQual "integerEncodeFloat#" integerEncodeFloatIdKey integerEncodeDoubleName = bniVarQual "integerEncodeDouble#" integerEncodeDoubleIdKey integerGcdName = bniVarQual "integerGcd" integerGcdIdKey @@ -1370,7 +1366,9 @@ floatingClassName = clsQual gHC_FLOAT (fsLit "Floating") floatingClassKey realFloatClassName = clsQual gHC_FLOAT (fsLit "RealFloat") realFloatClassKey -- other GHC.Float functions -rationalToFloatName, rationalToDoubleName :: Name +integerToFloatName, integerToDoubleName, rationalToFloatName, rationalToDoubleName :: Name +integerToFloatName = varQual gHC_FLOAT (fsLit "integerToFloat#") integerToFloatIdKey +integerToDoubleName = varQual gHC_FLOAT (fsLit "integerToDouble#") integerToDoubleIdKey rationalToFloatName = varQual gHC_FLOAT (fsLit "rationalToFloat") rationalToFloatIdKey rationalToDoubleName = varQual gHC_FLOAT (fsLit "rationalToDouble") rationalToDoubleIdKey @@ -2387,6 +2385,10 @@ coercionTokenIdKey = mkPreludeMiscIdUnique 124 noinlineIdKey = mkPreludeMiscIdUnique 125 considerAccessibleIdKey = mkPreludeMiscIdUnique 126 +integerToFloatIdKey, integerToDoubleIdKey :: Unique +integerToFloatIdKey = mkPreludeMiscIdUnique 128 +integerToDoubleIdKey = mkPreludeMiscIdUnique 129 + rationalToFloatIdKey, rationalToDoubleIdKey :: Unique rationalToFloatIdKey = mkPreludeMiscIdUnique 130 rationalToDoubleIdKey = mkPreludeMiscIdUnique 131 @@ -2600,8 +2602,6 @@ integerFromNaturalIdKey , integerModIdKey , integerDivModIdKey , integerQuotRemIdKey - , integerToFloatIdKey - , integerToDoubleIdKey , integerEncodeFloatIdKey , integerEncodeDoubleIdKey , integerGcdIdKey @@ -2683,8 +2683,6 @@ integerDivIdKey = mkPreludeMiscIdUnique 624 integerModIdKey = mkPreludeMiscIdUnique 625 integerDivModIdKey = mkPreludeMiscIdUnique 626 integerQuotRemIdKey = mkPreludeMiscIdUnique 627 -integerToFloatIdKey = mkPreludeMiscIdUnique 628 -integerToDoubleIdKey = mkPreludeMiscIdUnique 629 integerEncodeFloatIdKey = mkPreludeMiscIdUnique 630 integerEncodeDoubleIdKey = mkPreludeMiscIdUnique 631 integerGcdIdKey = mkPreludeMiscIdUnique 632 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. |