diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
index 98c6d3c5cb5f456d6829824f0126bca776b5bf8b..001d82b50b92ef8099b5fbd831d2c7cbc5a83998 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
+++ b/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
diff --git a/testsuite/tests/th/T20454.hs b/testsuite/tests/th/T20454.hs
index bdc5a7e382e5b77d20bd44ef9f5f6220ca4c0e53..62605acf086e7b8fe6e3e5954fbfb6b1aec9e635 100644
--- a/testsuite/tests/th/T20454.hs
+++ b/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)]
      |]
diff --git a/testsuite/tests/th/T20454.stdout b/testsuite/tests/th/T20454.stdout
index 9035052bbe8f486933a20fea15090d4ee2c47fd5..9f9263c4c408671e7b0d7785245c5676a091b1f0 100644
--- a/testsuite/tests/th/T20454.stdout
+++ b/testsuite/tests/th/T20454.stdout
@@ -6,6 +6,8 @@
  -5e8,
  3.45e69,
  -4.56e80,
+ 1e400,
+ -1e400,
  0.01,
  -2e-3,
  4e-58,