{-# 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 = 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) <- 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
_ = (forall a. Bounded a => a
minBound, forall a. Bounded a => a
maxBound)
  next :: QCGen -> (Int, QCGen)
next = forall a. (SMGen -> (a, SMGen)) -> QCGen -> (a, QCGen)
wrapQCGen SMGen -> (Int, SMGen)
nextInt

#ifndef OLD_RANDOM
  genWord8 :: QCGen -> (Word8, QCGen)
genWord8 = forall a. (SMGen -> (a, SMGen)) -> QCGen -> (a, QCGen)
wrapQCGen forall g. RandomGen g => g -> (Word8, g)
genWord8
  genWord16 :: QCGen -> (Word16, QCGen)
genWord16 = forall a. (SMGen -> (a, SMGen)) -> QCGen -> (a, QCGen)
wrapQCGen forall g. RandomGen g => g -> (Word16, g)
genWord16
  genWord32 :: QCGen -> (Word32, QCGen)
genWord32 = forall a. (SMGen -> (a, SMGen)) -> QCGen -> (a, QCGen)
wrapQCGen forall g. RandomGen g => g -> (Word32, g)
genWord32
  genWord64 :: QCGen -> (Word64, QCGen)
genWord64 = forall a. (SMGen -> (a, SMGen)) -> QCGen -> (a, QCGen)
wrapQCGen forall g. RandomGen g => g -> (Word64, g)
genWord64
  genWord32R :: Word32 -> QCGen -> (Word32, QCGen)
genWord32R Word32
r = forall a. (SMGen -> (a, SMGen)) -> QCGen -> (a, QCGen)
wrapQCGen (forall g. RandomGen g => Word32 -> g -> (Word32, g)
genWord32R Word32
r)
  genWord64R :: Word64 -> QCGen -> (Word64, QCGen)
genWord64R Word64
r = forall a. (SMGen -> (a, SMGen)) -> QCGen -> (a, QCGen)
wrapQCGen (forall g. RandomGen g => Word64 -> g -> (Word64, g)
genWord64R Word64
r)
  genShortByteString :: Int -> QCGen -> (ShortByteString, QCGen)
genShortByteString Int
n = forall a. (SMGen -> (a, SMGen)) -> QCGen -> (a, QCGen)
wrapQCGen (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 :: forall a. (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 = 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 (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 = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g. RandomGen g => g -> (g, g)
split
  right :: QCGen -> QCGen
right = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. Splittable a => 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 forall a. Ord a => a -> a -> Bool
>= Integer
1 = forall {c} {p}. (Splittable c, Bits p, Integral p) => p -> c -> c
gamma Integer
n forall a b. (a -> b) -> a -> b
$! forall a. Splittable a => a -> a
left a
g
  | Bool
otherwise = forall {c} {p}. (Splittable c, Bits p, Integral p) => p -> c -> c
gamma (Integer
1forall a. Num a => a -> a -> a
-Integer
n) forall a b. (a -> b) -> a -> b
$! forall a. Splittable a => a -> a
right a
g
  where
    gamma :: p -> c -> c
gamma p
n =
      forall {a}. Splittable a => Int -> a -> a
encode Int
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t} {a}. (Eq t, Num t, Splittable a) => t -> a -> a
zeroes Int
k
      where
        k :: Int
k = forall {t} {a}. (Num a, Integral t) => t -> a
ilog2 p
n

        encode :: Int -> a -> a
encode (-1) a
g = a
g
        encode Int
k a
g
          | forall a. Bits a => a -> Int -> Bool
testBit p
n Int
k =
            Int -> a -> a
encode (Int
kforall a. Num a => a -> a -> a
-Int
1) forall a b. (a -> b) -> a -> b
$! forall a. Splittable a => a -> a
right a
g
          | Bool
otherwise =
            Int -> a -> a
encode (Int
kforall a. Num a => a -> a -> a
-Int
1) forall a b. (a -> b) -> a -> b
$! 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
kforall a. Num a => a -> a -> a
-t
1) forall a b. (a -> b) -> a -> b
$! forall a. Splittable a => a -> a
left a
g

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