{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE ForeignFunctionInterface   #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE TypeFamilies               #-}
#if __GLASGOW_HASKELL__ >= 707
{-# LANGUAGE RoleAnnotations            #-}
#endif
--------------------------------------------------------------------
-- |
-- Module     : System.Random.PCG
-- Copyright  : Copyright (c) 2014-2015, Christopher Chalmers <c.chalmers@me.com>
-- License    : BSD3
-- Maintainer : Christopher Chalmers <c.chalmers@me.com>
-- Stability  : experimental
-- Portability: CPP, FFI
--
-- Standard PCG Random Number Generator with chosen streams. See
-- <http://www.pcg-random.org> for details.
--
-- @
-- import Control.Monad.ST
-- import System.Random.PCG
--
-- three :: [Double]
-- three = runST $ do
--   g <- create
--   a <- uniform g
--   b <- uniform g
--   c <- uniform g
--   return [a,b,c]
-- @

module System.Random.PCG
  ( -- * Generator
    Gen, GenIO, GenST
  , create, createSystemRandom, initialize
  , withSystemRandom, withFrozen

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

    -- * Frozen generator
  , 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
  ) where

import Control.Applicative
import Control.Monad.Primitive
import Control.Monad.ST
import Data.Data
import Foreign
import GHC.Generics
import System.IO.Unsafe
import System.Random

import System.Random.PCG.Class

-- $setup
-- >>> import System.Random.PCG
-- >>> import System.Random.PCG.Class
-- >>> import Control.Monad

------------------------------------------------------------------------
-- State
------------------------------------------------------------------------

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

-- | Save the state of a 'Gen' in a 'FrozenGen'.
save :: PrimMonad m => Gen (PrimState m) -> m FrozenGen
save :: forall (m :: * -> *).
PrimMonad m =>
Gen (PrimState m) -> m FrozenGen
save (Gen Ptr FrozenGen
p) = IO FrozenGen -> m FrozenGen
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim (Ptr FrozenGen -> IO FrozenGen
forall a. Storable a => Ptr a -> IO a
peek Ptr FrozenGen
p)
{-# INLINE save #-}

-- | Restore a 'Gen' from a 'FrozenGen'.
restore :: PrimMonad m => FrozenGen -> m (Gen (PrimState m))
restore :: forall (m :: * -> *).
PrimMonad m =>
FrozenGen -> m (Gen (PrimState m))
restore FrozenGen
s = IO (Gen (PrimState m)) -> m (Gen (PrimState m))
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim (IO (Gen (PrimState m)) -> m (Gen (PrimState m)))
-> IO (Gen (PrimState m)) -> m (Gen (PrimState m))
forall a b. (a -> b) -> a -> b
$ do
  Ptr FrozenGen
p <- IO (Ptr FrozenGen)
forall a. Storable a => IO (Ptr a)
malloc
  Ptr FrozenGen -> FrozenGen -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr FrozenGen
p FrozenGen
s
  Gen (PrimState m) -> IO (Gen (PrimState m))
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr FrozenGen -> Gen (PrimState m)
forall s. Ptr FrozenGen -> Gen s
Gen Ptr FrozenGen
p)
{-# INLINE restore #-}

-- | Fixed seed.
seed :: FrozenGen
seed :: FrozenGen
seed = Word64 -> Word64 -> FrozenGen
FrozenGen Word64
0x853c49e6748fea9b Word64
0xda3e39cb94b95bdb

-- | Generate a new seed using two 'Word64's.
--
--   >>> initFrozen 0 0
--   FrozenGen 6364136223846793006 1
initFrozen :: Word64 -> Word64 -> FrozenGen
initFrozen :: Word64 -> Word64 -> FrozenGen
initFrozen Word64
w1 Word64
w2 = IO FrozenGen -> FrozenGen
forall a. IO a -> a
unsafeDupablePerformIO (IO FrozenGen -> FrozenGen) -> IO FrozenGen -> FrozenGen
forall a b. (a -> b) -> a -> b
$ do
  Ptr FrozenGen
p <- IO (Ptr FrozenGen)
forall a. Storable a => IO (Ptr a)
malloc
  Ptr FrozenGen -> Word64 -> Word64 -> IO ()
pcg32_srandom_r Ptr FrozenGen
p Word64
w1 Word64
w2
  Ptr FrozenGen -> IO FrozenGen
forall a. Storable a => Ptr a -> IO a
peek Ptr FrozenGen
p IO FrozenGen -> IO () -> IO FrozenGen
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Ptr FrozenGen -> IO ()
forall a. Ptr a -> IO ()
free Ptr FrozenGen
p
{-# INLINE initFrozen #-}

instance Storable FrozenGen where
  sizeOf :: FrozenGen -> Int
sizeOf FrozenGen
_ = Int
16
  {-# INLINE sizeOf #-}
  alignment :: FrozenGen -> Int
alignment FrozenGen
_ = Int
8
  {-# INLINE alignment #-}
  poke :: Ptr FrozenGen -> FrozenGen -> IO ()
poke Ptr FrozenGen
ptr (FrozenGen 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 FrozenGen -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr FrozenGen
ptr
  {-# INLINE poke #-}
  peek :: Ptr FrozenGen -> IO FrozenGen
peek Ptr FrozenGen
ptr = Word64 -> Word64 -> FrozenGen
FrozenGen (Word64 -> Word64 -> FrozenGen)
-> IO Word64 -> IO (Word64 -> FrozenGen)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
ptr' IO (Word64 -> FrozenGen) -> IO Word64 -> IO FrozenGen
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Word64 -> Int -> IO Word64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word64
ptr' Int
1
    where ptr' :: Ptr Word64
ptr' = Ptr FrozenGen -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr FrozenGen
ptr
  {-# INLINE peek #-}

------------------------------------------------------------------------
-- PrimMonad interface
------------------------------------------------------------------------

-- | State of the random number generator
newtype Gen s = Gen (Ptr FrozenGen)
  deriving (Gen s -> Gen s -> Bool
(Gen s -> Gen s -> Bool) -> (Gen s -> Gen s -> Bool) -> Eq (Gen s)
forall s. Gen s -> Gen s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Gen s -> Gen s -> Bool
$c/= :: forall s. Gen s -> Gen s -> Bool
== :: Gen s -> Gen s -> Bool
$c== :: forall s. Gen s -> Gen s -> Bool
Eq, Eq (Gen s)
Eq (Gen s)
-> (Gen s -> Gen s -> Ordering)
-> (Gen s -> Gen s -> Bool)
-> (Gen s -> Gen s -> Bool)
-> (Gen s -> Gen s -> Bool)
-> (Gen s -> Gen s -> Bool)
-> (Gen s -> Gen s -> Gen s)
-> (Gen s -> Gen s -> Gen s)
-> Ord (Gen s)
Gen s -> Gen s -> Bool
Gen s -> Gen s -> Ordering
Gen s -> Gen s -> Gen s
forall s. Eq (Gen s)
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
forall s. Gen s -> Gen s -> Bool
forall s. Gen s -> Gen s -> Ordering
forall s. Gen s -> Gen s -> Gen s
min :: Gen s -> Gen s -> Gen s
$cmin :: forall s. Gen s -> Gen s -> Gen s
max :: Gen s -> Gen s -> Gen s
$cmax :: forall s. Gen s -> Gen s -> Gen s
>= :: Gen s -> Gen s -> Bool
$c>= :: forall s. Gen s -> Gen s -> Bool
> :: Gen s -> Gen s -> Bool
$c> :: forall s. Gen s -> Gen s -> Bool
<= :: Gen s -> Gen s -> Bool
$c<= :: forall s. Gen s -> Gen s -> Bool
< :: Gen s -> Gen s -> Bool
$c< :: forall s. Gen s -> Gen s -> Bool
compare :: Gen s -> Gen s -> Ordering
$ccompare :: forall s. Gen s -> Gen s -> Ordering
Ord)

#if __GLASGOW_HASKELL__ >= 707
type role Gen representational
#endif

-- this should be type safe because the Gen cannot escape its PrimMonad

-- | Type alias of 'Gen' specialized to 'IO'.
type GenIO = Gen RealWorld

-- | Type alias of 'Gen' specialized to 'ST'.
type GenST s = Gen s
-- Note this doesn't force it to be in ST. You can write (STGen Realworld)
-- and it'll work in IO. Writing STGen s = Gen (PrimState (ST s)) doesn't
-- solve this.

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

-- | Initialize a generator with two words.
--
--   >>> initialize 0 0 >>= save
--   FrozenGen 6364136223846793006 1
initialize :: PrimMonad m => Word64 -> Word64 -> m (Gen (PrimState m))
initialize :: forall (m :: * -> *).
PrimMonad m =>
Word64 -> Word64 -> m (Gen (PrimState m))
initialize Word64
a Word64
b = IO (Gen (PrimState m)) -> m (Gen (PrimState m))
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim (IO (Gen (PrimState m)) -> m (Gen (PrimState m)))
-> IO (Gen (PrimState m)) -> m (Gen (PrimState m))
forall a b. (a -> b) -> a -> b
$ do
  Ptr FrozenGen
p <- IO (Ptr FrozenGen)
forall a. Storable a => IO (Ptr a)
malloc
  Ptr FrozenGen -> Word64 -> Word64 -> IO ()
pcg32_srandom_r Ptr FrozenGen
p Word64
a Word64
b
  Gen (PrimState m) -> IO (Gen (PrimState m))
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr FrozenGen -> Gen (PrimState m)
forall s. Ptr FrozenGen -> Gen s
Gen Ptr FrozenGen
p)

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

-- | Run an action with a frozen generator, returning the result and the
--   new frozen generator.
withFrozen :: FrozenGen -> (forall s. Gen s -> ST s a) -> (a, FrozenGen)
withFrozen :: forall a.
FrozenGen -> (forall s. Gen s -> ST s a) -> (a, FrozenGen)
withFrozen FrozenGen
s forall s. Gen s -> ST s a
f = (forall s. ST s (a, FrozenGen)) -> (a, FrozenGen)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (a, FrozenGen)) -> (a, FrozenGen))
-> (forall s. ST s (a, FrozenGen)) -> (a, FrozenGen)
forall a b. (a -> b) -> a -> b
$ FrozenGen -> ST s (Gen (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
FrozenGen -> m (Gen (PrimState m))
restore FrozenGen
s ST s (Gen s)
-> (Gen s -> ST s (a, FrozenGen)) -> ST s (a, FrozenGen)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Gen s
g -> (a -> FrozenGen -> (a, FrozenGen))
-> ST s a -> ST s FrozenGen -> ST s (a, FrozenGen)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (Gen s -> ST s a
forall s. Gen s -> ST s a
f Gen s
g) (Gen (PrimState (ST s)) -> ST s FrozenGen
forall (m :: * -> *).
PrimMonad m =>
Gen (PrimState m) -> m FrozenGen
save Gen s
Gen (PrimState (ST s))
g)

-- | Seed a PRNG with data from the system's fast source of pseudo-random
-- numbers. All the caveats of 'withSystemRandom' apply here as well.
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 :: GenIO -> IO GenIO)

-- -- | Generate a uniform 'Word32' bounded by the given bound.
-- uniformB :: PrimMonad m => Word32 -> Gen (PrimState m) -> m Word32
-- uniformB u (Gen p) = unsafePrimToPrim $ pcg32_boundedrand_r p u
-- {-# INLINE uniformB #-}

-- | 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\".)
--
--   >>> create >>= \g -> replicateM_ 1000 (uniformW32 g) >> uniformW32 g
--   3640764222
--   >>> create >>= \g -> replicateM_ 500 (uniformD g) >> uniformW32 g
--   3640764222
--   >>> create >>= \g -> advance 1000 g >> uniformW32 g
--   3640764222
advance :: PrimMonad m => Word64 -> Gen (PrimState m) -> m ()
advance :: forall (m :: * -> *).
PrimMonad m =>
Word64 -> Gen (PrimState m) -> m ()
advance Word64
u (Gen Ptr FrozenGen
p) = IO () -> m ()
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ptr FrozenGen -> Word64 -> IO ()
pcg32_advance_r Ptr FrozenGen
p Word64
u
{-# INLINE advance #-}

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

------------------------------------------------------------------------
-- Foreign calls
------------------------------------------------------------------------

-- It shouldn't be too hard to impliment the algorithm in pure haskell.
-- For now just use the c interface.

-- For whatever reason, calling the #defined versions doesn't seem to work
-- so we need to call the low-level api directly

foreign import ccall unsafe "pcg_setseq_64_srandom_r"
  pcg32_srandom_r :: Ptr FrozenGen -> Word64 -> Word64 -> IO ()

foreign import ccall unsafe "pcg_setseq_64_xsh_rr_32_random_r"
  pcg32_random_r :: Ptr FrozenGen -> IO Word32

foreign import ccall unsafe "pcg_setseq_64_xsh_rr_32_boundedrand_r"
  pcg32_boundedrand_r :: Ptr FrozenGen -> Word32 -> IO Word32

foreign import ccall unsafe "pcg_setseq_64_advance_r"
  pcg32_advance_r :: Ptr FrozenGen -> Word64 -> IO ()

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

instance (PrimMonad m, s ~ PrimState m) => Generator (Gen s) m where
  uniform1 :: forall a. (Word32 -> a) -> Gen s -> m a
uniform1 Word32 -> a
f (Gen Ptr FrozenGen
p) = IO a -> m a
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ Word32 -> a
f (Word32 -> a) -> IO Word32 -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr FrozenGen -> IO Word32
pcg32_random_r Ptr FrozenGen
p
  {-# INLINE uniform1 #-}

  uniform2 :: forall a. (Word32 -> Word32 -> a) -> Gen s -> m a
uniform2 Word32 -> Word32 -> a
f (Gen Ptr FrozenGen
p) = IO a -> m a
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ do
    Word32
w1 <- Ptr FrozenGen -> IO Word32
pcg32_random_r Ptr FrozenGen
p
    Word32
w2 <- Ptr FrozenGen -> IO Word32
pcg32_random_r Ptr FrozenGen
p
    a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> a
f Word32
w1 Word32
w2
  {-# INLINE uniform2 #-}

  uniform1B :: forall a. Integral a => (Word32 -> a) -> Word32 -> Gen s -> m a
uniform1B Word32 -> a
f Word32
b (Gen Ptr FrozenGen
p) = IO a -> m a
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ Word32 -> a
f (Word32 -> a) -> IO Word32 -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr FrozenGen -> Word32 -> IO Word32
pcg32_boundedrand_r Ptr FrozenGen
p Word32
b
  {-# INLINE uniform1B #-}

instance RandomGen FrozenGen where
  genWord64 :: FrozenGen -> (Word64, FrozenGen)
genWord64 FrozenGen
s = IO (Word64, FrozenGen) -> (Word64, FrozenGen)
forall a. IO a -> a
unsafeDupablePerformIO (IO (Word64, FrozenGen) -> (Word64, FrozenGen))
-> IO (Word64, FrozenGen) -> (Word64, FrozenGen)
forall a b. (a -> b) -> a -> b
$ do
    Ptr FrozenGen
p <- IO (Ptr FrozenGen)
forall a. Storable a => IO (Ptr a)
malloc
    Ptr FrozenGen -> FrozenGen -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr FrozenGen
p FrozenGen
s
    Word32
w1 <- Ptr FrozenGen -> IO Word32
pcg32_random_r Ptr FrozenGen
p
    Word32
w2 <- Ptr FrozenGen -> IO Word32
pcg32_random_r Ptr FrozenGen
p
    FrozenGen
s' <- Ptr FrozenGen -> IO FrozenGen
forall a. Storable a => Ptr a -> IO a
peek Ptr FrozenGen
p
    Ptr FrozenGen -> IO ()
forall a. Ptr a -> IO ()
free Ptr FrozenGen
p
    (Word64, FrozenGen) -> IO (Word64, FrozenGen)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> Word32 -> Word64
forall a. Integral a => Word32 -> Word32 -> a
wordsTo64Bit Word32
w1 Word32
w2, FrozenGen
s')
  {-# INLINE genWord64 #-}

  split :: FrozenGen -> (FrozenGen, FrozenGen)
split FrozenGen
s = IO (FrozenGen, FrozenGen) -> (FrozenGen, FrozenGen)
forall a. IO a -> a
unsafeDupablePerformIO (IO (FrozenGen, FrozenGen) -> (FrozenGen, FrozenGen))
-> IO (FrozenGen, FrozenGen) -> (FrozenGen, FrozenGen)
forall a b. (a -> b) -> a -> b
$ do
    Ptr FrozenGen
p <- IO (Ptr FrozenGen)
forall a. Storable a => IO (Ptr a)
malloc
    Ptr FrozenGen -> FrozenGen -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr FrozenGen
p FrozenGen
s
    Word32
w1 <- Ptr FrozenGen -> IO Word32
pcg32_random_r Ptr FrozenGen
p
    Word32
w2 <- Ptr FrozenGen -> IO Word32
pcg32_random_r Ptr FrozenGen
p
    Word32
w3 <- Ptr FrozenGen -> IO Word32
pcg32_random_r Ptr FrozenGen
p
    Word32
w4 <- Ptr FrozenGen -> IO Word32
pcg32_random_r Ptr FrozenGen
p
    Word32
w5 <- Ptr FrozenGen -> IO Word32
pcg32_random_r Ptr FrozenGen
p
    Word32
w6 <- Ptr FrozenGen -> IO Word32
pcg32_random_r Ptr FrozenGen
p
    Word32
w7 <- Ptr FrozenGen -> IO Word32
pcg32_random_r Ptr FrozenGen
p
    Word32
w8 <- Ptr FrozenGen -> IO Word32
pcg32_random_r Ptr FrozenGen
p
    Ptr FrozenGen -> Word64 -> Word64 -> IO ()
pcg32_srandom_r Ptr FrozenGen
p (Word32 -> Word32 -> Word64
forall a. Integral a => Word32 -> Word32 -> a
wordsTo64Bit Word32
w1 Word32
w2) (Word32 -> Word32 -> Word64
forall a. Integral a => Word32 -> Word32 -> a
wordsTo64Bit Word32
w3 Word32
w4)
    FrozenGen
s1 <- Ptr FrozenGen -> IO FrozenGen
forall a. Storable a => Ptr a -> IO a
peek Ptr FrozenGen
p
    Ptr FrozenGen -> Word64 -> Word64 -> IO ()
pcg32_srandom_r Ptr FrozenGen
p (Word32 -> Word32 -> Word64
forall a. Integral a => Word32 -> Word32 -> a
wordsTo64Bit Word32
w5 Word32
w6) (Word32 -> Word32 -> Word64
forall a. Integral a => Word32 -> Word32 -> a
wordsTo64Bit Word32
w7 Word32
w8)
    FrozenGen
s2 <- Ptr FrozenGen -> IO FrozenGen
forall a. Storable a => Ptr a -> IO a
peek Ptr FrozenGen
p
    Ptr FrozenGen -> IO ()
forall a. Ptr a -> IO ()
free Ptr FrozenGen
p
    (FrozenGen, FrozenGen) -> IO (FrozenGen, FrozenGen)
forall (m :: * -> *) a. Monad m => a -> m a
return (FrozenGen
s1,FrozenGen
s2)