[Git][ghc/ghc][master] Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals

[Marge Bot (@marge-bot)]

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


Commits:
4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00
Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals

- - - - -


3 changed files:

- libraries/template-haskell/Language/Haskell/TH/Ppr.hs
- testsuite/tests/th/T20454.hs
- testsuite/tests/th/T20454.stdout


Changes:

=====================================
libraries/template-haskell/Language/Haskell/TH/Ppr.hs
=====================================
@@ -302,27 +302,28 @@ pprLit _ (StringPrimL s) = pprString (bytesToString s) <> char '#'
 pprLit _ (BytesPrimL {}) = pprString "<binary data>"
 pprLit i (RationalL rat)
   | withoutFactor 2 (withoutFactor 5 $ denominator rat) /= 1
-  -- if the denominator has prime factors other than 2 and 5, show as fraction
+  -- if the denominator has prime factors other than 2 and 5
+  -- or can't be represented as Double, show as fraction
   = parensIf (i > noPrec) $
     integer (numerator rat) <+> char '/' <+> integer (denominator rat)
-  | rat /= 0 && (zeroes < -1 || zeroes > 7),
-    let (n, d) = properFraction (rat' / magnitude)
-        (rat', zeroes')
-          | abs rat < 1 = (10 * rat, zeroes - 1)
-          | otherwise = (rat, zeroes)
+  | rat /= 0 && (zeroes < -2 || zeroes > 6),
+    let (n, d) = properFraction (rat / magnitude)
   -- if < 0.01 or >= 100_000_000, use scientific notation
   = parensIf (i > noPrec && rat < 0)
              (integer n
               <> (if d == 0 then empty else char '.' <> decimals (abs d))
-              <> char 'e' <> integer zeroes')
+              <> char 'e' <> integer zeroes)
   | let (n, d) = properFraction rat
   = parensIf (i > noPrec && rat < 0)
              (integer n <> char '.'
               <> if d == 0 then char '0' else decimals (abs d))
   where zeroes :: Integer
-        zeroes = truncate (logBase 10 (abs (fromRational rat) :: Double)
-                           * (1 - epsilon))
-        epsilon = 0.0000001
+        zeroes = log10 (abs rat)
+        log10 :: Rational -> Integer
+        log10 x
+          | x >= 10 = 1 + log10 (x / 10)
+          | x < 1 = -1 + log10 (x * 10)
+          | otherwise = 0
         magnitude :: Rational
         magnitude = 10 ^^ zeroes
         withoutFactor :: Integer -> Integer -> Integer


=====================================
testsuite/tests/th/T20454.hs
=====================================
@@ -8,6 +8,7 @@ e1, e2 :: ExpQ
 
 e1 = [|   -- Test the Template Haskell pretty-printing of rational literals
      [0.0, 123.0, -321.0, 9e3, 10000.0, -500000000.0, 345e67, -456e78,
+      1e400, -1e400, -- T23571
       0.01, -0.002, 0.04e-56, -0.3e-65,
       0.33333333333333333333333333333, $(pure $ LitE $ RationalL $ 1/3)]
      |]


=====================================
testsuite/tests/th/T20454.stdout
=====================================
@@ -6,6 +6,8 @@
  -5e8,
  3.45e69,
  -4.56e80,
+ 1e400,
+ -1e400,
  0.01,
  -2e-3,
  4e-58,



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4af7eac2a00e86c29509c119aacc7511a9c7747d
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/20230704/670bbc86/attachment-0001.html>