module Hedgehog.Internal.Seed (
Seed(..)
, random
, from
, split
, nextInteger
, nextDouble
, goldenGamma
, nextWord64
, nextWord32
, mix64
, mix64variant13
, mix32
, mixGamma
) where
import Control.Monad.IO.Class (MonadIO(..))
import Data.Bifunctor (first)
import Data.Bits ((.|.), xor, shiftR, popCount)
import Data.Int (Int32, Int64)
import Data.Time.Clock.POSIX (getPOSIXTime)
import Data.IORef (IORef)
import qualified Data.IORef as IORef
import Data.Word (Word32, Word64)
import System.IO.Unsafe (unsafePerformIO)
import System.Random (RandomGen)
import qualified System.Random as Random
data Seed =
Seed {
seedValue :: !Word64
, seedGamma :: !Word64
} deriving (Eq, Ord)
instance Show Seed where
showsPrec p (Seed v g) =
showParen (p > 10) $
showString "Seed " .
showsPrec 11 v .
showChar ' ' .
showsPrec 11 g
instance Read Seed where
readsPrec p =
readParen (p > 10) $ \r0 -> do
("Seed", r1) <- lex r0
(v, r2) <- readsPrec 11 r1
(g, r3) <- readsPrec 11 r2
pure (Seed v g, r3)
global :: IORef Seed
global =
unsafePerformIO $ do
seconds <- getPOSIXTime
IORef.newIORef $ from (round (seconds * 1000))
random :: MonadIO m => m Seed
random =
liftIO $ IORef.atomicModifyIORef' global split
from :: Word64 -> Seed
from x =
Seed x goldenGamma
goldenGamma :: Word64
goldenGamma =
7046029254386353131
next :: Seed -> (Word64, Seed)
next (Seed v0 g) =
let
v = v0 + g
in
(v, Seed v g)
split :: Seed -> (Seed, Seed)
split s0 =
let
(v0, s1) = next s0
(g0, s2) = next s1
in
(s2, Seed (mix64 v0) (mixGamma g0))
nextWord64 :: Seed -> (Word64, Seed)
nextWord64 s0 =
let
(v0, s1) = next s0
in
(mix64 v0, s1)
nextWord32 :: Seed -> (Word32, Seed)
nextWord32 s0 =
let
(v0, s1) = next s0
in
(mix32 v0, s1)
nextInteger :: Integer -> Integer -> Seed -> (Integer, Seed)
nextInteger lo hi =
Random.randomR (lo, hi)
nextDouble :: Double -> Double -> Seed -> (Double, Seed)
nextDouble lo hi =
Random.randomR (lo, hi)
mix64 :: Word64 -> Word64
mix64 x =
let
y = (x `xor` (x `shiftR` 33)) * (49064778989728563)
z = (y `xor` (y `shiftR` 33)) * (4265267296055464877)
in
z `xor` (z `shiftR` 33)
mix32 :: Word64 -> Word32
mix32 x =
let
y = (x `xor` (x `shiftR` 33)) * (49064778989728563)
z = (y `xor` (y `shiftR` 33)) * (4265267296055464877)
in
fromIntegral (z `shiftR` 32)
mix64variant13 :: Word64 -> Word64
mix64variant13 x =
let
y = (x `xor` (x `shiftR` 30)) * (4658895280553007687)
z = (y `xor` (y `shiftR` 27)) * (7723592293110705685)
in
z `xor` (z `shiftR` 31)
mixGamma :: Word64 -> Word64
mixGamma x =
let
y = mix64variant13 x .|. 1
n = popCount $ y `xor` (y `shiftR` 1)
in
if n >= 24 then
y `xor` (6148914691236517206)
else
y
#include "MachDeps.h"
#if (SIZEOF_HSINT == 8)
instance RandomGen Seed where
next =
first fromIntegral . nextWord64
genRange _ =
(fromIntegral (minBound :: Int64), fromIntegral (maxBound :: Int64))
split =
split
#else
instance RandomGen Seed where
next =
first fromIntegral . nextWord32
genRange _ =
(fromIntegral (minBound :: Int32), fromIntegral (maxBound :: Int32))
split =
split
#endif