diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2020-09-30 17:43:10 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-10-02 13:52:38 -0400 |
commit | 12c06927a03a2fdb516f7008c57d68568b02b576 (patch) | |
tree | c01860d5708f449e96722e4fa45d5dd992e03d28 /libraries/ghc-bignum/src/GHC | |
parent | 3c9beab75aaa5fbbb11132c99e2af114f322152f (diff) | |
download | haskell-12c06927a03a2fdb516f7008c57d68568b02b576.tar.gz |
Bignum: implement integerRecipMod (#18427)
Diffstat (limited to 'libraries/ghc-bignum/src/GHC')
-rw-r--r-- | libraries/ghc-bignum/src/GHC/Num/Backend/Check.hs | 15 | ||||
-rw-r--r-- | libraries/ghc-bignum/src/GHC/Num/Backend/FFI.hs | 16 | ||||
-rw-r--r-- | libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs | 31 | ||||
-rw-r--r-- | libraries/ghc-bignum/src/GHC/Num/Backend/Native.hs | 14 | ||||
-rw-r--r-- | libraries/ghc-bignum/src/GHC/Num/BigNat.hs-boot | 2 | ||||
-rw-r--r-- | libraries/ghc-bignum/src/GHC/Num/Integer.hs | 24 | ||||
-rw-r--r-- | libraries/ghc-bignum/src/GHC/Num/Integer.hs-boot | 4 |
7 files changed, 106 insertions, 0 deletions
diff --git a/libraries/ghc-bignum/src/GHC/Num/Backend/Check.hs b/libraries/ghc-bignum/src/GHC/Num/Backend/Check.hs index a8ee366312..9e5181c0bb 100644 --- a/libraries/ghc-bignum/src/GHC/Num/Backend/Check.hs +++ b/libraries/ghc-bignum/src/GHC/Num/Backend/Check.hs @@ -469,3 +469,18 @@ integer_gcde a b = then (# g0, x0, y0 #) else case unexpectedValue of !_ -> (# integerZero, integerZero, integerZero #) + +integer_recip_mod + :: Integer + -> Integer + -> (# Integer | () #) +integer_recip_mod x m = + let + !r0 = Other.integer_recip_mod x m + !r1 = Native.integer_recip_mod x m + in case (# r0, r1 #) of + (# (# | () #), (# | () #) #) -> r0 + (# (# y0 | #), (# y1 | #) #) + | isTrue# (integerEq# y0 y1) -> r0 + _ -> case unexpectedValue of + !_ -> (# | () #) diff --git a/libraries/ghc-bignum/src/GHC/Num/Backend/FFI.hs b/libraries/ghc-bignum/src/GHC/Num/Backend/FFI.hs index 3fddd19098..98350d4d29 100644 --- a/libraries/ghc-bignum/src/GHC/Num/Backend/FFI.hs +++ b/libraries/ghc-bignum/src/GHC/Num/Backend/FFI.hs @@ -596,3 +596,19 @@ integer_gcde = Native.integer_gcde -- for now we use Native's implementation. If some FFI backend user needs a -- specific implementation, we'll need to determine a prototype to pass and -- return BigNat signs and sizes via FFI. + + +-- | Computes the modular inverse of two non-zero integers. +-- +-- I.e. y = integer_recip_mod x m +-- = x^(-1) `mod` m +-- +-- with 0 < y < abs m +integer_recip_mod + :: Integer + -> Integer + -> (# Integer | () #) +integer_recip_mod = Native.integer_recip_mod + -- for now we use Native's implementation. If some FFI backend user needs a + -- specific implementation, we'll need to determine a prototype to pass and + -- return BigNat signs and sizes via FFI. diff --git a/libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs b/libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs index 10242dfdc7..462e67445c 100644 --- a/libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs +++ b/libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs @@ -423,6 +423,32 @@ integer_gcde a b = case runRW# io of (# _, a #) -> a +integer_recip_mod + :: Integer + -> Integer + -> (# Integer | () #) +integer_recip_mod x m = + let + !(# sign_x, bx #) = integerToBigNatSign# x + !(# _sign_m, bm #) = integerToBigNatSign# m + !br = sbignat_recip_mod sign_x bx bm + in if isTrue# (bigNatIsZero# br) + then (# | () #) + else (# integerFromBigNat# br | #) + + +-- | Return 0 for invalid inputs +sbignat_recip_mod :: Int# -> BigNat# -> BigNat# -> BigNat# +sbignat_recip_mod sign_x x m = withNewWordArray# szm io + where + io r s = case ioInt# (integer_gmp_invert# r x ssx m szm) s of + (# s, rn #) -> mwaSetSize# r (narrowGmpSize# rn) s + !szx = bigNatSize# x + !szm = bigNatSize# m + !ssx = case sign_x of -- signed size of x + 0# -> szx + _ -> negateInt# szx + ---------------------------------------------------------------------- -- FFI ccall imports @@ -444,6 +470,11 @@ foreign import ccall unsafe "integer_gmp_gcdext" integer_gmp_gcdext# -> ByteArray# -> GmpSize# -> IO () +foreign import ccall unsafe "integer_gmp_invert" + integer_gmp_invert# :: MutableByteArray# RealWorld + -> ByteArray# -> GmpSize# + -> ByteArray# -> GmpSize# -> IO GmpSize + -- mp_limb_t mpn_add_1 (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t n, -- mp_limb_t s2limb) foreign import ccall unsafe "gmp.h __gmpn_add_1" diff --git a/libraries/ghc-bignum/src/GHC/Num/Backend/Native.hs b/libraries/ghc-bignum/src/GHC/Num/Backend/Native.hs index db4196f51f..c5af604c17 100644 --- a/libraries/ghc-bignum/src/GHC/Num/Backend/Native.hs +++ b/libraries/ghc-bignum/src/GHC/Num/Backend/Native.hs @@ -737,3 +737,17 @@ integer_gcde a b = f (# a,integerOne,integerZero #) (# b,integerZero,integerOne | True = case integerQuotRem# old_g g of !(# q, r #) -> f new (# r , old_s `integerSub` (q `integerMul` s) , old_t `integerSub` (q `integerMul` t) #) + +integer_recip_mod + :: Integer + -> Integer + -> (# Integer | () #) +integer_recip_mod x m = + let m' = integerAbs m + in case integer_gcde x m' of + (# g, a, _b #) + -- gcd(x,m) = ax+mb = 1 + -- ==> ax - 1 = -mb + -- ==> ax = 1 [m] + | g `integerEq` integerOne -> (# a `integerMod` m' | #) + | True -> (# | () #) diff --git a/libraries/ghc-bignum/src/GHC/Num/BigNat.hs-boot b/libraries/ghc-bignum/src/GHC/Num/BigNat.hs-boot index 37edb97582..a62c07406d 100644 --- a/libraries/ghc-bignum/src/GHC/Num/BigNat.hs-boot +++ b/libraries/ghc-bignum/src/GHC/Num/BigNat.hs-boot @@ -5,11 +5,13 @@ module GHC.Num.BigNat where import GHC.Num.WordArray +import GHC.Num.Primitives import GHC.Prim type BigNat# = WordArray# data BigNat = BN# { unBigNat :: BigNat# } +bigNatIsZero# :: BigNat# -> Bool# bigNatSize# :: BigNat# -> Int# bigNatSubUnsafe :: BigNat# -> BigNat# -> BigNat# bigNatMulWord# :: BigNat# -> Word# -> BigNat# diff --git a/libraries/ghc-bignum/src/GHC/Num/Integer.hs b/libraries/ghc-bignum/src/GHC/Num/Integer.hs index daa7ab8388..7f0314f859 100644 --- a/libraries/ghc-bignum/src/GHC/Num/Integer.hs +++ b/libraries/ghc-bignum/src/GHC/Num/Integer.hs @@ -244,6 +244,11 @@ integerIsZero :: Integer -> Bool integerIsZero (IS 0#) = True integerIsZero _ = False +-- | One predicate +integerIsOne :: Integer -> Bool +integerIsOne (IS 1#) = True +integerIsOne _ = False + -- | Not-equal predicate. integerNe :: Integer -> Integer -> Bool integerNe !x !y = isTrue# (integerNe# x y) @@ -1217,3 +1222,22 @@ integerGcde -> ( Integer, Integer, Integer) integerGcde a b = case integerGcde# a b of (# g,x,y #) -> (g,x,y) + + +-- | Computes the modular inverse. +-- +-- I.e. y = integerRecipMod# x m +-- = x^(-1) `mod` m +-- +-- with 0 < y < |m| +-- +integerRecipMod# + :: Integer + -> Integer + -> (# Integer | () #) +integerRecipMod# x m + | integerIsZero x = (# | () #) + | integerIsZero m = (# | () #) + | IS 1# <- m = (# | () #) + | IS (-1#) <- m = (# | () #) + | True = Backend.integer_recip_mod x m diff --git a/libraries/ghc-bignum/src/GHC/Num/Integer.hs-boot b/libraries/ghc-bignum/src/GHC/Num/Integer.hs-boot index a07b9b7548..e9c2d003ca 100644 --- a/libraries/ghc-bignum/src/GHC/Num/Integer.hs-boot +++ b/libraries/ghc-bignum/src/GHC/Num/Integer.hs-boot @@ -17,11 +17,15 @@ integerEq# :: Integer -> Integer -> Int# integerEq :: Integer -> Integer -> Bool integerGt :: Integer -> Integer -> Bool integerIsZero :: Integer -> Bool +integerIsOne :: Integer -> Bool integerIsNegative :: Integer -> Bool integerSub :: Integer -> Integer -> Integer integerMul :: Integer -> Integer -> Integer +integerMod :: Integer -> Integer -> Integer +integerRem :: Integer -> Integer -> Integer integerNegate :: Integer -> Integer +integerAbs :: Integer -> Integer integerDivMod# :: Integer -> Integer -> (# Integer, Integer #) integerQuotRem# :: Integer -> Integer -> (# Integer, Integer #) |