{-# Language CPP, BangPatterns, MagicHash, ForeignFunctionInterface, UnliftedFFITypes #-}
-- |
-- Module    : System.Random.TF.Gen
-- Copyright : (c) 2012-2013 Michał Pałka
-- License   : BSD3
--
-- Maintainer  : michal.palka@chalmers.se
-- Stability   : experimental
-- Portability : portable
--
-- This module provides the 'TFGen' generator and the alternative 'RandomGen' class.
--  'TFGen' also implements the standard 'System.Random.RandomGen' class.

module System.Random.TF.Gen
 (TFGen, RandomGen(..), seedTFGen)
 where

import qualified System.Random as R

import System.IO.Unsafe

import Data.Bits
import Data.Char (toUpper, isSpace)
import Data.Maybe (isJust, fromJust)
import Data.Int
import Data.Word
import Data.Primitive.ByteArray

import Numeric

#if !MIN_VERSION_base(4,4,0)
unsafeDupablePerformIO :: IO a -> a
unsafeDupablePerformIO = unsafePerformIO
#endif

foreign import ccall unsafe "skein.h Threefish_256_Process_Block"
  threefish256EncryptBlock ::
    ByteArray# -> ByteArray# -> MutableByteArray# s -> Int -> IO ()

createBlock256 :: Word64 -> Word64 -> Word64 -> Word64 -> IO ByteArray
createBlock256 :: Word64 -> Word64 -> Word64 -> Word64 -> IO ByteArray
createBlock256 !Word64
a !Word64
b !Word64
c !Word64
d = do
  MutableByteArray RealWorld
ma <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
32
  MutableByteArray (PrimState IO) -> Int -> Word64 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
ma Int
0 Word64
a
  MutableByteArray (PrimState IO) -> Int -> Word64 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
ma Int
1 Word64
b
  MutableByteArray (PrimState IO) -> Int -> Word64 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
ma Int
2 Word64
c
  MutableByteArray (PrimState IO) -> Int -> Word64 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
ma Int
3 Word64
d
  MutableByteArray (PrimState IO) -> IO ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
ma

readBlock256 :: ByteArray -> (Word64, Word64, Word64, Word64)
readBlock256 :: ByteArray -> (Word64, Word64, Word64, Word64)
readBlock256 ByteArray
ba =
  ( ByteArray -> Int -> Word64
forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
ba Int
0
  , ByteArray -> Int -> Word64
forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
ba Int
1
  , ByteArray -> Int -> Word64
forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
ba Int
2
  , ByteArray -> Int -> Word64
forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
ba Int
3 )

-- | The generator type
data TFGen =
  TFGen
    {-# UNPACK #-} !ByteArray -- Key, four Word64s in host endian format
    {-# UNPACK #-} !Word64    -- Tree level
    {-# UNPACK #-} !Word64    -- Tree position bits
    {-# UNPACK #-} !Int16     -- Index in tree position bits
    {-# UNPACK #-} !Int16     -- Index in the block
    ByteArray                 -- The block, eight Word32s in host endian
                              -- format (this field is lazy)

newtype Hex = Hex ByteArray

instance Show Hex where
  showsPrec :: Int -> Hex -> ShowS
showsPrec Int
_ (Hex ByteArray
ba) =
    (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Word64 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex' Word64
x1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Word64 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex' Word64
x2 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Word64 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex' Word64
x3 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Word64 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex' Word64
x4
    where
    (Word64
x1, Word64
x2, Word64
x3, Word64
x4) = ByteArray -> (Word64, Word64, Word64, Word64)
readBlock256 ByteArray
ba
    showHex' :: a -> ShowS
showHex' a
x String
c = (ShowS
pad ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ a -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex a
x String
"") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
c
    pad :: ShowS
pad String
s = Int -> ShowS
forall a. Int -> [a] -> [a]
take (Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) (Char -> String
forall a. a -> [a]
repeat Char
'0') String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
      where l :: Int
l = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s

instance Read Hex where
  readsPrec :: Int -> ReadS Hex
readsPrec Int
_ = (([Word64], String) -> (Hex, String))
-> [([Word64], String)] -> [(Hex, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\([Word64]
l, String
s) -> (ByteArray -> Hex
Hex (ByteArray -> Hex) -> ByteArray -> Hex
forall a b. (a -> b) -> a -> b
$ [Word64] -> ByteArray
forall a. (Num a, Prim a) => [a] -> ByteArray
makeBA [Word64]
l, String
s)) ([([Word64], String)] -> [(Hex, String)])
-> (String -> [([Word64], String)]) -> ReadS Hex
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      (([Word64], String) -> Bool)
-> [([Word64], String)] -> [([Word64], String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\([Word64]
l, String
_) -> [Word64] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word64]
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
4) ([([Word64], String)] -> [([Word64], String)])
-> (String -> [([Word64], String)])
-> String
-> [([Word64], String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      ((Integer, String) -> ([Word64], String))
-> [(Integer, String)] -> [([Word64], String)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Integer
x, String
s) -> (Integer -> [Word64]
toList Integer
x, String
s)) ([(Integer, String)] -> [([Word64], String)])
-> (String -> [(Integer, String)])
-> String
-> [([Word64], String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(Integer, String)]
forall a. (Eq a, Num a) => ReadS a
readHex (String -> [(Integer, String)])
-> ShowS -> String -> [(Integer, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace
    where makeBA :: [a] -> ByteArray
makeBA [a]
l = IO ByteArray -> ByteArray
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteArray -> ByteArray) -> IO ByteArray -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
            MutableByteArray RealWorld
b <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
32
            [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ MutableByteArray (PrimState IO) -> Int -> a -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
b Int
i a
x | (a
x, Int
i) <- [a] -> [Int] -> [(a, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([a]
l [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a -> [a]
forall a. a -> [a]
repeat a
0) [Int
3,Int
2..Int
0] ]
            MutableByteArray (PrimState IO) -> IO ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
b
          toList :: Integer -> [Word64]
          toList :: Integer -> [Word64]
toList Integer
0 = []
          toList Integer
n = Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
m Word64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
: Integer -> [Word64]
toList Integer
d
            where (Integer
d, Integer
m) = Integer
n Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`divMod` (Integer
2Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
64)

data TFGenR = TFGenR Hex Word64 Word64 Int16 Int16
  deriving (Int -> TFGenR -> ShowS
[TFGenR] -> ShowS
TFGenR -> String
(Int -> TFGenR -> ShowS)
-> (TFGenR -> String) -> ([TFGenR] -> ShowS) -> Show TFGenR
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TFGenR] -> ShowS
$cshowList :: [TFGenR] -> ShowS
show :: TFGenR -> String
$cshow :: TFGenR -> String
showsPrec :: Int -> TFGenR -> ShowS
$cshowsPrec :: Int -> TFGenR -> ShowS
Show, ReadPrec [TFGenR]
ReadPrec TFGenR
Int -> ReadS TFGenR
ReadS [TFGenR]
(Int -> ReadS TFGenR)
-> ReadS [TFGenR]
-> ReadPrec TFGenR
-> ReadPrec [TFGenR]
-> Read TFGenR
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TFGenR]
$creadListPrec :: ReadPrec [TFGenR]
readPrec :: ReadPrec TFGenR
$creadPrec :: ReadPrec TFGenR
readList :: ReadS [TFGenR]
$creadList :: ReadS [TFGenR]
readsPrec :: Int -> ReadS TFGenR
$creadsPrec :: Int -> ReadS TFGenR
Read)

toTFGenR :: TFGen -> TFGenR
toTFGenR :: TFGen -> TFGenR
toTFGenR (TFGen ByteArray
k Word64
i Word64
b Int16
bi Int16
blki ByteArray
_) = Hex -> Word64 -> Word64 -> Int16 -> Int16 -> TFGenR
TFGenR (ByteArray -> Hex
Hex ByteArray
k) Word64
i Word64
b Int16
bi Int16
blki

fromTFGenR :: TFGenR -> Maybe TFGen
fromTFGenR :: TFGenR -> Maybe TFGen
fromTFGenR (TFGenR (Hex k :: ByteArray
k@(ByteArray ByteArray#
k')) Word64
i Word64
b Int16
bi Int16
blki)
  | Int16
bi Int16 -> Int16 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int16
0 Bool -> Bool -> Bool
&& Int16
bi Int16 -> Int16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int16
64 Bool -> Bool -> Bool
&& Int16
blki Int16 -> Int16 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int16
0 Bool -> Bool -> Bool
&& Int16
blki Int16 -> Int16 -> Bool
forall a. Ord a => a -> a -> Bool
< Int16
8
              = TFGen -> Maybe TFGen
forall a. a -> Maybe a
Just (TFGen -> Maybe TFGen) -> TFGen -> Maybe TFGen
forall a b. (a -> b) -> a -> b
$ ByteArray
-> Word64 -> Word64 -> Int16 -> Int16 -> ByteArray -> TFGen
TFGen ByteArray
k Word64
i Word64
b Int16
bi Int16
blki (ByteArray# -> Word64 -> Word64 -> Word64 -> Int -> ByteArray
mash ByteArray#
k' (Word64
iWord64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
-Int16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
blki) Word64
b Word64
0 Int
1)
  | Bool
otherwise = Maybe TFGen
forall a. Maybe a
Nothing

instance Show TFGen where
  showsPrec :: Int -> TFGen -> ShowS
showsPrec Int
n TFGen
g = Int -> TFGenR -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
n (TFGen -> TFGenR
toTFGenR TFGen
g)

instance Read TFGen where
  readsPrec :: Int -> ReadS TFGen
readsPrec Int
n =
    ((Maybe TFGen, String) -> (TFGen, String))
-> [(Maybe TFGen, String)] -> [(TFGen, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Maybe TFGen
g, String
s) -> (Maybe TFGen -> TFGen
forall a. HasCallStack => Maybe a -> a
fromJust Maybe TFGen
g, String
s)) ([(Maybe TFGen, String)] -> [(TFGen, String)])
-> (String -> [(Maybe TFGen, String)]) -> ReadS TFGen
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ((Maybe TFGen, String) -> Bool)
-> [(Maybe TFGen, String)] -> [(Maybe TFGen, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Maybe TFGen
g, String
_) -> Maybe TFGen -> Bool
forall a. Maybe a -> Bool
isJust Maybe TFGen
g) ([(Maybe TFGen, String)] -> [(Maybe TFGen, String)])
-> (String -> [(Maybe TFGen, String)])
-> String
-> [(Maybe TFGen, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ((TFGenR, String) -> (Maybe TFGen, String))
-> [(TFGenR, String)] -> [(Maybe TFGen, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\(TFGenR
g, String
s) -> (TFGenR -> Maybe TFGen
fromTFGenR TFGenR
g, String
s)) ([(TFGenR, String)] -> [(Maybe TFGen, String)])
-> ReadS TFGenR -> String -> [(Maybe TFGen, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ReadS TFGenR
forall a. Read a => Int -> ReadS a
readsPrec Int
n

mash :: ByteArray# -> Word64 -> Word64 -> Word64 -> Int -> ByteArray
mash :: ByteArray# -> Word64 -> Word64 -> Word64 -> Int -> ByteArray
mash ByteArray#
k' Word64
i Word64
b Word64
m Int
o32 =
  -- We use unsafeDupablePerformIO here because the cost
  -- of locking in unsafePerformIO is much higher
  -- than any gains it could bring.
  IO ByteArray -> ByteArray
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteArray -> ByteArray) -> IO ByteArray -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
      (ByteArray ByteArray#
c') <- Word64 -> Word64 -> Word64 -> Word64 -> IO ByteArray
createBlock256 Word64
b Word64
i Word64
m Word64
0
      -- Allocate array for cipher result
      o :: MutableByteArray RealWorld
o@(MutableByteArray MutableByteArray# RealWorld
o') <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
32
      ByteArray#
-> ByteArray# -> MutableByteArray# RealWorld -> Int -> IO ()
forall s.
ByteArray# -> ByteArray# -> MutableByteArray# s -> Int -> IO ()
threefish256EncryptBlock ByteArray#
k' ByteArray#
c' MutableByteArray# RealWorld
o' Int
o32
      MutableByteArray (PrimState IO) -> IO ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
o

mash' :: TFGen -> Word64 -> Int -> ByteArray
mash' :: TFGen -> Word64 -> Int -> ByteArray
mash' (TFGen (ByteArray ByteArray#
k') Word64
i Word64
b Int16
_ Int16
_ ByteArray
_) Word64
m Int
o32 =
  ByteArray# -> Word64 -> Word64 -> Word64 -> Int -> ByteArray
mash ByteArray#
k' Word64
i Word64
b Word64
m Int
o32

mkTFGen :: ByteArray -> Word64 -> Word64 -> Int16 -> TFGen
mkTFGen :: ByteArray -> Word64 -> Word64 -> Int16 -> TFGen
mkTFGen k :: ByteArray
k@(ByteArray ByteArray#
k') Word64
i Word64
b Int16
bi =
  ByteArray
-> Word64 -> Word64 -> Int16 -> Int16 -> ByteArray -> TFGen
TFGen ByteArray
k Word64
i Word64
b Int16
bi Int16
0 (ByteArray# -> Word64 -> Word64 -> Word64 -> Int -> ByteArray
mash ByteArray#
k' Word64
i Word64
b Word64
0 Int
1)

extract :: ByteArray -> Int -> Word32
extract :: ByteArray -> Int -> Word32
extract ByteArray
b Int
i = ByteArray -> Int -> Word32
forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
b Int
i

{-# INLINE tfGenNext #-}
tfGenNext :: TFGen -> (Word32, TFGen)
tfGenNext :: TFGen -> (Word32, TFGen)
tfGenNext (TFGen k :: ByteArray
k@(ByteArray ByteArray#
k') Word64
i Word64
b Int16
bi Int16
blki ByteArray
blk) =
  (Word32
val,
   if Int16
blki Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
== Int16
7
    then
      if Word64
i Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
forall a. Bounded a => a
maxBound Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1
        then ByteArray -> Word64 -> Word64 -> Int16 -> TFGen
mkTFGen ByteArray
k (Word64
iWord64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+Word64
1) Word64
b Int16
bi
        else
          if Int16
bi Int16 -> Int16 -> Bool
forall a. Ord a => a -> a -> Bool
< Int16
64
            then ByteArray -> Word64 -> Word64 -> Int16 -> TFGen
mkTFGen ByteArray
k Word64
0 (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
setBit Word64
b (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
bi) (Int16
biInt16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
+Int16
1)
            else ByteArray -> Word64 -> Word64 -> Int16 -> TFGen
mkTFGen (ByteArray# -> Word64 -> Word64 -> Word64 -> Int -> ByteArray
mash ByteArray#
k' Word64
forall a. Bounded a => a
maxBound Word64
b Word64
0 Int
0) Word64
0 Word64
0 Int16
0
    else ByteArray
-> Word64 -> Word64 -> Int16 -> Int16 -> ByteArray -> TFGen
TFGen ByteArray
k (Word64
iWord64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+Word64
1) Word64
b Int16
bi (Int16
blkiInt16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
+Int16
1) ByteArray
blk)
  where
  val :: Word32
  val :: Word32
val = ByteArray -> Int -> Word32
extract ByteArray
blk (Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
blki)

tfGenNext' :: TFGen -> (Int, TFGen)
tfGenNext' :: TFGen -> (Int, TFGen)
tfGenNext' TFGen
g
  -- We force the result into StdGen's range
  | Word32
val' Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<=  Word32
2147483562 = (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
val', TFGen
g')
  | Bool
otherwise           = TFGen -> (Int, TFGen)
tfGenNext' TFGen
g'
  where
  (Word32
val, TFGen
g') = TFGen -> (Word32, TFGen)
tfGenNext TFGen
g
  val' :: Word32
val'      = Word32
0x7FFFFFFF Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
val

tfGenSplit :: TFGen -> (TFGen, TFGen)
tfGenSplit :: TFGen -> (TFGen, TFGen)
tfGenSplit g :: TFGen
g@(TFGen ByteArray
k Word64
i Word64
b Int16
bi Int16
_ ByteArray
_)
  | Int16
bi Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
== Int16
maxb = (ByteArray -> Word64 -> Word64 -> Int16 -> TFGen
mkTFGen ByteArray
k' Word64
0 Word64
0 Int16
1,   ByteArray -> Word64 -> Word64 -> Int16 -> TFGen
mkTFGen ByteArray
k' Word64
0 Word64
1   Int16
1)
  | Bool
otherwise  = (ByteArray -> Word64 -> Word64 -> Int16 -> TFGen
mkTFGen ByteArray
k  Word64
i Word64
b Int16
bi', ByteArray -> Word64 -> Word64 -> Int16 -> TFGen
mkTFGen ByteArray
k  Word64
i Word64
b'' Int16
bi')
  where
  maxb :: Int16
maxb = Int16
64
  bi' :: Int16
bi'  = Int16
bi Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
+ Int16
1
  k' :: ByteArray
k'   = TFGen -> Word64 -> Int -> ByteArray
mash' TFGen
g Word64
0 Int
0
  b'' :: Word64
b''  = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
setBit Word64
b (Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
bi)

instance R.RandomGen TFGen where
  next :: TFGen -> (Int, TFGen)
next = TFGen -> (Int, TFGen)
tfGenNext'
  -- Current Random instances assume that the generator
  -- must have this range.
  genRange :: TFGen -> (Int, Int)
genRange TFGen
_ = (Int
0, Int
2147483562)
  split :: TFGen -> (TFGen, TFGen)
split = TFGen -> (TFGen, TFGen)
tfGenSplit

-- | Create a generator from a random seed.
seedTFGen :: (Word64, Word64, Word64, Word64) -> TFGen
seedTFGen :: (Word64, Word64, Word64, Word64) -> TFGen
seedTFGen (Word64
a1, Word64
a2, Word64
a3, Word64
a4) =
  ByteArray -> Word64 -> Word64 -> Int16 -> TFGen
mkTFGen
    (IO ByteArray -> ByteArray
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteArray -> ByteArray) -> IO ByteArray -> ByteArray
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Word64 -> Word64 -> IO ByteArray
createBlock256 Word64
a1 Word64
a2 Word64
a3 Word64
a4)
    Word64
0 Word64
0 Int16
0

-- | Alternative 'RandomGen' class with a modified 'next' operation, and added 'splitn'
-- and 'level' operations.
-- 
-- Using the generator requires that no more than one operation is called
-- on the same generator state, as the implementation does not guarantee pseudorandomness
-- otherwise. As an exception, calling 'splitn' many times on the same generator state is
-- allowed as long as the \'bits\' argument is the same for all the calls.
class RandomGen g where
  -- | 'next' returns a 'Word32' that appears to have been chosen uniformly at random, and a 
  -- new generator state.
  next  :: g -> (Word32, g)
  -- | 'split' returns two derived generator states that appear to be independent pseudorandom
  -- number generators.
  split :: g -> (g, g)
  -- | 'splitn' is the n-way split operation used to create many derived generator states
  -- in one go. Application of 'splitn' to two first arguments should be shared between
  -- different applications of the index argument to avoid unnecessary repeated computations.
  --
  -- The following code creates ten \'independent\' generator states. Number \'4\' comes
  -- from the fact that at least
  -- four bits are needed to encode ten different indices.
  --
  -- @
  --    f :: RandomGen g => g -> [g]
  --    f r = map (splitn r 4) [0..9]
  -- @
  splitn :: g -- ^ Original generator state.
    -> Int    -- ^ Number of bits that will be used to index the derived states.
              -- Must be between 0 and 32.
    -> Word32 -- ^ Index of the derived state. Call to @splitn r n i@ must
              -- satisfy @0 <= i < 2^n@.
    -> g
  -- | 'level' is a \'hint\' operation that may cause an iteration of work
  -- of the generator be performed prematurely in order to
  -- prevent the subsequent operations from being expensive. It is meant to be
  -- called before a 'splitn' operation, which is expected to be evaluated
  -- a very large number indices. Calling 'level' in such case might decrease
  -- the total amount of work performed.
  level :: g -> g

tfGenSplitN :: TFGen -> Int -> Word32 -> TFGen
tfGenSplitN :: TFGen -> Int -> Word32 -> TFGen
tfGenSplitN (TFGen k :: ByteArray
k@(ByteArray ByteArray#
ku) Word64
i Word64
b Int16
bi Int16
_ ByteArray
_) Int
nbits
  | Int
nbits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0          = String -> Word32 -> TFGen
forall a. HasCallStack => String -> a
error String
"tfGenSplitN called with nbits < 0"
  | Int
nbits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
32         = String -> Word32 -> TFGen
forall a. HasCallStack => String -> a
error String
"tfGenSplitN called with nbits > 32"
  | Int
bi' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nbits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxb = \Word32
n ->
     let k' :: ByteArray
k' = ByteArray# -> Word64 -> Word64 -> Word64 -> Int -> ByteArray
mash ByteArray#
ku Word64
i (Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> Word32 -> Word64
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32
forall a. (Bits a, Num a) => a -> a
clip Word32
n) (Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
bi)) Word64
0 Int
0 in
     ByteArray -> Word64 -> Word64 -> Int16 -> TFGen
mkTFGen ByteArray
k' Word64
0 (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> Word32 -> Word64
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32
forall a. (Bits a, Num a) => a -> a
clip Word32
n) (Int
bi' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nbits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
maxb)) (Int16
bi Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
- Int -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
maxb Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nbits))
  | Bool
otherwise          = \Word32
n ->
     ByteArray -> Word64 -> Word64 -> Int16 -> TFGen
mkTFGen ByteArray
k Word64
i (Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> Word32 -> Word64
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32
forall a. (Bits a, Num a) => a -> a
clip Word32
n) Int
bi') (Int16
bi Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
+ Int -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nbits)
  where
  bi' :: Int
bi' = Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
bi
  maxb :: Int
maxb = Int
64
  clip :: a -> a
clip a
n = (a
0xFFFFFFFF a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nbits)) a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
n

tfGenLevel :: TFGen -> TFGen
tfGenLevel :: TFGen -> TFGen
tfGenLevel g :: TFGen
g@(TFGen k :: ByteArray
k@(ByteArray ByteArray#
ku) Word64
i Word64
b Int16
bi Int16
_ ByteArray
_)
  | Int16
bi Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
+ Int16
40 Int16 -> Int16 -> Bool
forall a. Ord a => a -> a -> Bool
> Int16
maxb = ByteArray -> Word64 -> Word64 -> Int16 -> TFGen
mkTFGen ByteArray
k' Word64
0 Word64
0 Int16
0
  | Bool
otherwise      = TFGen
g
  where
  maxb :: Int16
maxb = Int16
64
  k' :: ByteArray
k'   = ByteArray# -> Word64 -> Word64 -> Word64 -> Int -> ByteArray
mash ByteArray#
ku Word64
i Word64
b Word64
0 Int
0

instance RandomGen TFGen where
  {-# INLINE next #-}
  next :: TFGen -> (Word32, TFGen)
next   = TFGen -> (Word32, TFGen)
tfGenNext
  split :: TFGen -> (TFGen, TFGen)
split  = TFGen -> (TFGen, TFGen)
tfGenSplit
  splitn :: TFGen -> Int -> Word32 -> TFGen
splitn = TFGen -> Int -> Word32 -> TFGen
tfGenSplitN
  level :: TFGen -> TFGen
level  = TFGen -> TFGen
tfGenLevel