[commit: base] master: Fix fromRat' and fromRat'' (2ff889f)

[Daniel Fischer]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/base

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/2ff889fc36406c2c4c07f0b009dd1ca3c2b7df6b

>---------------------------------------------------------------

commit 2ff889fc36406c2c4c07f0b009dd1ca3c2b7df6b
Author: Daniel Fischer <daniel.is.fischer at googlemail.com>
Date:   Tue Oct 4 16:31:36 2011 +0200

    Fix fromRat' and fromRat''
    
    Due to a wrong order of tests, values near the normalised/denormalised
    border were sent down the wrong branch. That led to rounding twice and
    picking the wrong neighbour for some values.
    
    fromRat' no longer uses scaleRat, if we're confident nobody uses that,
    we could remove it.

>---------------------------------------------------------------

 GHC/Float.lhs |   10 ++++------
 1 files changed, 4 insertions(+), 6 deletions(-)

diff --git a/GHC/Float.lhs b/GHC/Float.lhs
index f4a3da3..0680b89 100644
--- a/GHC/Float.lhs
+++ b/GHC/Float.lhs
@@ -849,18 +849,18 @@ fromRat' x = r
         p = floatDigits r
         (minExp0, _) = floatRange r
         minExp = minExp0 - p            -- the real minimum exponent
-        xMin   = toRational (expt b (p-1))
         xMax   = toRational (expt b p)
         p0 = (integerLogBase b (numerator x) - integerLogBase b (denominator x) - p) `max` minExp
         f = if p0 < 0 then 1 % expt b (-p0) else expt b p0 % 1
-        (x', p') = scaleRat (toRational b) minExp xMin xMax p0 (x / f)
+        x0 = x / f
+        (x', p') = if x0 >= xMax then (x0 / toRational b, p0+1) else (x0, p0)
         r = encodeFloat (round x') p'
 
 -- Scale x until xMin <= x < xMax, or p (the exponent) <= minExp.
 scaleRat :: Rational -> Int -> Rational -> Rational -> Int -> Rational -> (Rational, Int)
 scaleRat b minExp xMin xMax p x
- | p <= minExp = (x, p)
  | x >= xMax   = scaleRat b minExp xMin xMax (p+1) (x/b)
+ | p <= minExp = (x, p)
  | x < xMin    = scaleRat b minExp xMin xMax (p-1) (x*b)
  | otherwise   = (x, p)
 
@@ -924,7 +924,7 @@ fromRat'' minEx@(I# me#) mantDigs@(I# md#) n d =
       (# ld#, pw# #)
         | pw# ==# 0# ->
           case integerLog2# n of
-            ln# | ln# ># (ld# +# me#) ->
+            ln# | ln# >=# (ld# +# me# -# 1#) ->
                   if ln# <# md#
                     then encodeFloat (n `shiftL` (I# (md# -# 1# -# ln#)))
                                         (I# (ln# +# 1# -# ld# -# md#))
@@ -962,8 +962,6 @@ fromRat'' minEx@(I# me#) mantDigs@(I# md#) n d =
                 | p0 == mantDigs = (n, d)
                 | otherwise     = (n, d `shiftL` (p0 - mantDigs))
               scale p a b
-                | p <= minEx-mantDigs = (p,a,b)
-                | a < (b `shiftL` (mantDigs-1)) = (p-1, a `shiftL` 1, b)
                 | (b `shiftL` mantDigs) <= a = (p+1, a, b `shiftL` 1)
                 | otherwise = (p, a, b)
               (p', n'', d'') = scale (p0-mantDigs) n' d'