Bignum: fix bogus rewrite rule (#19345)

Fix the following rule:

  "fromIntegral/Int->Natural" fromIntegral = naturalFromWord . fromIntegral

Its type wasn't constrained to Int hence #19345.

4 files changed, 31 insertions, 5 deletions

diff --git a/libraries/base/GHC/Real.hs b/libraries/base/GHC/Real.hs
index ee61e34e70..4329bb7355 100644
--- a/libraries/base/GHC/Real.hs
+++ b/libraries/base/GHC/Real.hs
@@ -580,14 +580,25 @@ fromIntegral = fromInteger . toInteger
     #-}
 
 {-# RULES
-"fromIntegral/Natural->Natural"  fromIntegral = id :: Natural -> Natural
-"fromIntegral/Natural->Integer"  fromIntegral = toInteger :: Natural->Integer
-"fromIntegral/Natural->Word"     fromIntegral = naturalToWord
+"fromIntegral/Natural->Natural"  fromIntegral = id            :: Natural -> Natural
+"fromIntegral/Natural->Integer"  fromIntegral = toInteger     :: Natural -> Integer
+"fromIntegral/Natural->Word"     fromIntegral = naturalToWord :: Natural -> Word
   #-}
 
+-- Don't forget the type signatures in the following rules! Without a type
+-- signature we end up with the rule:
+--
+--  "fromIntegral/Int->Natural" forall a (d::Integral a).
+--        fromIntegral @a @Natural = naturalFromWord . fromIntegral @a d
+--
+-- but this rule is certainly not valid for every Integral type a!
+--
+-- This rule wraps any Integral input into Word's range. As a consequence,
+-- (2^64 :: Integer) was incorrectly wrapped to (0 :: Natural), see #19345.
+
 {-# RULES
-"fromIntegral/Word->Natural"    fromIntegral = naturalFromWord
-"fromIntegral/Int->Natural"     fromIntegral = naturalFromWord . fromIntegral
+"fromIntegral/Word->Natural"    fromIntegral = naturalFromWord                :: Word -> Natural
+"fromIntegral/Int->Natural"     fromIntegral = naturalFromWord . fromIntegral :: Int -> Natural
   #-}
 
 -- | general coercion to fractional types
diff --git a/testsuite/tests/lib/integer/T19345.hs b/testsuite/tests/lib/integer/T19345.hs
new file mode 100644
index 0000000000..41313a44e5
--- /dev/null
+++ b/testsuite/tests/lib/integer/T19345.hs
@@ -0,0 +1,12 @@
+{-# OPTIONS_GHC -O #-}
+module Main where
+
+import Numeric.Natural
+  ( Natural )
+
+a, q :: Natural
+a = fromIntegral ( 18446744073709551616 :: Integer )
+q = 18446744073709551616
+
+main :: IO ()
+main = print ( fromIntegral ( a `div` q ) :: Word )
diff --git a/testsuite/tests/lib/integer/T19345.stdout b/testsuite/tests/lib/integer/T19345.stdout
new file mode 100644
index 0000000000..d00491fd7e
--- /dev/null
+++ b/testsuite/tests/lib/integer/T19345.stdout
@@ -0,0 +1 @@
+1
diff --git a/testsuite/tests/lib/integer/all.T b/testsuite/tests/lib/integer/all.T
index 740fa0e606..7c9720ed1f 100644
--- a/testsuite/tests/lib/integer/all.T
+++ b/testsuite/tests/lib/integer/all.T
@@ -23,3 +23,5 @@ test('integerImportExport', [omit_ways(['ghci'])], compile_and_run, [''])
 
 # Disable GMP only tests
 #test('integerGmpInternals', [], compile_and_run, [''])
+
+test('T19345', [], compile_and_run, [''])