{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE ForeignFunctionInterface   #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MagicHash                  #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UnboxedTuples              #-}
#if __GLASGOW_HASKELL__ >= 707
{-# LANGUAGE RoleAnnotations            #-}
#endif
-- |
-- Module     : System.Random.PCG.Pure
-- Copyright  : Copyright (c) 2015, Christopher Chalmers <c.chalmers@me.com>
-- License    : BSD3
-- Maintainer : Christopher Chalmers <c.chalmers@me.com>
-- Stability  : experimental
-- Portability: CPP
--
-- Standard PCG Random Number Generator with chosen streams, written in
-- pure haskell. See <http://www.pcg-random.org> for details.
--
-- @
-- import Control.Monad.ST
-- import System.Random.PCG.Pure
--
-- three :: [Double]
-- three = runST $ do
--   g <- create
--   a <- uniform g
--   b <- uniform g
--   c <- uniform g
--   return [a,b,c]
-- @
module System.Random.PCG.Pure
  ( -- * Gen
    Gen, GenIO, GenST
  , create, createSystemRandom, initialize, withSystemRandom

    -- * Getting random numbers
  , Variate (..)
  , advance, retract

    -- * Seeds
  , FrozenGen, save, restore, seed, initFrozen

    -- * Type restricted versions
    -- ** uniform
  , uniformW8, uniformW16, uniformW32, uniformW64
  , uniformI8, uniformI16, uniformI32, uniformI64
  , uniformF, uniformD, uniformBool

    -- ** uniformR
  , uniformRW8, uniformRW16, uniformRW32, uniformRW64
  , uniformRI8, uniformRI16, uniformRI32, uniformRI64
  , uniformRF, uniformRD, uniformRBool

    -- ** uniformB
  , uniformBW8, uniformBW16, uniformBW32, uniformBW64
  , uniformBI8, uniformBI16, uniformBI32, uniformBI64
  , uniformBF, uniformBD, uniformBBool

    -- * Pure
  , SetSeq
  , next'
  , advanceSetSeq
  ) where


import Control.Monad.Primitive
import Data.Bits
import Data.Data
import Data.Primitive.ByteArray
import Foreign
import GHC.Generics

import System.Random.PCG.Class
import System.Random

-- $setup
-- >>> import System.Random.PCG.Pure as Pure
-- >>> import Control.Monad

type GenIO = Gen RealWorld
type GenST = Gen

-- | State of the random number generator
newtype Gen s = G (MutableByteArray s)

type FrozenGen = SetSeq

-- | The multiple sequence varient of the pcg random number generator.
data SetSeq = SetSeq
  {-# UNPACK #-} !Word64 -- step
  {-# UNPACK #-} !Word64 -- sequence
  deriving (Int -> SetSeq -> ShowS
[SetSeq] -> ShowS
SetSeq -> String
(Int -> SetSeq -> ShowS)
-> (SetSeq -> String) -> ([SetSeq] -> ShowS) -> Show SetSeq
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetSeq] -> ShowS
$cshowList :: [SetSeq] -> ShowS
show :: SetSeq -> String
$cshow :: SetSeq -> String
showsPrec :: Int -> SetSeq -> ShowS
$cshowsPrec :: Int -> SetSeq -> ShowS
Show, Eq SetSeq
Eq SetSeq
-> (SetSeq -> SetSeq -> Ordering)
-> (SetSeq -> SetSeq -> Bool)
-> (SetSeq -> SetSeq -> Bool)
-> (SetSeq -> SetSeq -> Bool)
-> (SetSeq -> SetSeq -> Bool)
-> (SetSeq -> SetSeq -> SetSeq)
-> (SetSeq -> SetSeq -> SetSeq)
-> Ord SetSeq
SetSeq -> SetSeq -> Bool
SetSeq -> SetSeq -> Ordering
SetSeq -> SetSeq -> SetSeq
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SetSeq -> SetSeq -> SetSeq
$cmin :: SetSeq -> SetSeq -> SetSeq
max :: SetSeq -> SetSeq -> SetSeq
$cmax :: SetSeq -> SetSeq -> SetSeq
>= :: SetSeq -> SetSeq -> Bool
$c>= :: SetSeq -> SetSeq -> Bool
> :: SetSeq -> SetSeq -> Bool
$c> :: SetSeq -> SetSeq -> Bool
<= :: SetSeq -> SetSeq -> Bool
$c<= :: SetSeq -> SetSeq -> Bool
< :: SetSeq -> SetSeq -> Bool
$c< :: SetSeq -> SetSeq -> Bool
compare :: SetSeq -> SetSeq -> Ordering
$ccompare :: SetSeq -> SetSeq -> Ordering
$cp1Ord :: Eq SetSeq
Ord, SetSeq -> SetSeq -> Bool
(SetSeq -> SetSeq -> Bool)
-> (SetSeq -> SetSeq -> Bool) -> Eq SetSeq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetSeq -> SetSeq -> Bool
$c/= :: SetSeq -> SetSeq -> Bool
== :: SetSeq -> SetSeq -> Bool
$c== :: SetSeq -> SetSeq -> Bool
Eq, Typeable SetSeq
DataType
Constr
Typeable SetSeq
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SetSeq -> c SetSeq)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SetSeq)
-> (SetSeq -> Constr)
-> (SetSeq -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SetSeq))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SetSeq))
-> ((forall b. Data b => b -> b) -> SetSeq -> SetSeq)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SetSeq -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SetSeq -> r)
-> (forall u. (forall d. Data d => d -> u) -> SetSeq -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> SetSeq -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SetSeq -> m SetSeq)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SetSeq -> m SetSeq)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SetSeq -> m SetSeq)
-> Data SetSeq
SetSeq -> DataType
SetSeq -> Constr
(forall b. Data b => b -> b) -> SetSeq -> SetSeq
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SetSeq -> c SetSeq
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SetSeq
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SetSeq -> u
forall u. (forall d. Data d => d -> u) -> SetSeq -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SetSeq -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SetSeq -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SetSeq -> m SetSeq
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SetSeq -> m SetSeq
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SetSeq
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SetSeq -> c SetSeq
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SetSeq)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SetSeq)
$cSetSeq :: Constr
$tSetSeq :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SetSeq -> m SetSeq
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SetSeq -> m SetSeq
gmapMp :: (forall d. Data d => d -> m d) -> SetSeq -> m SetSeq
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SetSeq -> m SetSeq
gmapM :: (forall d. Data d => d -> m d) -> SetSeq -> m SetSeq
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SetSeq -> m SetSeq
gmapQi :: Int -> (forall d. Data d => d -> u) -> SetSeq -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SetSeq -> u
gmapQ :: (forall d. Data d => d -> u) -> SetSeq -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SetSeq -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SetSeq -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SetSeq -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SetSeq -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SetSeq -> r
gmapT :: (forall b. Data b => b -> b) -> SetSeq -> SetSeq
$cgmapT :: (forall b. Data b => b -> b) -> SetSeq -> SetSeq
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SetSeq)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SetSeq)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SetSeq)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SetSeq)
dataTypeOf :: SetSeq -> DataType
$cdataTypeOf :: SetSeq -> DataType
toConstr :: SetSeq -> Constr
$ctoConstr :: SetSeq -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SetSeq
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SetSeq
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SetSeq -> c SetSeq
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SetSeq -> c SetSeq
$cp1Data :: Typeable SetSeq
Data, Typeable, (forall x. SetSeq -> Rep SetSeq x)
-> (forall x. Rep SetSeq x -> SetSeq) -> Generic SetSeq
forall x. Rep SetSeq x -> SetSeq
forall x. SetSeq -> Rep SetSeq x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SetSeq x -> SetSeq
$cfrom :: forall x. SetSeq -> Rep SetSeq x
Generic)

instance Storable SetSeq where
  sizeOf :: SetSeq -> Int
sizeOf SetSeq
_ = Int
16
  {-# INLINE sizeOf #-}
  alignment :: SetSeq -> Int
alignment SetSeq
_ = Int
8
  {-# INLINE alignment #-}
  poke :: Ptr SetSeq -> SetSeq -> IO ()
poke Ptr SetSeq
ptr (SetSeq Word64
x Word64
y) = Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word64
ptr' Word64
x IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Word64 -> Int -> Word64 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word64
ptr' Int
1 Word64
y
    where ptr' :: Ptr Word64
ptr' = Ptr SetSeq -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr SetSeq
ptr
  {-# INLINE poke #-}
  peek :: Ptr SetSeq -> IO SetSeq
peek Ptr SetSeq
ptr = do
    let ptr' :: Ptr Word64
ptr' = Ptr SetSeq -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr SetSeq
ptr
    Word64
s <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
ptr'
    Word64
inc <- Ptr Word64 -> Int -> IO Word64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word64
ptr' Int
1
    SetSeq -> IO SetSeq
forall (m :: * -> *) a. Monad m => a -> m a
return (SetSeq -> IO SetSeq) -> SetSeq -> IO SetSeq
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> SetSeq
SetSeq Word64
s Word64
inc
  {-# INLINE peek #-}

-- | Fixed seed.
seed :: SetSeq
seed :: SetSeq
seed = Word64 -> Word64 -> SetSeq
SetSeq Word64
9600629759793949339 Word64
15726070495360670683

-- Internals -----------------------------------------------------------

-- All operations are done via Pair to ensure everything's strict. Ghc
-- is normally pretty good at inlining this, so Pair rarely exists in
-- core.
data Pair = Pair
  {-# UNPACK #-} !Word64 -- step
  {-# UNPACK #-} !Word32 -- output

multiplier :: Word64
multiplier :: Word64
multiplier = Word64
6364136223846793005

-- A single step in the generator
state :: SetSeq -> Word64
state :: SetSeq -> Word64
state (SetSeq Word64
s Word64
inc) = Word64
s Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
multiplier Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
inc
{-# INLINE state #-}

-- The random number output
output :: Word64 -> Word32
output :: Word64 -> Word32
output Word64
s =
  (Word32
shifted Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
rot) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
shifted Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int -> Int
forall a. Num a => a -> a
negate Int
rot Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
31))
  where
    rot :: Int
rot     = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Word64 -> Int
forall a b. (a -> b) -> a -> b
$ Word64
s Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
59 :: Int
    shifted :: Word32
shifted = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word32) -> Word64 -> Word32
forall a b. (a -> b) -> a -> b
$ ((Word64
s Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
18) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
s) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
27 :: Word32
{-# INLINE output #-}

-- increment the sequence by one
pair :: SetSeq -> Pair
pair :: SetSeq -> Pair
pair g :: SetSeq
g@(SetSeq Word64
s Word64
_) = Word64 -> Word32 -> Pair
Pair (SetSeq -> Word64
state SetSeq
g) (Word64 -> Word32
output Word64
s)
{-# INLINE pair #-}

-- Given some bound and the generator, compute the new step and bounded
-- random number.
bounded :: Word32 -> SetSeq -> Pair
bounded :: Word32 -> SetSeq -> Pair
bounded Word32
b (SetSeq Word64
s0 Word64
inc) = Word64 -> Pair
go Word64
s0
  where
    t :: Word32
t = Word32 -> Word32
forall a. Num a => a -> a
negate Word32
b Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`mod` Word32
b
    go :: Word64 -> Pair
go !Word64
s | Word32
r Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
t    = Word64 -> Word32 -> Pair
Pair Word64
s' (Word32
r Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`mod` Word32
b)
          | Bool
otherwise = Word64 -> Pair
go Word64
s'
      where Pair Word64
s' Word32
r = SetSeq -> Pair
pair (Word64 -> Word64 -> SetSeq
SetSeq Word64
s Word64
inc)
{-# INLINE bounded #-}

advancing
  :: Word64 -- amount to advance by
  -> Word64 -- state
  -> Word64 -- multiplier
  -> Word64 -- increment
  -> Word64 -- new state
advancing :: Word64 -> Word64 -> Word64 -> Word64 -> Word64
advancing Word64
d0 Word64
s Word64
m0 Word64
p0 = Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> Word64
go Word64
d0 Word64
m0 Word64
p0 Word64
1 Word64
0
  where
    go :: Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> Word64
go Word64
d Word64
cm Word64
cp Word64
am Word64
ap
      | Word64
d Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0    = Word64
am Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
s Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
ap
      | Word64 -> Bool
forall a. Integral a => a -> Bool
odd Word64
d     = Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> Word64
go Word64
d' Word64
cm' Word64
cp' (Word64
am Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
cm) (Word64
ap Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
cm Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
cp)
      | Bool
otherwise = Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> Word64
go Word64
d' Word64
cm' Word64
cp' Word64
am        Word64
ap
      where
        cm' :: Word64
cm' = Word64
cm Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
cm
        cp' :: Word64
cp' = (Word64
cm Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
cp
        d' :: Word64
d'  = Word64
d Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
2

-- | Pure version of 'advance'.
advanceSetSeq :: Word64 -> FrozenGen -> FrozenGen
advanceSetSeq :: Word64 -> SetSeq -> SetSeq
advanceSetSeq Word64
d (SetSeq Word64
s Word64
inc) = Word64 -> Word64 -> SetSeq
SetSeq (Word64 -> Word64 -> Word64 -> Word64 -> Word64
advancing Word64
d Word64
s Word64
multiplier Word64
inc) Word64
inc

advanceSetSeq' :: Word64 -> FrozenGen -> Word64
advanceSetSeq' :: Word64 -> SetSeq -> Word64
advanceSetSeq' Word64
d (SetSeq Word64
s Word64
inc) = Word64 -> Word64 -> Word64 -> Word64 -> Word64
advancing Word64
d Word64
s Word64
multiplier Word64
inc

-- | Create a new generator from two words.
start :: Word64 -> Word64 -> SetSeq
start :: Word64 -> Word64 -> SetSeq
start Word64
a Word64
b = Word64 -> Word64 -> SetSeq
SetSeq Word64
s Word64
i
  where
    s :: Word64
s = SetSeq -> Word64
state (Word64 -> Word64 -> SetSeq
SetSeq (Word64
a Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
i) Word64
i)
    i :: Word64
i = (Word64
b Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
1
{-# INLINE start #-}

-- | Version of 'next' that returns a 'Word32'.
next' :: SetSeq -> (Word32, SetSeq)
next' :: SetSeq -> (Word32, SetSeq)
next' g :: SetSeq
g@(SetSeq Word64
_ Word64
inc) = (Word32
r, Word64 -> Word64 -> SetSeq
SetSeq Word64
s' Word64
inc)
  where Pair Word64
s' Word32
r = SetSeq -> Pair
pair SetSeq
g
{-# INLINE next' #-}

-- Multable ------------------------------------------------------------

-- | Save the state of a 'Gen' in a 'Seed'.
save :: PrimMonad m => Gen (PrimState m) -> m SetSeq
save :: Gen (PrimState m) -> m SetSeq
save (G MutableByteArray (PrimState m)
a) = do
  Word64
s   <- MutableByteArray (PrimState m) -> Int -> m Word64
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray (PrimState m)
a Int
0
  Word64
inc <- MutableByteArray (PrimState m) -> Int -> m Word64
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray (PrimState m)
a Int
1
  SetSeq -> m SetSeq
forall (m :: * -> *) a. Monad m => a -> m a
return (SetSeq -> m SetSeq) -> SetSeq -> m SetSeq
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> SetSeq
SetSeq Word64
s Word64
inc
{-# INLINE save #-}

-- | Restore a 'Gen' from a 'Seed'.
restore :: PrimMonad m => FrozenGen -> m (Gen (PrimState m))
restore :: SetSeq -> m (Gen (PrimState m))
restore (SetSeq Word64
s Word64
inc) = do
  MutableByteArray (PrimState m)
a <- Int -> m (MutableByteArray (PrimState m))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
16
  MutableByteArray (PrimState m) -> Int -> Word64 -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
a Int
0 Word64
s
  MutableByteArray (PrimState m) -> Int -> Word64 -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
a Int
1 Word64
inc
  Gen (PrimState m) -> m (Gen (PrimState m))
forall (m :: * -> *) a. Monad m => a -> m a
return (Gen (PrimState m) -> m (Gen (PrimState m)))
-> Gen (PrimState m) -> m (Gen (PrimState m))
forall a b. (a -> b) -> a -> b
$! MutableByteArray (PrimState m) -> Gen (PrimState m)
forall s. MutableByteArray s -> Gen s
G MutableByteArray (PrimState m)
a
{-# INLINE restore #-}

-- | Create a new generator from two words.
--
-- >>> Pure.initFrozen 0 0
-- SetSeq 6364136223846793006 1
initFrozen :: Word64 -> Word64 -> SetSeq
initFrozen :: Word64 -> Word64 -> SetSeq
initFrozen = Word64 -> Word64 -> SetSeq
start

-- | Create a 'Gen' from a fixed initial seed.
create :: PrimMonad m => m (Gen (PrimState m))
create :: m (Gen (PrimState m))
create = SetSeq -> m (Gen (PrimState m))
forall (m :: * -> *).
PrimMonad m =>
SetSeq -> m (Gen (PrimState m))
restore SetSeq
seed

-- | Initialize a generator a single word.
--
--   >>> Pure.initialize 0 0 >>= Pure.save
--   SetSeq 6364136223846793006 1
initialize :: PrimMonad m => Word64 -> Word64 -> m (Gen (PrimState m))
initialize :: Word64 -> Word64 -> m (Gen (PrimState m))
initialize Word64
a Word64
b = SetSeq -> m (Gen (PrimState m))
forall (m :: * -> *).
PrimMonad m =>
SetSeq -> m (Gen (PrimState m))
restore (Word64 -> Word64 -> SetSeq
initFrozen Word64
a Word64
b)

-- | Seed with system random number. (@\/dev\/urandom@ on Unix-like
--   systems and CryptAPI on Windows).
withSystemRandom :: (GenIO -> IO a) -> IO a
withSystemRandom :: (GenIO -> IO a) -> IO a
withSystemRandom GenIO -> IO a
f = do
  Word64
a <- IO Word64
sysRandom
  Word64
b <- IO Word64
sysRandom
  Word64 -> Word64 -> IO (Gen (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Word64 -> Word64 -> m (Gen (PrimState m))
initialize Word64
a Word64
b IO GenIO -> (GenIO -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GenIO -> IO a
f

-- | Seed with system random number. (@\/dev\/urandom@ on Unix-like
--   systems and CryptAPI on Windows).
createSystemRandom :: IO GenIO
createSystemRandom :: IO GenIO
createSystemRandom = (GenIO -> IO GenIO) -> IO GenIO
forall a. (GenIO -> IO a) -> IO a
withSystemRandom GenIO -> IO GenIO
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Advance the given generator n steps in log(n) time. (Note that a
--   \"step\" is a single random 32-bit (or less) 'Variate'. Data types
--   such as 'Double' or 'Word64' require two \"steps\".)
--
--   >>> Pure.create >>= \g -> replicateM_ 1000 (uniformW32 g) >> uniformW32 g
--   3640764222
--   >>> Pure.create >>= \g -> replicateM_ 500 (uniformD g) >> uniformW32 g
--   3640764222
--   >>> Pure.create >>= \g -> Pure.advance 1000 g >> uniformW32 g
--   3640764222
advance :: PrimMonad m => Word64 -> Gen (PrimState m) -> m ()
advance :: Word64 -> Gen (PrimState m) -> m ()
advance Word64
u g :: Gen (PrimState m)
g@(G MutableByteArray (PrimState m)
a) = do
  SetSeq
ss <- Gen (PrimState m) -> m SetSeq
forall (m :: * -> *). PrimMonad m => Gen (PrimState m) -> m SetSeq
save Gen (PrimState m)
g
  let s' :: Word64
s' = Word64 -> SetSeq -> Word64
advanceSetSeq' Word64
u SetSeq
ss
  MutableByteArray (PrimState m) -> Int -> Word64 -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
a Int
0 Word64
s'
{-# INLINE advance #-}

-- | Retract the given generator n steps in log(2^64-n) time. This
--   is just @advance (-n)@.
--
--   >>> Pure.create >>= \g -> replicateM 3 (uniformW32 g)
--   [355248013,41705475,3406281715]
--   >>> Pure.create >>= \g -> Pure.retract 1 g >> replicateM 3 (uniformW32 g)
--   [19683962,355248013,41705475]
retract :: PrimMonad m => Word64 -> Gen (PrimState m) -> m ()
retract :: Word64 -> Gen (PrimState m) -> m ()
retract Word64
u Gen (PrimState m)
g = Word64 -> Gen (PrimState m) -> m ()
forall (m :: * -> *).
PrimMonad m =>
Word64 -> Gen (PrimState m) -> m ()
advance (-Word64
u) Gen (PrimState m)
g
{-# INLINE retract #-}

------------------------------------------------------------------------
-- Instances
------------------------------------------------------------------------

instance (PrimMonad m, s ~ PrimState m) => Generator (Gen s) m where
  uniform1 :: (Word32 -> a) -> Gen s -> m a
uniform1 Word32 -> a
f (G MutableByteArray s
a) = do
    Word64
s   <- MutableByteArray (PrimState m) -> Int -> m Word64
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray s
MutableByteArray (PrimState m)
a Int
0
    Word64
inc <- MutableByteArray (PrimState m) -> Int -> m Word64
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray s
MutableByteArray (PrimState m)
a Int
1
    MutableByteArray (PrimState m) -> Int -> Word64 -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray s
MutableByteArray (PrimState m)
a Int
0 (Word64 -> m ()) -> Word64 -> m ()
forall a b. (a -> b) -> a -> b
$! Word64
s Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
multiplier Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
inc
    a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$! Word32 -> a
f (Word64 -> Word32
output Word64
s)
  {-# INLINE uniform1 #-}

  uniform2 :: (Word32 -> Word32 -> a) -> Gen s -> m a
uniform2 Word32 -> Word32 -> a
f (G MutableByteArray s
a) = do
    Word64
s   <- MutableByteArray (PrimState m) -> Int -> m Word64
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray s
MutableByteArray (PrimState m)
a Int
0
    Word64
inc <- MutableByteArray (PrimState m) -> Int -> m Word64
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray s
MutableByteArray (PrimState m)
a Int
1
    let !s' :: Word64
s' = Word64
s Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
multiplier Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
inc
    MutableByteArray (PrimState m) -> Int -> Word64 -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray s
MutableByteArray (PrimState m)
a Int
0 (Word64 -> m ()) -> Word64 -> m ()
forall a b. (a -> b) -> a -> b
$! Word64
s' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
multiplier Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
inc
    a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$! Word32 -> Word32 -> a
f (Word64 -> Word32
output Word64
s) (Word64 -> Word32
output Word64
s')
  {-# INLINE uniform2 #-}

  uniform1B :: (Word32 -> a) -> Word32 -> Gen s -> m a
uniform1B Word32 -> a
f Word32
b g :: Gen s
g@(G MutableByteArray s
a) = do
    SetSeq
ss <- Gen (PrimState m) -> m SetSeq
forall (m :: * -> *). PrimMonad m => Gen (PrimState m) -> m SetSeq
save Gen s
Gen (PrimState m)
g
    let Pair Word64
s' Word32
r = Word32 -> SetSeq -> Pair
bounded Word32
b SetSeq
ss
    MutableByteArray (PrimState m) -> Int -> Word64 -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray s
MutableByteArray (PrimState m)
a Int
0 Word64
s'
    a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$! Word32 -> a
f Word32
r
  {-# INLINE uniform1B #-}

instance RandomGen FrozenGen where
  next :: SetSeq -> (Int, SetSeq)
next (SetSeq Word64
s Word64
inc) = (Word32 -> Word32 -> Int
forall a. Integral a => Word32 -> Word32 -> a
wordsTo64Bit Word32
w1 Word32
w2, Word64 -> Word64 -> SetSeq
SetSeq Word64
s'' Word64
inc)
    where
      Pair Word64
s'  Word32
w1 = SetSeq -> Pair
pair (Word64 -> Word64 -> SetSeq
SetSeq Word64
s Word64
inc)
      Pair Word64
s'' Word32
w2 = SetSeq -> Pair
pair (Word64 -> Word64 -> SetSeq
SetSeq Word64
s' Word64
inc)
  {-# INLINE next #-}

  split :: SetSeq -> (SetSeq, SetSeq)
split (SetSeq Word64
s Word64
inc) = (Word64 -> Word64 -> SetSeq
SetSeq Word64
s4 Word64
inc, Word32 -> Word32 -> Word32 -> Word32 -> SetSeq
mk Word32
w1 Word32
w2 Word32
w3 Word32
w4)
    where
      mk :: Word32 -> Word32 -> Word32 -> Word32 -> SetSeq
mk Word32
a Word32
b Word32
c Word32
d = Word64 -> Word64 -> SetSeq
start (Word32 -> Word32 -> Word64
forall a. Integral a => Word32 -> Word32 -> a
wordsTo64Bit Word32
a Word32
b) (Word32 -> Word32 -> Word64
forall a. Integral a => Word32 -> Word32 -> a
wordsTo64Bit Word32
c Word32
d)
      Pair Word64
s1 Word32
w1 = SetSeq -> Pair
pair (Word64 -> Word64 -> SetSeq
SetSeq Word64
s  Word64
inc)
      Pair Word64
s2 Word32
w2 = SetSeq -> Pair
pair (Word64 -> Word64 -> SetSeq
SetSeq Word64
s1 Word64
inc)
      Pair Word64
s3 Word32
w3 = SetSeq -> Pair
pair (Word64 -> Word64 -> SetSeq
SetSeq Word64
s2 Word64
inc)
      Pair Word64
s4 Word32
w4 = SetSeq -> Pair
pair (Word64 -> Word64 -> SetSeq
SetSeq Word64
s3 Word64
inc)
  {-# INLINE split #-}