Detect underflow in fromIntegral/Int->Natural rule

Fix #20066

1 files changed, 15 insertions, 3 deletions

diff --git a/libraries/base/GHC/Real.hs b/libraries/base/GHC/Real.hs
index df4143e1ee..6c7ae43e5c 100644
--- a/libraries/base/GHC/Real.hs
+++ b/libraries/base/GHC/Real.hs
@@ -597,7 +597,7 @@ fromIntegral = fromInteger . toInteger
   #-}
 
 -- Don't forget the type signatures in the following rules! Without a type
--- signature we end up with the rule:
+-- signature we ended up with the rule:
 --
 --  "fromIntegral/Int->Natural" forall a (d::Integral a).
 --        fromIntegral @a @Natural = naturalFromWord . fromIntegral @a d
@@ -606,12 +606,24 @@ fromIntegral = fromInteger . toInteger
 --
 -- This rule wraps any Integral input into Word's range. As a consequence,
 -- (2^64 :: Integer) was incorrectly wrapped to (0 :: Natural), see #19345.
+--
+-- A follow-up issue with this rule was that no underflow exception was raised
+-- for negative Int values (see #20066). We now use a naturalFromInt helper
+-- function to restore this behavior.
 
 {-# RULES
-"fromIntegral/Word->Natural"    fromIntegral = naturalFromWord                :: Word -> Natural
-"fromIntegral/Int->Natural"     fromIntegral = naturalFromWord . fromIntegral :: Int -> Natural
+"fromIntegral/Word->Natural"    fromIntegral = naturalFromWord :: Word -> Natural
+"fromIntegral/Int->Natural"     fromIntegral = naturalFromInt  :: Int -> Natural
   #-}
 
+-- | Convert an Int into a Natural, throwing an underflow exception for negative
+-- values.
+naturalFromInt :: Int -> Natural
+{-# INLINE naturalFromInt #-}
+naturalFromInt x
+  | x < 0     = underflowError
+  | otherwise = naturalFromWord (fromIntegral x)
+
 -- | general coercion to fractional types
 realToFrac :: (Real a, Fractional b) => a -> b
 {-# NOINLINE [1] realToFrac #-}