{-# Language CPP, BangPatterns, MagicHash, ForeignFunctionInterface, UnliftedFFITypes #-}
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 )
data TFGen =
TFGen
{-# UNPACK #-} !ByteArray
{-# UNPACK #-} !Word64
{-# UNPACK #-} !Word64
{-# UNPACK #-} !Int16
{-# UNPACK #-} !Int16
ByteArray
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 =
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
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
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
| 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'
genRange :: TFGen -> (Int, Int)
genRange TFGen
_ = (Int
0, Int
2147483562)
split :: TFGen -> (TFGen, TFGen)
split = TFGen -> (TFGen, TFGen)
tfGenSplit
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
class RandomGen g where
next :: g -> (Word32, g)
split :: g -> (g, g)
splitn :: g
-> Int
-> Word32
-> g
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