{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UnliftedFFITypes #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GHCForeignImportPrim #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE NoImplicitPrelude #-}
#include "MachDeps.h"
module GHC.Integer.GMP.Internals
(
Integer(..)
, isValidInteger#
, module GHC.Integer
, bitInteger
, popCountInteger
, gcdInteger
, gcdExtInteger
, lcmInteger
, sqrInteger
, powModInteger
, powModSecInteger
, recipModInteger
, wordToNegInteger
, bigNatToInteger
, bigNatToNegInteger
, BigNat(..)
, GmpLimb, GmpLimb#
, GmpSize, GmpSize#
, isValidBigNat#
, sizeofBigNat#
, zeroBigNat
, oneBigNat
, nullBigNat
, byteArrayToBigNat#
, wordToBigNat
, wordToBigNat2
, bigNatToInt
, bigNatToWord
, indexBigNat#
, plusBigNat
, plusBigNatWord
, minusBigNat
, minusBigNatWord
, timesBigNat
, timesBigNatWord
, sqrBigNat
, quotRemBigNat
, quotRemBigNatWord
, quotBigNatWord
, quotBigNat
, remBigNat
, remBigNatWord
, gcdBigNat
, gcdBigNatWord
, powModBigNat
, powModBigNatWord
, recipModBigNat
, shiftRBigNat
, shiftLBigNat
, testBitBigNat
, clearBitBigNat
, complementBitBigNat
, setBitBigNat
, andBigNat
, xorBigNat
, popCountBigNat
, orBigNat
, bitBigNat
, isZeroBigNat
, isNullBigNat#
, compareBigNatWord
, compareBigNat
, eqBigNatWord
, eqBigNatWord#
, eqBigNat
, eqBigNat#
, gtBigNatWord#
, gcdInt
, gcdWord
, powModWord
, recipModWord
, testPrimeInteger
, testPrimeBigNat
, testPrimeWord#
, nextPrimeInteger
, nextPrimeBigNat
, nextPrimeWord#
, sizeInBaseBigNat
, sizeInBaseInteger
, sizeInBaseWord#
, exportBigNatToAddr
, exportIntegerToAddr
, exportWordToAddr
, exportBigNatToMutableByteArray
, exportIntegerToMutableByteArray
, exportWordToMutableByteArray
, importBigNatFromAddr
, importIntegerFromAddr
, importBigNatFromByteArray
, importIntegerFromByteArray
) where
import GHC.Integer.Type
import GHC.Integer
import GHC.Prim
import GHC.Types
default ()
sizeInBaseInteger :: Integer -> Int# -> Word#
sizeInBaseInteger (S# i#) = sizeInBaseWord# (int2Word# (absI# i#))
sizeInBaseInteger (Jp# bn) = sizeInBaseBigNat bn
sizeInBaseInteger (Jn# bn) = sizeInBaseBigNat bn
sizeInBaseBigNat :: BigNat -> Int# -> Word#
sizeInBaseBigNat bn@(BN# ba#) = c_mpn_sizeinbase# ba# (sizeofBigNat# bn)
foreign import ccall unsafe "integer_gmp_mpn_sizeinbase"
c_mpn_sizeinbase# :: ByteArray# -> GmpSize# -> Int# -> Word#
foreign import ccall unsafe "integer_gmp_mpn_sizeinbase1"
sizeInBaseWord# :: Word# -> Int# -> Word#
exportIntegerToAddr :: Integer -> Addr# -> Int# -> IO Word
exportIntegerToAddr (S# i#) = exportWordToAddr (W# (int2Word# (absI# i#)))
exportIntegerToAddr (Jp# bn) = exportBigNatToAddr bn
exportIntegerToAddr (Jn# bn) = exportBigNatToAddr bn
exportBigNatToAddr :: BigNat -> Addr# -> Int# -> IO Word
exportBigNatToAddr bn@(BN# ba#) addr e
= c_mpn_exportToAddr# ba# (sizeofBigNat# bn) addr 0# e
foreign import ccall unsafe "integer_gmp_mpn_export"
c_mpn_exportToAddr# :: ByteArray# -> GmpSize# -> Addr# -> Int# -> Int#
-> IO Word
exportWordToAddr :: Word -> Addr# -> Int# -> IO Word
exportWordToAddr (W# w#) addr
= c_mpn_export1ToAddr# w# addr 0#
foreign import ccall unsafe "integer_gmp_mpn_export1"
c_mpn_export1ToAddr# :: GmpLimb# -> Addr# -> Int# -> Int#
-> IO Word
exportIntegerToMutableByteArray :: Integer -> MutableByteArray# RealWorld
-> Word# -> Int# -> IO Word
exportIntegerToMutableByteArray (S# i#)
= exportWordToMutableByteArray (W# (int2Word# (absI# i#)))
exportIntegerToMutableByteArray (Jp# bn) = exportBigNatToMutableByteArray bn
exportIntegerToMutableByteArray (Jn# bn) = exportBigNatToMutableByteArray bn
exportBigNatToMutableByteArray :: BigNat -> MutableByteArray# RealWorld -> Word#
-> Int# -> IO Word
exportBigNatToMutableByteArray bn@(BN# ba#)
= c_mpn_exportToMutableByteArray# ba# (sizeofBigNat# bn)
foreign import ccall unsafe "integer_gmp_mpn_export"
c_mpn_exportToMutableByteArray# :: ByteArray# -> GmpSize#
-> MutableByteArray# RealWorld -> Word#
-> Int# -> IO Word
exportWordToMutableByteArray :: Word -> MutableByteArray# RealWorld -> Word#
-> Int# -> IO Word
exportWordToMutableByteArray (W# w#) = c_mpn_export1ToMutableByteArray# w#
foreign import ccall unsafe "integer_gmp_mpn_export1"
c_mpn_export1ToMutableByteArray# :: GmpLimb# -> MutableByteArray# RealWorld
-> Word# -> Int# -> IO Word
{-# NOINLINE testPrimeInteger #-}
testPrimeInteger :: Integer -> Int# -> Int#
testPrimeInteger (S# i#) = testPrimeWord# (int2Word# (absI# i#))
testPrimeInteger (Jp# n) = testPrimeBigNat n
testPrimeInteger (Jn# n) = testPrimeBigNat n
testPrimeBigNat :: BigNat -> Int# -> Int#
testPrimeBigNat bn@(BN# ba#) = c_integer_gmp_test_prime# ba# (sizeofBigNat# bn)
foreign import ccall unsafe "integer_gmp_test_prime"
c_integer_gmp_test_prime# :: ByteArray# -> GmpSize# -> Int# -> Int#
foreign import ccall unsafe "integer_gmp_test_prime1"
testPrimeWord# :: GmpLimb# -> Int# -> Int#
{-# NOINLINE nextPrimeInteger #-}
nextPrimeInteger :: Integer -> Integer
nextPrimeInteger (S# i#)
| isTrue# (i# ># 1#) = wordToInteger (nextPrimeWord# (int2Word# i#))
| True = S# 2#
nextPrimeInteger (Jp# bn) = Jp# (nextPrimeBigNat bn)
nextPrimeInteger (Jn# _) = S# 2#
foreign import ccall unsafe "integer_gmp_next_prime1"
nextPrimeWord# :: GmpLimb# -> GmpLimb#