summaryrefslogtreecommitdiff
path: root/libraries/ghc-bignum/src
diff options
context:
space:
mode:
Diffstat (limited to 'libraries/ghc-bignum/src')
-rw-r--r--libraries/ghc-bignum/src/GHC/Num/Backend/Check.hs15
-rw-r--r--libraries/ghc-bignum/src/GHC/Num/Backend/FFI.hs16
-rw-r--r--libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs31
-rw-r--r--libraries/ghc-bignum/src/GHC/Num/Backend/Native.hs14
-rw-r--r--libraries/ghc-bignum/src/GHC/Num/BigNat.hs-boot2
-rw-r--r--libraries/ghc-bignum/src/GHC/Num/Integer.hs24
-rw-r--r--libraries/ghc-bignum/src/GHC/Num/Integer.hs-boot4
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 #)
View Lorry Controller Status