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