[Git][ghc/ghc][master] numberToRangedRational: fix edge cases for exp ≈ (maxBound :: Int)

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
4bc7b1e5 by Fraser Tweedale at 2023-08-08T21:27:32-04:00
numberToRangedRational: fix edge cases for exp ≈ (maxBound :: Int)

Currently a negative exponent less than `minBound :: Int` results in
Infinity, which is very surprising and obviously wrong.

```
λ> read "1e-9223372036854775808" :: Double
0.0
λ> read "1e-9223372036854775809" :: Double
Infinity
```

There is a further edge case where the exponent can overflow when
increased by the number of tens places in the integer part, or
underflow when decreased by the number of leading zeros in the
fractional part if the integer part is zero:

```
λ> read "10e9223372036854775807" :: Double
0.0
λ> read "0.01e-9223372036854775808" :: Double
Infinity
```

To resolve both of these issues, perform all arithmetic and
comparisons involving the exponent in type `Integer`.  This approach
also eliminates the need to explicitly check the exponent against
`maxBound :: Int` and `minBound :: Int`, because the allowed range
of the exponent (i.e. the result of `floatRange` for the target
floating point type) is certainly within those bounds.

This change implements CLC proposal 192:
https://github.com/haskell/core-libraries-committee/issues/192

- - - - -


5 changed files:

- libraries/base/Text/Read/Lex.hs
- libraries/base/changelog.md
- libraries/base/tests/all.T
- + libraries/base/tests/read-float-double.hs
- + libraries/base/tests/read-float-double.stdout


Changes:

=====================================
libraries/base/Text/Read/Lex.hs
=====================================
@@ -47,7 +47,7 @@ import GHC.Unicode
 import GHC.Real( Rational, (%), fromIntegral, Integral,
                  toInteger, (^), quot, even )
 import GHC.List
-import GHC.Enum( minBound, maxBound )
+import GHC.Enum( maxBound )
 import Data.Maybe
 
 -- local copy to break import-cycle
@@ -121,12 +121,9 @@ numberToFixed _ _ = Nothing
 numberToRangedRational :: (Int, Int) -> Number
                        -> Maybe Rational -- Nothing = Inf
 numberToRangedRational (neg, pos) n@(MkDecimal iPart mFPart (Just exp))
-    -- if exp is out of integer bounds,
-    -- then the number is definitely out of range
-    | exp > fromIntegral (maxBound :: Int) ||
-      exp < fromIntegral (minBound :: Int)
-    = Nothing
-    | otherwise
+    -- Calculate amount to increase/decrease the exponent, based on (non
+    -- leading zero) places in the iPart, or leading zeros in the fPart.
+    -- If iPart and fPart are all zeros, return Nothing.
     = let mFirstDigit = case dropWhile (0 ==) iPart of
                         iPart'@(_ : _) -> Just (length iPart')
                         [] -> case mFPart of
@@ -139,10 +136,11 @@ numberToRangedRational (neg, pos) n@(MkDecimal iPart mFPart (Just exp))
       in case mFirstDigit of
          Nothing -> Just 0
          Just firstDigit ->
-             let firstDigit' = firstDigit + fromInteger exp
-             in if firstDigit' > (pos + 3)
+             -- compare exp to bounds as Integer to avoid over/underflow
+             let firstDigit' = toInteger firstDigit + exp
+             in if firstDigit' > toInteger (pos + 3)
                 then Nothing
-                else if firstDigit' < (neg - 3)
+                else if firstDigit' < toInteger (neg - 3)
                 then Just 0
                 else Just (numberToRational n)
 numberToRangedRational _ n = Just (numberToRational n)


=====================================
libraries/base/changelog.md
=====================================
@@ -38,6 +38,7 @@
   * Add nominal role annotations to SNat/SSymbol/SChar ([CLC proposal #170](https://github.com/haskell/core-libraries-committee/issues/170))
   * Make `Semigroup`'s `stimes` specializable. ([CLC proposal #8](https://github.com/haskell/core-libraries-committee/issues/8))
   * Deprecate `Data.List.NonEmpty.unzip` ([CLC proposal #86](https://github.com/haskell/core-libraries-committee/issues/86))
+  * Fixed exponent overflow/underflow bugs in the `Read` instances for `Float` and `Double` ([CLC proposal #192](https://github.com/haskell/core-libraries-committee/issues/192))
 
 ## 4.18.0.0 *March 2023*
   * Shipped with GHC 9.6.1


=====================================
libraries/base/tests/all.T
=====================================
@@ -14,6 +14,7 @@ def normalise_quotes (str):
 #--------------------------------------
 test('SystemInfoTest', normal, compile_and_run, [''])
 test('readFloat', exit_code(1), compile_and_run, [''])
+test('read-float-double', normal, compile_and_run, [''])
 test('enumDouble', normal, compile_and_run, [''])
 test('enumRatio', normal, compile_and_run, [''])
 test('enumNumeric', normal, compile_and_run, [''])


=====================================
libraries/base/tests/read-float-double.hs
=====================================
@@ -0,0 +1,20 @@
+-- Test edge cases fixed in
+-- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10933
+
+main :: IO ()
+main = do
+  let
+    lo = toInteger (minBound :: Int)
+    hi = toInteger (maxBound :: Int)
+    readDouble = read :: String -> Double
+    readFloat = read :: String -> Float
+
+  print $ readDouble ("1e" <> show lo)
+  print $ readDouble ("1e" <> show (lo - 1))
+  print $ readDouble ("0.01e" <> show lo)
+  print $ readDouble ("10e" <> show hi)
+
+  print $ readFloat ("1e" <> show lo)
+  print $ readFloat ("1e" <> show (lo - 1))
+  print $ readFloat ("0.01e" <> show lo)
+  print $ readFloat ("10e" <> show hi)


=====================================
libraries/base/tests/read-float-double.stdout
=====================================
@@ -0,0 +1,8 @@
+0.0
+0.0
+0.0
+Infinity
+0.0
+0.0
+0.0
+Infinity



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4bc7b1e5abaee101198c336ea2ff9c1d0c12149d

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4bc7b1e5abaee101198c336ea2ff9c1d0c12149d
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230808/847857fa/attachment-0001.html>