{-# 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 = 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
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
{-# INLINE integerVariant #-}
integerVariant :: Splittable a => Integer -> a -> a
integerVariant :: forall a. Splittable a => Integer -> a -> a
integerVariant Integer
n a
g
| 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)