module GHC.Num.Backend.GMP where
#include "MachDeps.h"
#include "WordSize.h"
import GHC.Num.WordArray
import GHC.Num.Primitives
import GHC.Prim
import GHC.Types
import GHC.Magic (runRW#)
import GHC.Num.Integer
import GHC.Num.BigNat
import GHC.Num.Natural
default ()
type GmpLimb = Word
type GmpLimb# = Word#
type GmpSize = Int
type GmpSize# = Int#
narrowGmpSize# :: Int# -> Int#
#if SIZEOF_LONG == SIZEOF_HSWORD
narrowGmpSize# x = x
#elif (SIZEOF_LONG == 4) && (SIZEOF_HSWORD == 8)
narrowGmpSize# = narrow32Int#
#endif
narrowCInt# :: Int# -> Int#
narrowCInt# = narrow32Int#
bignat_compare :: WordArray# -> WordArray# -> Int#
bignat_compare x y = narrowCInt# (c_mpn_cmp x y (wordArraySize# x))
bignat_add
:: MutableWordArray# RealWorld
-> WordArray#
-> WordArray#
-> State# RealWorld
-> State# RealWorld
bignat_add mwa wa wb s
| isTrue# (wordArraySize# wb ># wordArraySize# wa)
= case ioWord# (c_mpn_add mwa wb (wordArraySize# wb) wa (wordArraySize# wa)) s of
(# s', c #) -> mwaWriteMostSignificant mwa c s'
| True
= case ioWord# (c_mpn_add mwa wa (wordArraySize# wa) wb (wordArraySize# wb)) s of
(# s', c #) -> mwaWriteMostSignificant mwa c s'
bignat_add_word
:: MutableWordArray# RealWorld
-> WordArray#
-> Word#
-> State# RealWorld
-> State# RealWorld
bignat_add_word mwa wa b s = do
case ioWord# (c_mpn_add_1 mwa wa (wordArraySize# wa) b) s of
(# s', c #) -> mwaWriteMostSignificant mwa c s'
bignat_sub
:: MutableWordArray# RealWorld
-> WordArray#
-> WordArray#
-> State# RealWorld
-> (# State# RealWorld, Bool# #)
bignat_sub mwa wa wb s =
case ioWord# (c_mpn_sub mwa wa (wordArraySize# wa) wb (wordArraySize# wb)) s of
(# s', 1## #) -> (# s', 0# #)
(# s', _ #) -> (# s', 1# #)
bignat_sub_word
:: MutableWordArray# RealWorld
-> WordArray#
-> Word#
-> State# RealWorld
-> (# State# RealWorld, Bool# #)
bignat_sub_word mwa wa b s =
case ioWord# (c_mpn_sub_1 mwa wa (wordArraySize# wa) b) s of
(# s', 1## #) -> (# s', 0# #)
(# s', _ #) -> (# s', 1# #)
bignat_mul
:: MutableWordArray# RealWorld
-> WordArray#
-> WordArray#
-> State# RealWorld
-> State# RealWorld
bignat_mul mwa wa wb s = do
case ioWord# (c_mpn_mul mwa wa (wordArraySize# wa) wb (wordArraySize# wb)) s of
(# s', _msl #) -> s'
bignat_mul_word
:: MutableWordArray# RealWorld
-> WordArray#
-> Word#
-> State# RealWorld
-> State# RealWorld
bignat_mul_word mwa wa b s =
case ioWord# (c_mpn_mul_1 mwa wa (wordArraySize# wa) b) s of
(# s', c #) -> mwaWriteMostSignificant mwa c s'
bignat_popcount :: WordArray# -> Word#
bignat_popcount wa = c_mpn_popcount wa (wordArraySize# wa)
bignat_shiftl
:: MutableWordArray# RealWorld
-> WordArray#
-> Word#
-> State# RealWorld
-> State# RealWorld
bignat_shiftl mwa wa n s =
case ioWord# (c_mpn_lshift mwa wa (wordArraySize# wa) n) s of
(# s', _msl #) -> s'
bignat_shiftr
:: MutableWordArray# RealWorld
-> WordArray#
-> Word#
-> State# RealWorld
-> State# RealWorld
bignat_shiftr mwa wa n s =
case ioWord# (c_mpn_rshift mwa wa (wordArraySize# wa) n) s of
(# s', _msl #) -> s'
bignat_or
:: MutableWordArray# RealWorld
-> WordArray#
-> WordArray#
-> State# RealWorld
-> State# RealWorld
bignat_or mwa wa wb s1
| isTrue# (szA >=# szB) = go wa szA wb szB s1
| True = go wb szB wa szA s1
where
!szA = wordArraySize# wa
!szB = wordArraySize# wb
go wx nx wy ny s = case ioVoid (c_mpn_ior_n mwa wx wy ny) s of
s' -> mwaArrayCopy# mwa ny wx ny (nx -# ny) s'
bignat_xor
:: MutableWordArray# RealWorld
-> WordArray#
-> WordArray#
-> State# RealWorld
-> State# RealWorld
bignat_xor mwa wa wb s1
| isTrue# (szA >=# szB) = go wa szA wb szB s1
| True = go wb szB wa szA s1
where
!szA = wordArraySize# wa
!szB = wordArraySize# wb
go wx nx wy ny s = case ioVoid (c_mpn_xor_n mwa wx wy ny) s of
s' -> mwaArrayCopy# mwa ny wx ny (nx -# ny) s'
bignat_and
:: MutableWordArray# RealWorld
-> WordArray#
-> WordArray#
-> State# RealWorld
-> State# RealWorld
bignat_and mwa wa wb s = ioVoid (c_mpn_and_n mwa wa wb sz) s
where
!szA = wordArraySize# wa
!szB = wordArraySize# wb
!sz = minI# szA szB
bignat_and_not
:: MutableWordArray# RealWorld
-> WordArray#
-> WordArray#
-> State# RealWorld
-> State# RealWorld
bignat_and_not mwa wa wb s =
case ioVoid (c_mpn_andn_n mwa wa wb n) s of
s' -> mwaArrayCopy# mwa szB wa szB (szA -# szB) s'
where
!szA = wordArraySize# wa
!szB = wordArraySize# wb
!n = minI# szA szB
bignat_quotrem
:: MutableWordArray# RealWorld
-> MutableWordArray# RealWorld
-> WordArray#
-> WordArray#
-> State# RealWorld
-> State# RealWorld
bignat_quotrem mwq mwr wa wb s =
ioVoid (c_mpn_tdiv_qr mwq mwr 0# wa szA wb szB) s
where
szA = wordArraySize# wa
szB = wordArraySize# wb
bignat_quot
:: MutableWordArray# RealWorld
-> WordArray#
-> WordArray#
-> State# RealWorld
-> State# RealWorld
bignat_quot mwq wa wb s =
ioVoid (c_mpn_tdiv_q mwq wa szA wb szB) s
where
szA = wordArraySize# wa
szB = wordArraySize# wb
bignat_rem
:: MutableWordArray# RealWorld
-> WordArray#
-> WordArray#
-> State# RealWorld
-> State# RealWorld
bignat_rem mwr wa wb s =
ioVoid (c_mpn_tdiv_r mwr wa szA wb szB) s
where
szA = wordArraySize# wa
szB = wordArraySize# wb
bignat_quotrem_word
:: MutableWordArray# RealWorld
-> WordArray#
-> Word#
-> State# RealWorld
-> (# State# RealWorld, Word# #)
bignat_quotrem_word mwq wa b s =
ioWord# (c_mpn_divrem_1 mwq 0# wa szA b) s
where
szA = wordArraySize# wa
bignat_quot_word
:: MutableWordArray# RealWorld
-> WordArray#
-> Word#
-> State# RealWorld
-> State# RealWorld
bignat_quot_word mwq wa b s =
case bignat_quotrem_word mwq wa b s of
(# s', _ #) -> s'
bignat_rem_word
:: WordArray#
-> Word#
-> Word#
bignat_rem_word wa b =
c_mpn_mod_1 wa (wordArraySize# wa) b
bignat_gcd
:: MutableWordArray# RealWorld
-> WordArray#
-> WordArray#
-> State# RealWorld
-> State# RealWorld
bignat_gcd mwr wa wb s =
case ioInt# (c_mpn_gcd# mwr wa (wordArraySize# wa) wb (wordArraySize# wb)) s of
(# s', sz #) -> mwaSetSize# mwr (narrowGmpSize# sz) s'
bignat_gcd_word
:: WordArray#
-> Word#
-> Word#
bignat_gcd_word wa b = c_mpn_gcd_1# wa (wordArraySize# wa) b
bignat_gcd_word_word
:: Word#
-> Word#
-> Word#
bignat_gcd_word_word = integer_gmp_gcd_word
bignat_encode_double :: WordArray# -> Int# -> Double#
bignat_encode_double wa e = c_mpn_get_d wa (wordArraySize# wa) e
bignat_shiftr_neg
:: MutableWordArray# RealWorld
-> WordArray#
-> Word#
-> State# RealWorld
-> State# RealWorld
bignat_shiftr_neg mwa wa n s =
ioVoid (c_mpn_rshift_2c mwa wa (wordArraySize# wa) n) s
bignat_powmod_word
:: WordArray#
-> WordArray#
-> Word#
-> Word#
bignat_powmod_word b e m =
integer_gmp_powm1# b (wordArraySize# b) e (wordArraySize# e) m
bignat_powmod_words
:: Word#
-> Word#
-> Word#
-> Word#
bignat_powmod_words = integer_gmp_powm_word
bignat_powmod
:: MutableWordArray# RealWorld
-> WordArray#
-> WordArray#
-> WordArray#
-> State# RealWorld
-> State# RealWorld
bignat_powmod r b e m s = sbignat_powmod r (wordArraySize# b) b e m s
integer_powmod
:: Integer
-> Natural
-> Natural
-> Natural
integer_powmod b e m = naturalFromBigNat# (withNewWordArray# szm io)
where
!be = naturalToBigNat# e
!bm = naturalToBigNat# m
!(# sb, bb #) = integerToBigNatSign# b
!szb = bigNatSize# bb
!szm = bigNatSize# bm
!ssb = case sb of
0# -> szb
_ -> negateInt# szb
io r s = sbignat_powmod r ssb bb be bm s
sbignat_powmod
:: MutableWordArray# RealWorld
-> Int#
-> WordArray#
-> WordArray#
-> WordArray#
-> State# RealWorld
-> State# RealWorld
sbignat_powmod r b_signed_size b e m s =
case ioInt# (integer_gmp_powm# r b b_signed_size e (wordArraySize# e) m (wordArraySize# m)) s of
(# s', n #) -> mwaSetSize# r (narrowGmpSize# n) s'
integer_gcde
:: Integer
-> Integer
-> (# Integer, Integer, Integer #)
integer_gcde a b = case runRW# io of (# _, a #) -> a
where
!(# sa, ba #) = integerToBigNatSign# a
!(# sb, bb #) = integerToBigNatSign# b
!sza = bigNatSize# ba
!szb = bigNatSize# bb
!ssa = case sa of
0# -> sza
_ -> negateInt# sza
!ssb = case sb of
0# -> szb
_ -> negateInt# szb
!g_init_sz = minI# sza szb
!x_init_sz = szb
!y_init_sz = sza
io s =
case newWordArray# g_init_sz s of { (# s, mbg #) ->
case newWordArray# x_init_sz s of { (# s, mbx #) ->
case newWordArray# y_init_sz s of { (# s, mby #) ->
case newPinnedByteArray# 12# s of { (# s, mszs #) ->
case unsafeFreezeByteArray# mszs s of { (# s, szs #) ->
let !ssx_ptr = byteArrayContents# szs in
let !ssy_ptr = ssx_ptr `plusAddr#` 4# in
let !sg_ptr = ssy_ptr `plusAddr#` 4# in
case ioVoid (integer_gmp_gcdext# mbx ssx_ptr mby ssy_ptr mbg sg_ptr ba ssa bb ssb) s of { s ->
case readInt32OffAddr# ssx_ptr 0# s of { (# s, ssx #) ->
case readInt32OffAddr# ssy_ptr 0# s of { (# s, ssy #) ->
case readInt32OffAddr# sg_ptr 0# s of { (# s, sg #) ->
case touch# szs s of { s ->
let !sx = absI# (int32ToInt# ssx) in
let !sy = absI# (int32ToInt# ssy) in
case mwaSetSize# mbx sx s of { s ->
case mwaSetSize# mby sy s of { s ->
case mwaSetSize# mbg (int32ToInt# sg) s of { s ->
case unsafeFreezeByteArray# mbx s of { (# s, bx #) ->
case unsafeFreezeByteArray# mby s of { (# s, by #) ->
case unsafeFreezeByteArray# mbg s of { (# s, bg #) ->
(# s, (# integerFromBigNat# bg
, integerFromBigNatSign# (int32ToInt# ssx <# 0#) bx
, integerFromBigNatSign# (int32ToInt# ssy <# 0#) by #) #)
}}}}}}}}}}}}}}}}
integer_recip_mod
:: Integer
-> Natural
-> (# Natural | () #)
integer_recip_mod x m =
let
!(# sign_x, bx #) = integerToBigNatSign# x
!bm = naturalToBigNat# m
!br = sbignat_recip_mod sign_x bx bm
in if isTrue# (bigNatIsZero# br)
then (# | () #)
else (# naturalFromBigNat# br | #)
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
0# -> szx
_ -> negateInt# szx
foreign import ccall unsafe "integer_gmp_gcd_word"
integer_gmp_gcd_word :: GmpLimb# -> GmpLimb# -> GmpLimb#
foreign import ccall unsafe "integer_gmp_mpn_gcd_1"
c_mpn_gcd_1# :: ByteArray# -> GmpSize# -> GmpLimb# -> GmpLimb#
foreign import ccall unsafe "integer_gmp_mpn_gcd"
c_mpn_gcd# :: MutableByteArray# s -> ByteArray# -> GmpSize#
-> ByteArray# -> GmpSize# -> IO GmpSize
foreign import ccall unsafe "integer_gmp_gcdext" integer_gmp_gcdext#
:: MutableByteArray# s -> Addr#
-> MutableByteArray# s -> Addr#
-> MutableByteArray# s -> Addr#
-> ByteArray# -> GmpSize#
-> ByteArray# -> GmpSize#
-> IO ()
foreign import ccall unsafe "integer_gmp_invert"
integer_gmp_invert# :: MutableByteArray# RealWorld
-> ByteArray# -> GmpSize#
-> ByteArray# -> GmpSize# -> IO GmpSize
foreign import ccall unsafe "gmp.h __gmpn_add_1"
c_mpn_add_1 :: MutableByteArray# s -> ByteArray# -> GmpSize# -> GmpLimb#
-> IO GmpLimb
foreign import ccall unsafe "gmp.h __gmpn_sub_1"
c_mpn_sub_1 :: MutableByteArray# s -> ByteArray# -> GmpSize# -> GmpLimb#
-> IO GmpLimb
foreign import ccall unsafe "gmp.h __gmpn_mul_1"
c_mpn_mul_1 :: MutableByteArray# s -> ByteArray# -> GmpSize# -> GmpLimb#
-> IO GmpLimb
foreign import ccall unsafe "gmp.h __gmpn_add"
c_mpn_add :: MutableByteArray# s -> ByteArray# -> GmpSize#
-> ByteArray# -> GmpSize# -> IO GmpLimb
foreign import ccall unsafe "gmp.h __gmpn_sub"
c_mpn_sub :: MutableByteArray# s -> ByteArray# -> GmpSize# -> ByteArray#
-> GmpSize# -> IO GmpLimb
foreign import ccall unsafe "gmp.h __gmpn_mul"
c_mpn_mul :: MutableByteArray# s -> ByteArray# -> GmpSize# -> ByteArray#
-> GmpSize# -> IO GmpLimb
foreign import ccall unsafe "gmp.h __gmpn_cmp"
c_mpn_cmp :: ByteArray# -> ByteArray# -> GmpSize# -> Int#
foreign import ccall unsafe "gmp.h __gmpn_tdiv_qr"
c_mpn_tdiv_qr :: MutableByteArray# s -> MutableByteArray# s -> GmpSize#
-> ByteArray# -> GmpSize# -> ByteArray# -> GmpSize# -> IO ()
foreign import ccall unsafe "integer_gmp_mpn_tdiv_q"
c_mpn_tdiv_q :: MutableByteArray# s -> ByteArray# -> GmpSize# -> ByteArray#
-> GmpSize# -> IO ()
foreign import ccall unsafe "integer_gmp_mpn_tdiv_r"
c_mpn_tdiv_r :: MutableByteArray# s -> ByteArray# -> GmpSize# -> ByteArray#
-> GmpSize# -> IO ()
foreign import ccall unsafe "gmp.h __gmpn_divrem_1"
c_mpn_divrem_1 :: MutableByteArray# s -> GmpSize# -> ByteArray# -> GmpSize#
-> GmpLimb# -> IO GmpLimb
foreign import ccall unsafe "gmp.h __gmpn_mod_1"
c_mpn_mod_1 :: ByteArray# -> GmpSize# -> GmpLimb# -> GmpLimb#
foreign import ccall unsafe "integer_gmp_mpn_rshift"
c_mpn_rshift :: MutableByteArray# s -> ByteArray# -> GmpSize# -> Word#
-> IO GmpLimb
foreign import ccall unsafe "integer_gmp_mpn_rshift_2c"
c_mpn_rshift_2c :: MutableByteArray# s -> ByteArray# -> GmpSize# -> Word#
-> IO GmpLimb
foreign import ccall unsafe "integer_gmp_mpn_lshift"
c_mpn_lshift :: MutableByteArray# s -> ByteArray# -> GmpSize# -> Word#
-> IO GmpLimb
foreign import ccall unsafe "integer_gmp_mpn_and_n"
c_mpn_and_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize#
-> IO ()
foreign import ccall unsafe "integer_gmp_mpn_andn_n"
c_mpn_andn_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize#
-> IO ()
foreign import ccall unsafe "integer_gmp_mpn_ior_n"
c_mpn_ior_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize#
-> IO ()
foreign import ccall unsafe "integer_gmp_mpn_xor_n"
c_mpn_xor_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize#
-> IO ()
foreign import ccall unsafe "gmp.h __gmpn_popcount"
c_mpn_popcount :: ByteArray# -> GmpSize# -> Word#
foreign import ccall unsafe "integer_gmp_mpn_get_d"
c_mpn_get_d :: ByteArray# -> GmpSize# -> Int# -> Double#
foreign import ccall unsafe "integer_gmp_powm"
integer_gmp_powm# :: MutableByteArray# RealWorld
-> ByteArray# -> GmpSize# -> ByteArray# -> GmpSize#
-> ByteArray# -> GmpSize# -> IO GmpSize
foreign import ccall unsafe "integer_gmp_powm_word"
integer_gmp_powm_word :: GmpLimb# -> GmpLimb# -> GmpLimb# -> GmpLimb#
foreign import ccall unsafe "integer_gmp_powm1"
integer_gmp_powm1# :: ByteArray# -> GmpSize# -> ByteArray# -> GmpSize#
-> GmpLimb# -> GmpLimb#