{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
module Numeric.GMP.Utils
(
withInInteger'
, withInInteger
, withInOutInteger
, withInOutInteger_
, withOutInteger
, withOutInteger_
, peekInteger'
, peekInteger
, pokeInteger
, withInRational'
, withInRational
, withInOutRational
, withInOutRational_
, withOutRational
, withOutRational_
, peekRational'
, peekRational
, pokeRational
) where
import Control.Exception (bracket_)
import Data.Ratio ((%), numerator, denominator)
import Foreign (allocaBytes, alloca, with, sizeOf, peek)
#if MIN_VERSION_base(4,15,0)
#define GHC_BIGNUM 1
import GHC.Num.Integer
( Integer(..)
, integerFromBigNat#
, integerFromBigNatNeg#
)
import GHC.Num.BigNat
( bigNatSize#
)
#else
#define GHC_BIGNUM 0
import GHC.Integer.GMP.Internals
( Integer(..)
, BigNat(..)
, sizeofBigNat#
, byteArrayToBigNat#
, bigNatToInteger
, bigNatToNegInteger
)
#define IS S#
#endif
import GHC.Prim
( ByteArray#
, sizeofByteArray#
, copyByteArrayToAddr#
, newByteArray#
, copyAddrToByteArray#
, unsafeFreezeByteArray#
)
import GHC.Exts (Int(..), Ptr(..))
import GHC.Types (IO(..))
import Numeric.GMP.Types
import Numeric.GMP.Raw.Unsafe
( mpz_init
, mpz_clear
, mpq_init
, mpq_clear
, mpz_set
)
foreign import ccall unsafe "mpz_set_HsInt"
mpz_set_HsInt :: Ptr MPZ -> Int -> IO ()
withInInteger' :: Integer -> (MPZ -> IO r) -> IO r
withInInteger' :: Integer -> (MPZ -> IO r) -> IO r
withInInteger' Integer
i MPZ -> IO r
action = case Integer
i of
IS Int#
n# -> (Ptr MPZ -> IO r) -> IO r
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr MPZ -> IO r) -> IO r) -> (Ptr MPZ -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \Ptr MPZ
src -> IO () -> IO () -> IO r -> IO r
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (Ptr MPZ -> IO ()
mpz_init Ptr MPZ
src) (Ptr MPZ -> IO ()
mpz_clear Ptr MPZ
src) (IO r -> IO r) -> IO r -> IO r
forall a b. (a -> b) -> a -> b
$ do
Ptr MPZ -> Int -> IO ()
mpz_set_HsInt Ptr MPZ
src (Int# -> Int
I# Int#
n#)
MPZ
z <- Ptr MPZ -> IO MPZ
forall a. Storable a => Ptr a -> IO a
peek Ptr MPZ
src
r
r <- MPZ -> IO r
action MPZ
z
r -> IO r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r
#if GHC_BIGNUM
IP ba# -> withByteArray ba# $ \d _ -> action MPZ
{ mpzAlloc = 0
, mpzSize = fromIntegral (I# (bigNatSize# ba#))
, mpzD = d
}
IN ba# -> withByteArray ba# $ \d _ -> action MPZ
{ mpzAlloc = 0
, mpzSize = - fromIntegral (I# (bigNatSize# ba#))
, mpzD = d
}
#else
Jp# bn :: BigNat
bn@(BN# ByteArray#
ba#) -> ByteArray# -> (Ptr MPLimb -> Int -> IO r) -> IO r
forall a r. ByteArray# -> (Ptr a -> Int -> IO r) -> IO r
withByteArray ByteArray#
ba# ((Ptr MPLimb -> Int -> IO r) -> IO r)
-> (Ptr MPLimb -> Int -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \Ptr MPLimb
d Int
_ -> MPZ -> IO r
action MPZ :: CInt -> CInt -> Ptr MPLimb -> MPZ
MPZ
{ mpzAlloc :: CInt
mpzAlloc = CInt
0
, mpzSize :: CInt
mpzSize = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int# -> Int
I# (BigNat -> Int#
sizeofBigNat# BigNat
bn))
, mpzD :: Ptr MPLimb
mpzD = Ptr MPLimb
d
}
Jn# bn :: BigNat
bn@(BN# ByteArray#
ba#) -> ByteArray# -> (Ptr MPLimb -> Int -> IO r) -> IO r
forall a r. ByteArray# -> (Ptr a -> Int -> IO r) -> IO r
withByteArray ByteArray#
ba# ((Ptr MPLimb -> Int -> IO r) -> IO r)
-> (Ptr MPLimb -> Int -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \Ptr MPLimb
d Int
_ -> MPZ -> IO r
action MPZ :: CInt -> CInt -> Ptr MPLimb -> MPZ
MPZ
{ mpzAlloc :: CInt
mpzAlloc = CInt
0
, mpzSize :: CInt
mpzSize = - Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int# -> Int
I# (BigNat -> Int#
sizeofBigNat# BigNat
bn))
, mpzD :: Ptr MPLimb
mpzD = Ptr MPLimb
d
}
#endif
withByteArray :: ByteArray# -> (Ptr a -> Int -> IO r) -> IO r
withByteArray :: ByteArray# -> (Ptr a -> Int -> IO r) -> IO r
withByteArray ByteArray#
ba# Ptr a -> Int -> IO r
f = do
let bytes :: Int
bytes = Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba#)
Int -> (Ptr a -> IO r) -> IO r
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
bytes ((Ptr a -> IO r) -> IO r) -> (Ptr a -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr a
ptr@(Ptr Addr#
addr#) -> do
(State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\State# RealWorld
s -> (# ByteArray#
-> Int# -> Addr# -> Int# -> State# RealWorld -> State# RealWorld
forall d.
ByteArray# -> Int# -> Addr# -> Int# -> State# d -> State# d
copyByteArrayToAddr# ByteArray#
ba# Int#
0# Addr#
addr# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba#) State# RealWorld
s, () #))
Ptr a -> Int -> IO r
f Ptr a
ptr Int
bytes
withInInteger :: Integer -> (Ptr MPZ -> IO r) -> IO r
withInInteger :: Integer -> (Ptr MPZ -> IO r) -> IO r
withInInteger Integer
i Ptr MPZ -> IO r
action = Integer -> (MPZ -> IO r) -> IO r
forall r. Integer -> (MPZ -> IO r) -> IO r
withInInteger' Integer
i ((MPZ -> IO r) -> IO r) -> (MPZ -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \MPZ
z -> MPZ -> (Ptr MPZ -> IO r) -> IO r
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with MPZ
z Ptr MPZ -> IO r
action
withInOutInteger :: Integer -> (Ptr MPZ -> IO a) -> IO (Integer, a)
withInOutInteger :: Integer -> (Ptr MPZ -> IO a) -> IO (Integer, a)
withInOutInteger Integer
n Ptr MPZ -> IO a
action = (Ptr MPZ -> IO a) -> IO (Integer, a)
forall a. (Ptr MPZ -> IO a) -> IO (Integer, a)
withOutInteger ((Ptr MPZ -> IO a) -> IO (Integer, a))
-> (Ptr MPZ -> IO a) -> IO (Integer, a)
forall a b. (a -> b) -> a -> b
$ \Ptr MPZ
z -> do
Ptr MPZ -> Integer -> IO ()
pokeInteger Ptr MPZ
z Integer
n
Ptr MPZ -> IO a
action Ptr MPZ
z
withInOutInteger_ :: Integer -> (Ptr MPZ -> IO a) -> IO Integer
withInOutInteger_ :: Integer -> (Ptr MPZ -> IO a) -> IO Integer
withInOutInteger_ Integer
n Ptr MPZ -> IO a
action = do
(Integer
z, a
_) <- Integer -> (Ptr MPZ -> IO a) -> IO (Integer, a)
forall a. Integer -> (Ptr MPZ -> IO a) -> IO (Integer, a)
withInOutInteger Integer
n Ptr MPZ -> IO a
action
Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
z
withOutInteger :: (Ptr MPZ -> IO a) -> IO (Integer, a)
withOutInteger :: (Ptr MPZ -> IO a) -> IO (Integer, a)
withOutInteger Ptr MPZ -> IO a
action = (Ptr MPZ -> IO (Integer, a)) -> IO (Integer, a)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr MPZ -> IO (Integer, a)) -> IO (Integer, a))
-> (Ptr MPZ -> IO (Integer, a)) -> IO (Integer, a)
forall a b. (a -> b) -> a -> b
$ \Ptr MPZ
ptr ->
IO () -> IO () -> IO (Integer, a) -> IO (Integer, a)
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (Ptr MPZ -> IO ()
mpz_init Ptr MPZ
ptr) (Ptr MPZ -> IO ()
mpz_clear Ptr MPZ
ptr) (IO (Integer, a) -> IO (Integer, a))
-> IO (Integer, a) -> IO (Integer, a)
forall a b. (a -> b) -> a -> b
$ do
a
a <- Ptr MPZ -> IO a
action Ptr MPZ
ptr
Integer
z <- Ptr MPZ -> IO Integer
peekInteger Ptr MPZ
ptr
(Integer, a) -> IO (Integer, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
z, a
a)
withOutInteger_ :: (Ptr MPZ -> IO a) -> IO Integer
withOutInteger_ :: (Ptr MPZ -> IO a) -> IO Integer
withOutInteger_ Ptr MPZ -> IO a
action = do
(Integer
z, a
_) <- (Ptr MPZ -> IO a) -> IO (Integer, a)
forall a. (Ptr MPZ -> IO a) -> IO (Integer, a)
withOutInteger Ptr MPZ -> IO a
action
Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
z
pokeInteger :: Ptr MPZ -> Integer -> IO ()
pokeInteger :: Ptr MPZ -> Integer -> IO ()
pokeInteger Ptr MPZ
dst (IS Int#
n#) = Ptr MPZ -> Int -> IO ()
mpz_set_HsInt Ptr MPZ
dst (Int# -> Int
I# Int#
n#)
pokeInteger Ptr MPZ
dst Integer
j = Integer -> (Ptr MPZ -> IO ()) -> IO ()
forall r. Integer -> (Ptr MPZ -> IO r) -> IO r
withInInteger Integer
j ((Ptr MPZ -> IO ()) -> IO ()) -> (Ptr MPZ -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr MPZ -> Ptr MPZ -> IO ()
mpz_set Ptr MPZ
dst
peekInteger' :: MPZ -> IO Integer
peekInteger' :: MPZ -> IO Integer
peekInteger' MPZ{ mpzSize :: MPZ -> CInt
mpzSize = CInt
size, mpzD :: MPZ -> Ptr MPLimb
mpzD = Ptr MPLimb
d } = do
if CInt
size CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0 then Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0 else
Ptr MPLimb -> Int -> (ByteArray# -> IO Integer) -> IO Integer
forall a r. Ptr a -> Int -> (ByteArray# -> IO r) -> IO r
asByteArray Ptr MPLimb
d (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> CInt
forall a. Num a => a -> a
abs CInt
size) Int -> Int -> Int
forall a. Num a => a -> a -> a
* MPLimb -> Int
forall a. Storable a => a -> Int
sizeOf (MPLimb
forall a. HasCallStack => a
undefined :: MPLimb))
#if GHC_BIGNUM
(\ba# -> return $ if size < 0
then integerFromBigNatNeg# ba#
else integerFromBigNat# ba#
)
#else
(\ByteArray#
ba# -> Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> IO Integer) -> Integer -> IO Integer
forall a b. (a -> b) -> a -> b
$ case CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> CInt
forall a. Num a => a -> a
abs CInt
size) of
I# Int#
size# -> (if CInt
size CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 then BigNat -> Integer
bigNatToNegInteger else BigNat -> Integer
bigNatToInteger)
(ByteArray# -> Int# -> BigNat
byteArrayToBigNat# ByteArray#
ba# Int#
size#)
)
#endif
asByteArray :: Ptr a -> Int -> (ByteArray# -> IO r) -> IO r
asByteArray :: Ptr a -> Int -> (ByteArray# -> IO r) -> IO r
asByteArray (Ptr Addr#
addr#) (I# Int#
bytes#) ByteArray# -> IO r
f = do
(State# RealWorld -> (# State# RealWorld, r #)) -> IO r
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, r #)) -> IO r)
-> (State# RealWorld -> (# State# RealWorld, r #)) -> IO r
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# -> case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
bytes# State# RealWorld
s# of
(# State# RealWorld
s'#, MutableByteArray# RealWorld
mba# #) ->
case MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
mba# (Addr#
-> MutableByteArray# RealWorld
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall d.
Addr#
-> MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
copyAddrToByteArray# Addr#
addr# MutableByteArray# RealWorld
mba# Int#
0# Int#
bytes# State# RealWorld
s'#) of
(# State# RealWorld
s''#, ByteArray#
ba# #) -> case ByteArray# -> IO r
f ByteArray#
ba# of IO State# RealWorld -> (# State# RealWorld, r #)
r -> State# RealWorld -> (# State# RealWorld, r #)
r State# RealWorld
s''#
peekInteger :: Ptr MPZ -> IO Integer
peekInteger :: Ptr MPZ -> IO Integer
peekInteger Ptr MPZ
src = do
MPZ
z <- Ptr MPZ -> IO MPZ
forall a. Storable a => Ptr a -> IO a
peek Ptr MPZ
src
MPZ -> IO Integer
peekInteger' MPZ
z
withInRational' :: Rational -> (MPQ -> IO r) -> IO r
withInRational' :: Rational -> (MPQ -> IO r) -> IO r
withInRational' Rational
q MPQ -> IO r
action =
Integer -> (MPZ -> IO r) -> IO r
forall r. Integer -> (MPZ -> IO r) -> IO r
withInInteger' (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
q) ((MPZ -> IO r) -> IO r) -> (MPZ -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \MPZ
nz ->
Integer -> (MPZ -> IO r) -> IO r
forall r. Integer -> (MPZ -> IO r) -> IO r
withInInteger' (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
q) ((MPZ -> IO r) -> IO r) -> (MPZ -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \MPZ
dz ->
MPQ -> IO r
action (MPZ -> MPZ -> MPQ
MPQ MPZ
nz MPZ
dz)
withInRational :: Rational -> (Ptr MPQ -> IO r) -> IO r
withInRational :: Rational -> (Ptr MPQ -> IO r) -> IO r
withInRational Rational
q Ptr MPQ -> IO r
action = Rational -> (MPQ -> IO r) -> IO r
forall r. Rational -> (MPQ -> IO r) -> IO r
withInRational' Rational
q ((MPQ -> IO r) -> IO r) -> (MPQ -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \MPQ
qq -> MPQ -> (Ptr MPQ -> IO r) -> IO r
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with MPQ
qq Ptr MPQ -> IO r
action
withInOutRational :: Rational -> (Ptr MPQ -> IO a) -> IO (Rational, a)
withInOutRational :: Rational -> (Ptr MPQ -> IO a) -> IO (Rational, a)
withInOutRational Rational
n Ptr MPQ -> IO a
action = (Ptr MPQ -> IO a) -> IO (Rational, a)
forall a. (Ptr MPQ -> IO a) -> IO (Rational, a)
withOutRational ((Ptr MPQ -> IO a) -> IO (Rational, a))
-> (Ptr MPQ -> IO a) -> IO (Rational, a)
forall a b. (a -> b) -> a -> b
$ \Ptr MPQ
q -> do
Ptr MPQ -> Rational -> IO ()
pokeRational Ptr MPQ
q Rational
n
Ptr MPQ -> IO a
action Ptr MPQ
q
withInOutRational_ :: Rational -> (Ptr MPQ -> IO a) -> IO Rational
withInOutRational_ :: Rational -> (Ptr MPQ -> IO a) -> IO Rational
withInOutRational_ Rational
n Ptr MPQ -> IO a
action = do
(Rational
q, a
_) <- Rational -> (Ptr MPQ -> IO a) -> IO (Rational, a)
forall a. Rational -> (Ptr MPQ -> IO a) -> IO (Rational, a)
withInOutRational Rational
n Ptr MPQ -> IO a
action
Rational -> IO Rational
forall (m :: * -> *) a. Monad m => a -> m a
return Rational
q
withOutRational :: (Ptr MPQ -> IO a) -> IO (Rational, a)
withOutRational :: (Ptr MPQ -> IO a) -> IO (Rational, a)
withOutRational Ptr MPQ -> IO a
action = (Ptr MPQ -> IO (Rational, a)) -> IO (Rational, a)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr MPQ -> IO (Rational, a)) -> IO (Rational, a))
-> (Ptr MPQ -> IO (Rational, a)) -> IO (Rational, a)
forall a b. (a -> b) -> a -> b
$ \Ptr MPQ
ptr ->
IO () -> IO () -> IO (Rational, a) -> IO (Rational, a)
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (Ptr MPQ -> IO ()
mpq_init Ptr MPQ
ptr) (Ptr MPQ -> IO ()
mpq_clear Ptr MPQ
ptr) (IO (Rational, a) -> IO (Rational, a))
-> IO (Rational, a) -> IO (Rational, a)
forall a b. (a -> b) -> a -> b
$ do
a
a <- Ptr MPQ -> IO a
action Ptr MPQ
ptr
Rational
q <- Ptr MPQ -> IO Rational
peekRational Ptr MPQ
ptr
(Rational, a) -> IO (Rational, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Rational
q, a
a)
withOutRational_ :: (Ptr MPQ -> IO a) -> IO Rational
withOutRational_ :: (Ptr MPQ -> IO a) -> IO Rational
withOutRational_ Ptr MPQ -> IO a
action = do
(Rational
q, a
_) <- (Ptr MPQ -> IO a) -> IO (Rational, a)
forall a. (Ptr MPQ -> IO a) -> IO (Rational, a)
withOutRational Ptr MPQ -> IO a
action
Rational -> IO Rational
forall (m :: * -> *) a. Monad m => a -> m a
return Rational
q
pokeRational :: Ptr MPQ -> Rational -> IO ()
pokeRational :: Ptr MPQ -> Rational -> IO ()
pokeRational Ptr MPQ
ptr Rational
q = do
Ptr MPZ -> Integer -> IO ()
pokeInteger (Ptr MPQ -> Ptr MPZ
mpq_numref Ptr MPQ
ptr) (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
q)
Ptr MPZ -> Integer -> IO ()
pokeInteger (Ptr MPQ -> Ptr MPZ
mpq_denref Ptr MPQ
ptr) (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
q)
peekRational' :: MPQ -> IO Rational
peekRational' :: MPQ -> IO Rational
peekRational' (MPQ MPZ
n MPZ
d) = do
Integer
num <- MPZ -> IO Integer
peekInteger' MPZ
n
Integer
den <- MPZ -> IO Integer
peekInteger' MPZ
d
Rational -> IO Rational
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
num Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
den)
peekRational :: Ptr MPQ -> IO Rational
peekRational :: Ptr MPQ -> IO Rational
peekRational Ptr MPQ
src = do
MPQ
q <- Ptr MPQ -> IO MPQ
forall a. Storable a => Ptr a -> IO a
peek Ptr MPQ
src
MPQ -> IO Rational
peekRational' MPQ
q