{-# LANGUAGE CPP                        #-}
{-# LANGUAGE ForeignFunctionInterface   #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
--------------------------------------------------------------------
-- |
-- Module     : System.Random.PCG.Unique
-- 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
--
-- Unique variant of the PCG random number generator. Guarantees the
-- sequence to be unique by using the pointer address to select the
-- output sequence.
--
-- There is no way to freeze the state  because then it wouldn't be
-- unique anymore. Also, generators can't be initialized in ST because
-- we don't know what pointer reference they'll get.
--
-- See <http://www.pcg-random.org> for details.
--
-- @
-- import System.Random.PCG.Unique
--
-- three :: IO [Double]
-- three = do
--   g <- create
--   a <- uniform g
--   b <- uniform g
--   c <- uniform g
--   return [a,b,c]
-- @

module System.Random.PCG.Unique
  ( -- * Gen
    Gen
  , create, createSystemRandom, initialize, withSystemRandom

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

    -- * 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

#if __GLASGOW_HASKELL__ < 710
import Data.Functor
#endif
import Foreign

import System.Random.PCG.Class

-- | Standard initial seed.
seed :: Word64
seed :: Word64
seed = Word64
0x4d595df4d0f33173

-- | Create a 'Gen' from a fixed initial seed.
create :: IO Gen
create :: IO Gen
create = Word64 -> IO Gen
initialize Word64
seed
  -- do
  -- p <- malloc
  -- poke p seed
  -- return (Gen p)

  -- Note that this does produce a unique sequence but if two generators
  -- are created in sequence they'll have the similar pointer references
  -- and the first couple of numbers are likely to be the same. Since
  -- this is undesirable we run initialise to randomise it.

------------------------------------------------------------------------
-- Generator
------------------------------------------------------------------------

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

-- | Create a generator from two words. Note: this is not the same as the
--   two words in a 'Seed'.
initialize :: Word64 -> IO Gen
initialize :: Word64 -> IO Gen
initialize Word64
a = do
  Ptr Word64
p <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
malloc
  Ptr Word64 -> Word64 -> IO ()
pcg32u_srandom_r Ptr Word64
p Word64
a
  Gen -> IO Gen
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word64 -> Gen
Gen Ptr Word64
p)

-- | Seed with system random number. (\"@\/dev\/urandom@\" on Unix-like
--   systems, time otherwise).
withSystemRandom :: (Gen -> IO a) -> IO a
withSystemRandom :: (Gen -> IO a) -> IO a
withSystemRandom Gen -> IO a
f = IO Word64
sysRandom IO Word64 -> (Word64 -> IO Gen) -> IO Gen
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word64 -> IO Gen
initialize IO Gen -> (Gen -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Gen -> IO a
f

-- | 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 Gen
createSystemRandom :: IO Gen
createSystemRandom = (Gen -> IO Gen) -> IO Gen
forall a. (Gen -> IO a) -> IO a
withSystemRandom Gen -> IO Gen
forall (m :: * -> *) a. Monad m => a -> m a
return

-- -- | Generate a uniform 'Word32' bounded above by the given bound.
-- uniformB :: Word32 -> UGen -> IO Word32
-- uniformB u (UGen p) = unsafePrimToPrim $ pcg32u_boundedrand_r p u
-- {-# INLINE uniformB #-}

-- | Advance the given generator n steps in log(n) time.
advance :: Word64 -> Gen -> IO ()
advance :: Word64 -> Gen -> IO ()
advance Word64
u (Gen Ptr Word64
p) = Ptr Word64 -> Word64 -> IO ()
pcg32u_advance_r Ptr Word64
p Word64
u
{-# INLINE advance #-}

-- | Retract the given generator n steps in log(2^64-n) time. This
--   is just @advance (-n)@.
retract :: Word64 -> Gen -> IO ()
retract :: Word64 -> Gen -> IO ()
retract Word64
u Gen
g = Word64 -> Gen -> IO ()
advance (-Word64
u) Gen
g
{-# INLINE retract #-}

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

foreign import ccall unsafe "pcg_unique_64_srandom_r"
  pcg32u_srandom_r :: Ptr Word64 -> Word64 -> IO ()

foreign import ccall unsafe "pcg_unique_64_xsh_rs_32_random_r"
  pcg32u_random_r :: Ptr Word64 -> IO Word32

foreign import ccall unsafe "pcg_unique_64_xsh_rs_32_boundedrand_r"
  pcg32u_boundedrand_r :: Ptr Word64 -> Word32 -> IO Word32

foreign import ccall unsafe "pcg_unique_64_advance_r"
  pcg32u_advance_r :: Ptr Word64 -> Word64 -> IO ()

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

instance Generator Gen IO where
  uniform1 :: (Word32 -> a) -> Gen -> IO a
uniform1 Word32 -> a
f (Gen Ptr Word64
p) = Word32 -> a
f (Word32 -> a) -> IO Word32 -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word64 -> IO Word32
pcg32u_random_r Ptr Word64
p
  {-# INLINE uniform1 #-}

  uniform2 :: (Word32 -> Word32 -> a) -> Gen -> IO a
uniform2 Word32 -> Word32 -> a
f (Gen Ptr Word64
p) = do
    Word32
w1 <- Ptr Word64 -> IO Word32
pcg32u_random_r Ptr Word64
p
    Word32
w2 <- Ptr Word64 -> IO Word32
pcg32u_random_r Ptr Word64
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 :: (Word32 -> a) -> Word32 -> Gen -> IO a
uniform1B Word32 -> a
f Word32
b (Gen Ptr Word64
p) = Word32 -> a
f (Word32 -> a) -> IO Word32 -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word64 -> Word32 -> IO Word32
pcg32u_boundedrand_r Ptr Word64
p Word32
b
  {-# INLINE uniform1B #-}