{-# LANGUAGE MagicHash, UnboxedTuples, BangPatterns #-}
module System.Random.Mersenne.Pure64.MTBlock (
MTBlock,
seedBlock,
nextBlock,
lookupBlock,
blockLen,
mixWord64,
) where
import GHC.Exts
#if __GLASGOW_HASKELL__ >= 706
import GHC.IO
#else
import GHC.IOBase
#endif
import GHC.Word
import System.Random.Mersenne.Pure64.Base
import System.Random.Mersenne.Pure64.Internal
allocateBlock :: IO MTBlock
allocateBlock :: IO MTBlock
allocateBlock =
(State# RealWorld -> (# State# RealWorld, MTBlock #)) -> IO MTBlock
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, MTBlock #))
-> IO MTBlock)
-> (State# RealWorld -> (# State# RealWorld, MTBlock #))
-> IO MTBlock
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s0 -> case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newPinnedByteArray# Int#
blockSize# State# RealWorld
s0 of
(# State# RealWorld
s1, MutableByteArray# RealWorld
b0 #) -> case MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
b0 State# RealWorld
s1 of
(# State# RealWorld
s2, ByteArray#
b1 #) -> (# State# RealWorld
s2, ByteArray# -> MTBlock
MTBlock ByteArray#
b1 #)
where
!(I# Int#
blockSize#) = Int
blockSize
blockAsPtr :: MTBlock -> Ptr a
blockAsPtr :: MTBlock -> Ptr a
blockAsPtr (MTBlock ByteArray#
b) = Addr# -> Ptr a
forall a. Addr# -> Ptr a
Ptr (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b)
seedBlock :: Word64 -> MTBlock
seedBlock :: Word64 -> MTBlock
seedBlock Word64
seed = IO MTBlock -> MTBlock
forall a. IO a -> a
unsafeDupablePerformIO (IO MTBlock -> MTBlock) -> IO MTBlock -> MTBlock
forall a b. (a -> b) -> a -> b
$ do
MTBlock
b <- IO MTBlock
allocateBlock
Ptr Any -> Word64 -> IO ()
forall a. Ptr a -> Word64 -> IO ()
c_seed_genrand64_block (MTBlock -> Ptr Any
forall a. MTBlock -> Ptr a
blockAsPtr MTBlock
b) Word64
seed
Ptr Any -> Ptr Any -> IO ()
forall a. Ptr a -> Ptr a -> IO ()
c_next_genrand64_block (MTBlock -> Ptr Any
forall a. MTBlock -> Ptr a
blockAsPtr MTBlock
b) (MTBlock -> Ptr Any
forall a. MTBlock -> Ptr a
blockAsPtr MTBlock
b)
MTBlock -> IO ()
forall a. a -> IO ()
touch MTBlock
b
MTBlock -> IO MTBlock
forall (m :: * -> *) a. Monad m => a -> m a
return MTBlock
b
{-# NOINLINE seedBlock #-}
nextBlock :: MTBlock -> MTBlock
nextBlock :: MTBlock -> MTBlock
nextBlock MTBlock
b = IO MTBlock -> MTBlock
forall a. IO a -> a
unsafeDupablePerformIO (IO MTBlock -> MTBlock) -> IO MTBlock -> MTBlock
forall a b. (a -> b) -> a -> b
$ do
MTBlock
new <- IO MTBlock
allocateBlock
Ptr Any -> Ptr Any -> IO ()
forall a. Ptr a -> Ptr a -> IO ()
c_next_genrand64_block (MTBlock -> Ptr Any
forall a. MTBlock -> Ptr a
blockAsPtr MTBlock
b) (MTBlock -> Ptr Any
forall a. MTBlock -> Ptr a
blockAsPtr MTBlock
new)
MTBlock -> IO ()
forall a. a -> IO ()
touch MTBlock
b
MTBlock -> IO ()
forall a. a -> IO ()
touch MTBlock
new
MTBlock -> IO MTBlock
forall (m :: * -> *) a. Monad m => a -> m a
return MTBlock
new
{-# NOINLINE nextBlock #-}
touch :: a -> IO ()
touch :: a -> IO ()
touch a
r = (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s0 -> case a -> State# RealWorld -> State# RealWorld
forall a. a -> State# RealWorld -> State# RealWorld
touch# a
r State# RealWorld
s0 of State# RealWorld
s1 -> (# State# RealWorld
s1, () #)
lookupBlock :: MTBlock -> Int -> Word64
lookupBlock :: MTBlock -> Int -> Word64
lookupBlock (MTBlock ByteArray#
b) (I# Int#
i) = Word# -> Word64
W64# (ByteArray# -> Int# -> Word#
indexWord64Array# ByteArray#
b Int#
i)
mixWord64 :: Word64 -> Word64
mixWord64 :: Word64 -> Word64
mixWord64 = Word64 -> Word64
c_mix_word64