{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
module Data.GMP ( GMPInt (..)
, gmpToInteger
, conjugateGMP
, integerToGMP
) where
import Control.Monad ((<=<))
import Data.Functor.Foldable
import Data.Word
import Foreign
import Foreign.C
data GMPInt = GMPInt {
_mp_alloc :: !Word32
, _mp_size :: !Word32
, _mp_d :: !(Ptr Word64)
}
foreign import capi "&__gmpz_clear" mpz_clear :: FunPtr (Ptr GMPInt -> IO ())
wordWidth :: Int
wordWidth = sizeOf (undefined :: Word32)
ptrWidth :: Int
ptrWidth = sizeOf (undefined :: Ptr Word64)
gmpToList :: GMPInt -> IO [Word64]
gmpToList (GMPInt _ s aptr) = peekArray (fromIntegral s) aptr
integerToWordList :: Integer -> [Word64]
integerToWordList = coelgot pa c where
pa (i, ws) | i < 2 ^ (64 :: Int) = [fromIntegral i]
| otherwise = embed ws
c i = Cons (fromIntegral (i `mod` (2 ^ (64 :: Int)))) (i `div` (2 ^ (64 :: Int)))
{-# INLINEABLE integerToWordList #-}
wordListToInteger :: [Word64] -> Integer
wordListToInteger = cata a where
a Nil = 0
a (Cons x xs) = fromIntegral x + (2 ^ (64 :: Int)) * xs
{-# INLINEABLE wordListToInteger #-}
integerToGMP :: Integer -> IO GMPInt
integerToGMP i = GMPInt l l <$> newArray ls
where l = fromIntegral . length $ ls
ls = integerToWordList i
gmpForeignPtr :: Ptr GMPInt -> IO (ForeignPtr GMPInt)
gmpForeignPtr = newForeignPtr mpz_clear
conjugateGMP :: (CInt -> Ptr GMPInt) -> Int -> IO Integer
conjugateGMP f = gmpToInteger <=< flip withForeignPtr peek <=< (gmpForeignPtr . f . fromIntegral)
gmpToInteger :: GMPInt -> IO Integer
gmpToInteger = fmap wordListToInteger . gmpToList
instance Storable GMPInt where
sizeOf _ = 2 * wordWidth + ptrWidth
{-# INLINEABLE sizeOf #-}
alignment _ = gcd wordWidth ptrWidth
{-# INLINEABLE alignment #-}
peek ptr = GMPInt <$> peekByteOff ptr 0 <*> peekByteOff ptr wordWidth <*> peekByteOff ptr (wordWidth * 2)
{-# INLINEABLE peek #-}
poke ptr (GMPInt a s d) =
pokeByteOff ptr 0 a >>
pokeByteOff ptr wordWidth s >>
pokeByteOff ptr (wordWidth * 2) d
{-# INLINEABLE poke #-}