Bignum: implement integerPowMod (#18427)

Incidentally fix powModInteger which was crashing in integer-gmp for
negative exponents when the modular multiplicative inverse for the base
didn't exist. Now we compute it explicitly with integerRecipMod so that
every backend returns the same result without crashing.

4 files changed, 36 insertions, 22 deletions

diff --git a/testsuite/tests/lib/integer/integerPowMod.hs b/testsuite/tests/lib/integer/integerPowMod.hs
index 497e96cbf9..7a027fcc8a 100644
--- a/testsuite/tests/lib/integer/integerPowMod.hs
+++ b/testsuite/tests/lib/integer/integerPowMod.hs
@@ -1,3 +1,6 @@
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE MagicHash #-}
+
 module Main (main) where
 
 import Data.List (group)
@@ -7,22 +10,33 @@ import Control.Monad
 
 import GHC.Word
 import GHC.Base
-import GHC.Natural
+import GHC.Num.Natural
+import GHC.Num.Integer
+
+integerPowMod :: Integer -> Integer -> Integer -> Maybe Integer
+integerPowMod b e m = case integerPowMod# b e (fromIntegral m) of
+   (# | () #) -> Nothing
+   (# r  | #) -> Just (fromIntegral r)
 
 main :: IO ()
 main = do
-    print $ powModNatural b e m
-    print $ powModNatural b e (m-1)
+    print $ naturalPowMod b e m
+    print $ naturalPowMod b e (m-1)
+
+    print $ integerPowMod b e m
+    print $ integerPowMod b e (m-1)
+
+    print $ integerPowMod b (-e) m
+    print $ integerPowMod b (-e) (m-1)
+
+    print $ integerPowMod (-b) e m
+    print $ integerPowMod (-b) e (m-1)
+
+    print $ integerPowMod (-b) (-e) m
+    print $ integerPowMod (-b) (-e) (m-1)
 
   where
+    b,e,m :: Num a => a
     b = 2988348162058574136915891421498819466320163312926952423791023078876139
     e = 2351399303373464486466122544523690094744975233415544072992656881240319
     m = 10^(40::Int)
-
-    x = 5328841272400314897981163497728751426
-    y = 32052182750761975518649228050096851724
-
-    b1024 = roll (map fromIntegral (take 128 [0x80::Int .. ]))
-
-    roll :: [Word8] -> Integer
-    roll = GHC.Base.foldr (\b a -> a `shiftL` 8 .|. fromIntegral b) 0
diff --git a/testsuite/tests/lib/integer/integerPowMod.stdout b/testsuite/tests/lib/integer/integerPowMod.stdout
index 64a4c568ac..c095505778 100644
--- a/testsuite/tests/lib/integer/integerPowMod.stdout
+++ b/testsuite/tests/lib/integer/integerPowMod.stdout
@@ -1,2 +1,10 @@
 1527229998585248450016808958343740453059
 682382427572745901624116300491295556924
+Just 1527229998585248450016808958343740453059
+Just 682382427572745901624116300491295556924
+Just 9710805908340105786808462779613285007339
+Nothing
+Just 8472770001414751549983191041656259546941
+Just 9317617572427254098375883699508704443075
+Just 289194091659894213191537220386714992661
+Nothing
diff --git a/testsuite/tests/lib/integer/integerRecipMod.hs b/testsuite/tests/lib/integer/integerRecipMod.hs
index e5de646790..aad4a7e33b 100644
--- a/testsuite/tests/lib/integer/integerRecipMod.hs
+++ b/testsuite/tests/lib/integer/integerRecipMod.hs
@@ -11,9 +11,10 @@ import Control.Monad
 import GHC.Word
 import GHC.Base
 import GHC.Num.Integer
+import GHC.Num.Natural
 import qualified GHC.Num.Integer as I
 
-recipModInteger :: Integer -> Integer -> Maybe Integer
+recipModInteger :: Integer -> Natural -> Maybe Natural
 recipModInteger x m = case I.integerRecipMod# x m of
    (# y |    #) -> Just y
    (#   | () #) -> Nothing
@@ -24,16 +25,9 @@ main = do
       f x = case recipModInteger x (2*3*11*11*17*17) of
                y -> fmap (x,) y
 
-      g x = case recipModInteger x (-2*3*11*11*17*17) of
-               y -> fmap (x,) y
-
    -- positive modulo
    print $ mapMaybe f [-7..71]
 
-   -- negative modulo
-   print $ mapMaybe g [-7..71]
-
-   -- modulo == 1, -1 or 0
+   -- modulo == 1 or 0
    print (recipModInteger 77 1)
-   print (recipModInteger 77 (-1))
    print (recipModInteger 77 0)
diff --git a/testsuite/tests/lib/integer/integerRecipMod.stdout b/testsuite/tests/lib/integer/integerRecipMod.stdout
index 205af95fb9..b55b6b4040 100644
--- a/testsuite/tests/lib/integer/integerRecipMod.stdout
+++ b/testsuite/tests/lib/integer/integerRecipMod.stdout
@@ -1,5 +1,3 @@
 [(-7,149867),(-5,167851),(-1,209813),(1,1),(5,41963),(7,59947),(13,177535),(19,143557),(23,182447),(25,134281),(29,7235),(31,33841),(35,95915),(37,113413),(41,61409),(43,24397),(47,174101),(49,158431),(53,193979),(59,188477),(61,185737),(65,35507),(67,118999),(71,186173)]
-[(-7,149867),(-5,167851),(-1,209813),(1,1),(5,41963),(7,59947),(13,177535),(19,143557),(23,182447),(25,134281),(29,7235),(31,33841),(35,95915),(37,113413),(41,61409),(43,24397),(47,174101),(49,158431),(53,193979),(59,188477),(61,185737),(65,35507),(67,118999),(71,186173)]
-Nothing
 Nothing
 Nothing