{-# OPTIONS_HADDOCK hide #-}
{-# 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
#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 :: 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 = (SMGen -> QCGen) -> IO SMGen -> IO QCGen
forall a b. (a -> b) -> IO a -> IO b
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
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
{-# INLINE integerVariant #-}
integerVariant :: Splittable a => Integer -> a -> a
integerVariant :: forall a. Splittable a => Integer -> a -> a
integerVariant Integer
n a
g
| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
1 = Integer -> a -> a
forall {c} {p}. (Splittable c, Bits p, Integral p) => p -> 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} {p}. (Splittable c, Bits p, Integral p) => p -> 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 :: p -> c -> c
gamma p
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 = p -> Int
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
| p -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit p
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 -> a
ilog2 t
1 = a
0
ilog2 t
n = a
1 a -> a -> a
forall a. Num a => a -> a -> a
+ t -> a
ilog2 (t
n t -> t -> t
forall a. Integral a => a -> a -> a
`div` t
2)