{-# OPTIONS_HADDOCK hide #-}
-- | A wrapper around the system random number generator. Internal QuickCheck module.
{-# LANGUAGE CPP #-}
#ifndef NO_SAFE_HASKELL
{-# LANGUAGE Trustworthy #-}
#endif
module Test.QuickCheck.Random where

import System.Random
#ifndef NO_SPLITMIX
import System.Random.SplitMix
#endif
import Data.Bits

-- | The "standard" QuickCheck random number generator.
-- A wrapper around either 'SMGen' on GHC, or 'StdGen'
-- on other Haskell systems.
#ifdef NO_SPLITMIX
newtype QCGen = QCGen StdGen
#else
newtype QCGen = QCGen SMGen
#endif

instance Show QCGen where
  showsPrec :: Int -> QCGen -> ShowS
showsPrec n :: Int
n (QCGen g :: SMGen
g) s :: String
s = Int -> SMGen -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
n SMGen
g String
s
instance Read QCGen where
  readsPrec :: Int -> ReadS QCGen
readsPrec n :: Int
n xs :: String
xs = [(SMGen -> QCGen
QCGen SMGen
g, String
ys) | (g :: SMGen
g, ys :: String
ys) <- Int -> ReadS SMGen
forall a. Read a => Int -> ReadS a
readsPrec Int
n String
xs]

instance RandomGen QCGen where
  split :: QCGen -> (QCGen, QCGen)
split (QCGen g :: SMGen
g) =
    case SMGen -> (SMGen, SMGen)
forall g. RandomGen g => g -> (g, g)
split SMGen
g of
      (g1 :: SMGen
g1, g2 :: SMGen
g2) -> (SMGen -> QCGen
QCGen SMGen
g1, SMGen -> QCGen
QCGen SMGen
g2)
  genRange :: QCGen -> (Int, Int)
genRange (QCGen g :: SMGen
g) = SMGen -> (Int, Int)
forall g. RandomGen g => g -> (Int, Int)
genRange SMGen
g
  next :: QCGen -> (Int, QCGen)
next (QCGen g :: SMGen
g) =
    case SMGen -> (Int, SMGen)
forall g. RandomGen g => g -> (Int, g)
next SMGen
g of
      (x :: Int
x, g' :: SMGen
g') -> (Int
x, SMGen -> QCGen
QCGen SMGen
g')

newQCGen :: IO QCGen
#ifdef NO_SPLITMIX
newQCGen = fmap QCGen newStdGen
#else
newQCGen :: IO QCGen
newQCGen = (SMGen -> QCGen) -> IO SMGen -> IO QCGen
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SMGen -> QCGen
QCGen IO SMGen
newSMGen
#endif

mkQCGen :: Int -> QCGen
#ifdef NO_SPLITMIX
mkQCGen n = QCGen (mkStdGen n)
#else
mkQCGen :: Int -> QCGen
mkQCGen n :: Int
n = SMGen -> QCGen
QCGen (Word64 -> SMGen
mkSMGen (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))
#endif

-- Parameterised in order to make this code testable.
class Splittable a where
  left, right :: a -> a

instance Splittable QCGen where
  left :: QCGen -> QCGen
left = (QCGen, QCGen) -> QCGen
forall a b. (a, b) -> a
fst ((QCGen, QCGen) -> QCGen)
-> (QCGen -> (QCGen, QCGen)) -> QCGen -> QCGen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QCGen -> (QCGen, QCGen)
forall g. RandomGen g => g -> (g, g)
split
  right :: QCGen -> QCGen
right = (QCGen, QCGen) -> QCGen
forall a b. (a, b) -> b
snd ((QCGen, QCGen) -> QCGen)
-> (QCGen -> (QCGen, QCGen)) -> QCGen -> QCGen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QCGen -> (QCGen, QCGen)
forall g. RandomGen g => g -> (g, g)
split

-- The logic behind 'variant'. Given a random number seed, and an integer, uses
-- splitting to transform the seed according to the integer. We use a
-- prefix-free code so that calls to integerVariant n g for different values of
-- n are guaranteed to return independent seeds.
{-# INLINE integerVariant #-}
integerVariant :: Splittable a => Integer -> a -> a
integerVariant :: Integer -> a -> a
integerVariant n :: Integer
n g :: a
g
  -- Use one bit to encode the sign, then use Elias gamma coding
  -- (https://en.wikipedia.org/wiki/Elias_gamma_coding) to do the rest.
  -- Actually, the first bit encodes whether n >= 1 or not;
  -- this has the advantage that both 0 and 1 get short codes.
  | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= 1 = Integer -> a -> a
forall c t. (Splittable c, Bits t, Integral t) => t -> c -> c
gamma Integer
n (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$! a -> a
forall a. Splittable a => a -> a
left a
g
  | Bool
otherwise = Integer -> a -> a
forall c t. (Splittable c, Bits t, Integral t) => t -> c -> c
gamma (1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
n) (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$! a -> a
forall a. Splittable a => a -> a
right a
g
  where
    gamma :: t -> c -> c
gamma n :: t
n =
      Int -> c -> c
forall a. Splittable a => Int -> a -> a
encode Int
k (c -> c) -> (c -> c) -> c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> c -> c
forall t a. (Eq t, Num t, Splittable a) => t -> a -> a
zeroes Int
k
      where
        k :: Int
k = t -> Int
forall t p. (Num p, Integral t) => t -> p
ilog2 t
n

        encode :: Int -> a -> a
encode (-1) g :: a
g = a
g
        encode k :: Int
k g :: a
g
          | t -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit t
n Int
k =
            Int -> a -> a
encode (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$! a -> a
forall a. Splittable a => a -> a
right a
g
          | Bool
otherwise =
            Int -> a -> a
encode (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$! a -> a
forall a. Splittable a => a -> a
left a
g

        zeroes :: t -> a -> a
zeroes 0 g :: a
g = a
g
        zeroes k :: t
k g :: a
g = t -> a -> a
zeroes (t
kt -> t -> t
forall a. Num a => a -> a -> a
-1) (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$! a -> a
forall a. Splittable a => a -> a
left a
g

    ilog2 :: t -> p
ilog2 1 = 0
    ilog2 n :: t
n = 1 p -> p -> p
forall a. Num a => a -> a -> a
+ t -> p
ilog2 (t
n t -> t -> t
forall a. Integral a => a -> a -> a
`div` 2)