1{-# OPTIONS_HADDOCK hide #-}
2-- | A wrapper around the system random number generator. Internal QuickCheck module.
3{-# LANGUAGE CPP #-}
4#ifndef NO_SAFE_HASKELL
5{-# LANGUAGE Trustworthy #-}
6#endif
7module Test.QuickCheck.Random where
8
9import System.Random
10#ifndef NO_SPLITMIX
11import System.Random.SplitMix
12#endif
13import Data.Bits
14
15-- | The "standard" QuickCheck random number generator.
16-- A wrapper around either 'SMGen' on GHC, or 'StdGen'
17-- on other Haskell systems.
18#ifdef NO_SPLITMIX
19newtype QCGen = QCGen StdGen
20#else
21newtype QCGen = QCGen SMGen
22#endif
23
24instance Show QCGen where
25  showsPrec n (QCGen g) s = showsPrec n g s
26instance Read QCGen where
27  readsPrec n xs = [(QCGen g, ys) | (g, ys) <- readsPrec n xs]
28
29instance RandomGen QCGen where
30#ifdef NO_SPLITMIX
31  split (QCGen g) =
32    case split g of
33      (g1, g2) -> (QCGen g1, QCGen g2)
34  genRange (QCGen g) = genRange g
35  next = wrapQCGen next
36#else
37  split (QCGen g) =
38    case splitSMGen g of
39      (g1, g2) -> (QCGen g1, QCGen g2)
40  genRange _ = (minBound, maxBound)
41  next = wrapQCGen nextInt
42
43#ifndef OLD_RANDOM
44  genWord8 = wrapQCGen genWord8
45  genWord16 = wrapQCGen genWord16
46  genWord32 = wrapQCGen genWord32
47  genWord64 = wrapQCGen genWord64
48  genWord32R r = wrapQCGen (genWord32R r)
49  genWord64R r = wrapQCGen (genWord64R r)
50  genShortByteString n = wrapQCGen (genShortByteString n)
51#endif
52#endif
53
54{-# INLINE wrapQCGen #-}
55#ifdef NO_SPLITMIX
56wrapQCGen :: (StdGen -> (a, StdGen)) -> (QCGen -> (a, QCGen))
57#else
58wrapQCGen :: (SMGen -> (a, SMGen)) -> (QCGen -> (a, QCGen))
59#endif
60wrapQCGen f (QCGen g) =
61  case f g of
62    (x, g') -> (x, QCGen g')
63
64newQCGen :: IO QCGen
65#ifdef NO_SPLITMIX
66newQCGen = fmap QCGen newStdGen
67#else
68newQCGen = fmap QCGen newSMGen
69#endif
70
71mkQCGen :: Int -> QCGen
72#ifdef NO_SPLITMIX
73mkQCGen n = QCGen (mkStdGen n)
74#else
75mkQCGen n = QCGen (mkSMGen (fromIntegral n))
76#endif
77
78-- Parameterised in order to make this code testable.
79class Splittable a where
80  left, right :: a -> a
81
82instance Splittable QCGen where
83  left = fst . split
84  right = snd . split
85
86-- The logic behind 'variant'. Given a random number seed, and an integer, uses
87-- splitting to transform the seed according to the integer. We use a
88-- prefix-free code so that calls to integerVariant n g for different values of
89-- n are guaranteed to return independent seeds.
90{-# INLINE integerVariant #-}
91integerVariant :: Splittable a => Integer -> a -> a
92integerVariant n g
93  -- Use one bit to encode the sign, then use Elias gamma coding
94  -- (https://en.wikipedia.org/wiki/Elias_gamma_coding) to do the rest.
95  -- Actually, the first bit encodes whether n >= 1 or not;
96  -- this has the advantage that both 0 and 1 get short codes.
97  | n >= 1 = gamma n $! left g
98  | otherwise = gamma (1-n) $! right g
99  where
100    gamma n =
101      encode k . zeroes k
102      where
103        k = ilog2 n
104
105        encode (-1) g = g
106        encode k g
107          | testBit n k =
108            encode (k-1) $! right g
109          | otherwise =
110            encode (k-1) $! left g
111
112        zeroes 0 g = g
113        zeroes k g = zeroes (k-1) $! left g
114
115    ilog2 1 = 0
116    ilog2 n = 1 + ilog2 (n `div` 2)
117