    {-# LANGUAGE MagicHash, UnboxedTuples, BangPatterns #-}
    --------------------------------------------------------------------
    -- |
    -- Module     : System.Random.Mersenne.Pure64
    -- Copyright  : Copyright (c) 2008, Bertram Felgenhauer <int-e@gmx.de>
    -- License    : BSD3
    -- Maintainer : Don Stewart <dons@galois.com>
    -- Stability  : experimental
    -- Portability:
    -- Tested with: GHC 6.8.3
    --
    -- A purely functional binding 64 bit binding to the classic mersenne
    -- twister random number generator. This is more flexible than the
    -- impure 'mersenne-random' library, at the cost of being a bit slower.
    -- This generator is however, many times faster than System.Random,
    -- and yields high quality randoms with a long period.
    --
    module System.Random.Mersenne.Pure64.MTBlock (
        -- * Block type
        MTBlock,

        -- * Block functions
        seedBlock,
        nextBlock,
        lookupBlock,

        -- * Misc functions
        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 :: forall a. MTBlock -> Ptr a
    blockAsPtr (MTBlock ByteArray#
    b) = Addr# -> Ptr a
    forall a. Addr# -> Ptr a
    Ptr (ByteArray# -> Addr#
    byteArrayContents# ByteArray#
    b)

    -- | create a new MT block, seeded with the given Word64 value
    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
        b <- IO MTBlock
    allocateBlock
        c_seed_genrand64_block (blockAsPtr b) seed
        c_next_genrand64_block (blockAsPtr b) (blockAsPtr b)
        touch b
        return b
    {-# NOINLINE seedBlock #-}

    -- | step: create a new MTBlock buffer from the previous one
    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
        new <- IO MTBlock
    allocateBlock
        c_next_genrand64_block (blockAsPtr b) (blockAsPtr new)
        touch b
        touch new
        return new
    {-# NOINLINE nextBlock #-}

    -- stolen from GHC.ForeignPtr - make sure the argument is still alive.
    touch :: a -> IO ()
    touch :: forall a. 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 d. a -> State# d -> State# d
    touch# a
    r State# RealWorld
    s0 of State# RealWorld
    s1 -> (# State# RealWorld
    s1, () #)

    -- | look up an element of an MT block
    lookupBlock :: MTBlock -> Int -> Word64
    lookupBlock :: MTBlock -> Int -> Word64
    lookupBlock (MTBlock ByteArray#
    b) (I# Int#
    i) = Word64# -> Word64
    W64# (ByteArray# -> Int# -> Word64#
    indexWord64Array# ByteArray#
    b Int#
    i)

    -- | MT's word mix function.
    --
    -- (MT applies this function to each Word64 from the buffer before returning it)
    mixWord64 :: Word64 -> Word64
    mixWord64 :: Word64 -> Word64
    mixWord64 = Word64 -> Word64
    c_mix_word64

    -- Alternative implementation - it's probably faster on 64 bit machines, but
    -- on Athlon XP it loses.
    {-
    mixWord64 (W64# x0) = let
        W64# x1 = W64# x0 `xor` (W64# (x0 `uncheckedShiftRL64#` 28#) .&. 0x5555555555555555)
        W64# x2 = W64# x1 `xor` (W64# (x1 `uncheckedShiftL64#` 17#) .&. 0x71D67FFFEDA60000)
        W64# x3 = W64# x2 `xor` (W64# (x2 `uncheckedShiftL64#` 37#) .&. 0xFFF7EEE000000000)
        W64# x4 = W64# x3 `xor` (W64# (x3 `uncheckedShiftRL64#` 43#))
      in
        W64# x4
    -}