Commit e2af452c authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺

Restore exact old semantics of `decodeFloat`

`integer-gmp2` uses the new 64bit-based IEEE deconstructing primop
introduced in b62bd5ec.

However, the returned values differ for exceptional IEEE values:

Previous (expected) semantics:

  > decodeFloat (-1/0)
  (-4503599627370496,972)

  > decodeFloat (1/0)
  (4503599627370496,972)

  > decodeFloat (0/0)
  (-6755399441055744,972)

Currently (broken) semantics:

  > decodeFloat (-1/0 :: Double)
  (-9223372036854775808,-53)

  > decodeFloat (1/0 :: Double)
  (-9223372036854775808,-53)

  > decodeFloat (0/0 :: Double)
  (-9223372036854775808,-53)

This patch reverts to the old expected semantics.

I plan to revisit the implementation during GHC 7.11 development.

This should address #9810

Reviewed By: austin, ekmett, luite

Differential Revision: https://phabricator.haskell.org/D486
parent 42244668
......@@ -166,6 +166,8 @@ __decodeDouble_2Int (I_ *man_sign, W_ *man_high, W_ *man_low, I_ *exp, StgDouble
StgInt
__decodeDouble_Int64 (StgInt64 *const mantissa, const StgDouble dbl)
{
#if 0
// We can't use this yet as-is, see ticket #9810
if (dbl) {
int exp = 0;
*mantissa = (StgInt64)scalbn(frexp(dbl, &exp), DBL_MANT_DIG);
......@@ -174,6 +176,17 @@ __decodeDouble_Int64 (StgInt64 *const mantissa, const StgDouble dbl)
*mantissa = 0;
return 0;
}
#else
I_ man_sign = 0;
W_ man_high = 0, man_low = 0;
I_ exp = 0;
__decodeDouble_2Int (&man_sign, &man_high, &man_low, &exp, dbl);
*mantissa = ((((StgInt64)man_high << 32) | (StgInt64)man_low)
* (StgInt64)man_sign);
return exp;
#endif
}
/* Convenient union types for checking the layout of IEEE 754 types -
......
......@@ -1035,6 +1035,7 @@ mk/ghcconfig*_inplace_bin_ghc-stage2.exe.mk
/tests/numeric/should_run/T7233
/tests/numeric/should_run/T7689
/tests/numeric/should_run/T8726
/tests/numeric/should_run/T9810
/tests/numeric/should_run/add2
/tests/numeric/should_run/arith001
/tests/numeric/should_run/arith002
......
main = do
-- NOTE: the `abs` is to compensate for WAY=optllvm
-- having a positive sign for 0/0
putStrLn "## Double ##"
print $ idRational ( 1/0 :: Double)
print $ idRational (-1/0 :: Double)
print $ abs $ idRational ( 0/0 :: Double)
print $ idReencode ( 1/0 :: Double)
print $ idReencode (-1/0 :: Double)
print $ abs $ idReencode ( 0/0 :: Double)
putStrLn "## Float ##"
print $ idRational ( 1/0 :: Float)
print $ idRational (-1/0 :: Float)
print $ abs $ idRational ( 0/0 :: Float)
print $ idReencode ( 1/0 :: Float)
print $ idReencode (-1/0 :: Float)
print $ abs $ idReencode ( 0/0 :: Float)
where
idRational :: (Real a, Fractional a) => a -> a
idRational = fromRational . toRational
idReencode :: (RealFloat a) => a -> a
idReencode = uncurry encodeFloat . decodeFloat
## Double ##
Infinity
-Infinity
Infinity
Infinity
-Infinity
Infinity
## Float ##
Infinity
-Infinity
Infinity
Infinity
-Infinity
Infinity
......@@ -63,3 +63,4 @@ test('T7233', normal, compile_and_run, [''])
test('NumDecimals', normal, compile_and_run, [''])
test('T8726', normal, compile_and_run, [''])
test('CarryOverflow', omit_ways(['ghci']), compile_and_run, [''])
test('T9810', normal, compile_and_run, [''])
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment