{-# 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 Int
n (QCGen SMGen
g) 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 Int
n String
xs = [(SMGen -> QCGen
QCGen SMGen
g, String
ys) | (SMGen
g, String
ys) <- Int -> ReadS SMGen
forall a. Read a => Int -> ReadS a
readsPrec Int
n String
xs]

instance RandomGen QCGen where
#ifdef NO_SPLITMIX
  split (QCGen g) =
    case split g of
      (g1, g2) -> (QCGen g1, QCGen g2)
  genRange (QCGen g) = genRange g
  next = wrapQCGen next
#else
  split :: QCGen -> (QCGen, QCGen)
split (QCGen SMGen
g) =
    case SMGen -> (SMGen, SMGen)
splitSMGen SMGen
g of
      (SMGen
g1, SMGen
g2) -> (SMGen -> QCGen
QCGen SMGen
g1, SMGen -> QCGen
QCGen SMGen
g2)
  genRange :: QCGen -> (Int, Int)
genRange QCGen
_ = (Int
forall a. Bounded a => a
minBound, Int
forall a. Bounded a => a
maxBound)
  next :: QCGen -> (Int, QCGen)
next = (SMGen -> (Int, SMGen)) -> QCGen -> (Int, QCGen)
forall a. (SMGen -> (a, SMGen)) -> QCGen -> (a, QCGen)
wrapQCGen SMGen -> (Int, SMGen)
nextInt

#ifndef OLD_RANDOM
  genWord8 :: QCGen -> (Word8, QCGen)
genWord8 = (SMGen -> (Word8, SMGen)) -> QCGen -> (Word8, QCGen)
forall a. (SMGen -> (a, SMGen)) -> QCGen -> (a, QCGen)
wrapQCGen SMGen -> (Word8, SMGen)
forall g. RandomGen g => g -> (Word8, g)
genWord8
  genWord16 :: QCGen -> (Word16, QCGen)
genWord16 = (SMGen -> (Word16, SMGen)) -> QCGen -> (Word16, QCGen)
forall a. (SMGen -> (a, SMGen)) -> QCGen -> (a, QCGen)
wrapQCGen SMGen -> (Word16, SMGen)
forall g. RandomGen g => g -> (Word16, g)
genWord16
  genWord32 :: QCGen -> (Word32, QCGen)
genWord32 = (SMGen -> (Word32, SMGen)) -> QCGen -> (Word32, QCGen)
forall a. (SMGen -> (a, SMGen)) -> QCGen -> (a, QCGen)
wrapQCGen SMGen -> (Word32, SMGen)
forall g. RandomGen g => g -> (Word32, g)
genWord32
  genWord64 :: QCGen -> (Word64, QCGen)
genWord64 = (SMGen -> (Word64, SMGen)) -> QCGen -> (Word64, QCGen)
forall a. (SMGen -> (a, SMGen)) -> QCGen -> (a, QCGen)
wrapQCGen SMGen -> (Word64, SMGen)
forall g. RandomGen g => g -> (Word64, g)
genWord64
  genWord32R :: Word32 -> QCGen -> (Word32, QCGen)
genWord32R Word32
r = (SMGen -> (Word32, SMGen)) -> QCGen -> (Word32, QCGen)
forall a. (SMGen -> (a, SMGen)) -> QCGen -> (a, QCGen)
wrapQCGen (Word32 -> SMGen -> (Word32, SMGen)
forall g. RandomGen g => Word32 -> g -> (Word32, g)
genWord32R Word32
r)
  genWord64R :: Word64 -> QCGen -> (Word64, QCGen)
genWord64R Word64
r = (SMGen -> (Word64, SMGen)) -> QCGen -> (Word64, QCGen)
forall a. (SMGen -> (a, SMGen)) -> QCGen -> (a, QCGen)
wrapQCGen (Word64 -> SMGen -> (Word64, SMGen)
forall g. RandomGen g => Word64 -> g -> (Word64, g)
genWord64R Word64
r)
  genShortByteString :: Int -> QCGen -> (ShortByteString, QCGen)
genShortByteString Int
n = (SMGen -> (ShortByteString, SMGen))
-> QCGen -> (ShortByteString, QCGen)
forall a. (SMGen -> (a, SMGen)) -> QCGen -> (a, QCGen)
wrapQCGen (Int -> SMGen -> (ShortByteString, SMGen)
forall g. RandomGen g => Int -> g -> (ShortByteString, g)
genShortByteString Int
n)
#endif
#endif

{-# INLINE wrapQCGen #-}
#ifdef NO_SPLITMIX
wrapQCGen :: (StdGen -> (a, StdGen)) -> (QCGen -> (a, QCGen))
#else
wrapQCGen :: (SMGen -> (a, SMGen)) -> (QCGen -> (a, QCGen))
#endif
wrapQCGen :: (SMGen -> (a, SMGen)) -> QCGen -> (a, QCGen)
wrapQCGen SMGen -> (a, SMGen)
f (QCGen SMGen
g) =
  case SMGen -> (a, SMGen)
f SMGen
g of
    (a
x, SMGen
g') -> (a
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 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 Integer
n 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
>= Integer
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 (Integer
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 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) a
g = a
g
        encode Int
k 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
-Int
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
-Int
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 t
0 a
g = a
g
        zeroes t
k a
g = t -> a -> a
zeroes (t
kt -> t -> t
forall a. Num a => a -> a -> a
-t
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 t
1 = p
0
    ilog2 t
n = p
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` t
2)