random-1.2.1.1/bench/0000755000000000000000000000000014121726764012411 5ustar0000000000000000random-1.2.1.1/bench-legacy/0000755000000000000000000000000014121726764013653 5ustar0000000000000000random-1.2.1.1/src/0000755000000000000000000000000013674377445012133 5ustar0000000000000000random-1.2.1.1/src/System/0000755000000000000000000000000014235761771013410 5ustar0000000000000000random-1.2.1.1/src/System/Random/0000755000000000000000000000000014235762653014630 5ustar0000000000000000random-1.2.1.1/test/0000755000000000000000000000000014235761771012314 5ustar0000000000000000random-1.2.1.1/test-inspection/0000755000000000000000000000000014121726764014462 5ustar0000000000000000random-1.2.1.1/test-inspection/Spec/0000755000000000000000000000000014121726764015354 5ustar0000000000000000random-1.2.1.1/test-legacy/0000755000000000000000000000000014235763105013547 5ustar0000000000000000random-1.2.1.1/test/Spec/0000755000000000000000000000000014235761771013206 5ustar0000000000000000random-1.2.1.1/src/System/Random.hs0000644000000000000000000006240314235761771015171 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE Trustworthy #-} -- | -- Module : System.Random -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file LICENSE in the 'random' repository) -- Maintainer : libraries@haskell.org -- Stability : stable -- -- This library deals with the common task of pseudo-random number generation. module System.Random ( -- * Introduction -- $introduction -- * Usage -- $usagepure -- * Pure number generator interface -- $interfaces RandomGen(..) , uniform , uniformR , genByteString , Random(..) , Uniform , UniformRange , Finite -- ** Standard pseudo-random number generator , StdGen , mkStdGen , initStdGen -- ** Global standard pseudo-random number generator -- $globalstdgen , getStdRandom , getStdGen , setStdGen , newStdGen , randomIO , randomRIO -- * Compatibility and reproducibility -- ** Backwards compatibility and deprecations -- $deprecations -- ** Reproducibility -- $reproducibility -- * Notes for pseudo-random number generator implementors -- ** How to implement 'RandomGen' -- $implementrandomgen -- * References -- $references ) where import Control.Arrow import Control.Monad.IO.Class import Control.Monad.State.Strict import Data.ByteString (ByteString) import Data.Int import Data.IORef import Data.Word import Foreign.C.Types import GHC.Exts import System.Random.GFinite (Finite) import System.Random.Internal import qualified System.Random.SplitMix as SM -- $introduction -- -- This module provides type classes and instances for the following concepts: -- -- [Pure pseudo-random number generators] 'RandomGen' is an interface to pure -- pseudo-random number generators. -- -- 'StdGen', the standard pseudo-random number generator provided in this -- library, is an instance of 'RandomGen'. It uses the SplitMix -- implementation provided by the -- package. -- Programmers may, of course, supply their own instances of 'RandomGen'. -- -- $usagepure -- -- In pure code, use 'uniform' and 'uniformR' to generate pseudo-random values -- with a pure pseudo-random number generator like 'StdGen'. -- -- >>> :{ -- let rolls :: RandomGen g => Int -> g -> [Word] -- rolls n = take n . unfoldr (Just . uniformR (1, 6)) -- pureGen = mkStdGen 137 -- in -- rolls 10 pureGen :: [Word] -- :} -- [4,2,6,1,6,6,5,1,1,5] -- -- To run use a /monadic/ pseudo-random computation in pure code with a pure -- pseudo-random number generator, use 'runStateGen' and its variants. -- -- >>> :{ -- let rollsM :: StatefulGen g m => Int -> g -> m [Word] -- rollsM n = replicateM n . uniformRM (1, 6) -- pureGen = mkStdGen 137 -- in -- runStateGen_ pureGen (rollsM 10) :: [Word] -- :} -- [4,2,6,1,6,6,5,1,1,5] ------------------------------------------------------------------------------- -- Pseudo-random number generator interfaces ------------------------------------------------------------------------------- -- $interfaces -- -- Pseudo-random number generators come in two flavours: /pure/ and /monadic/. -- -- ['RandomGen': pure pseudo-random number generators] These generators produce -- a new pseudo-random value together with a new instance of the -- pseudo-random number generator. -- -- Pure pseudo-random number generators should implement 'split' if they -- are /splittable/, that is, if there is an efficient method to turn one -- generator into two. The pseudo-random numbers produced by the two -- resulting generators should not be correlated. See [1] for some -- background on splittable pseudo-random generators. -- -- ['System.Random.Stateful.StatefulGen': monadic pseudo-random number generators] -- See "System.Random.Stateful" module -- -- | Generates a value uniformly distributed over all possible values of that -- type. -- -- This is a pure version of 'System.Random.Stateful.uniformM'. -- -- ====__Examples__ -- -- >>> import System.Random -- >>> let pureGen = mkStdGen 137 -- >>> uniform pureGen :: (Bool, StdGen) -- (True,StdGen {unStdGen = SMGen 11285859549637045894 7641485672361121627}) -- -- @since 1.2.0 uniform :: (RandomGen g, Uniform a) => g -> (a, g) uniform g = runStateGen g uniformM {-# INLINE uniform #-} -- | Generates a value uniformly distributed over the provided range, which -- is interpreted as inclusive in the lower and upper bound. -- -- * @uniformR (1 :: Int, 4 :: Int)@ generates values uniformly from the set -- \(\{1,2,3,4\}\) -- -- * @uniformR (1 :: Float, 4 :: Float)@ generates values uniformly from the -- set \(\{x\;|\;1 \le x \le 4\}\) -- -- The following law should hold to make the function always defined: -- -- > uniformR (a, b) = uniformR (b, a) -- -- This is a pure version of 'System.Random.Stateful.uniformRM'. -- -- ====__Examples__ -- -- >>> import System.Random -- >>> let pureGen = mkStdGen 137 -- >>> uniformR (1 :: Int, 4 :: Int) pureGen -- (4,StdGen {unStdGen = SMGen 11285859549637045894 7641485672361121627}) -- -- @since 1.2.0 uniformR :: (RandomGen g, UniformRange a) => (a, a) -> g -> (a, g) uniformR r g = runStateGen g (uniformRM r) {-# INLINE uniformR #-} -- | Generates a 'ByteString' of the specified size using a pure pseudo-random -- number generator. See 'uniformByteStringM' for the monadic version. -- -- ====__Examples__ -- -- >>> import System.Random -- >>> import Data.ByteString -- >>> let pureGen = mkStdGen 137 -- >>> unpack . fst . genByteString 10 $ pureGen -- [51,123,251,37,49,167,90,109,1,4] -- -- @since 1.2.0 genByteString :: RandomGen g => Int -> g -> (ByteString, g) genByteString n g = runStateGenST g (uniformByteStringM n) {-# INLINE genByteString #-} -- | The class of types for which random values can be generated. Most -- instances of `Random` will produce values that are uniformly distributed on the full -- range, but for those types without a well-defined "full range" some sensible default -- subrange will be selected. -- -- 'Random' exists primarily for backwards compatibility with version 1.1 of -- this library. In new code, use the better specified 'Uniform' and -- 'UniformRange' instead. -- -- @since 1.0.0 class Random a where -- | Takes a range /(lo,hi)/ and a pseudo-random number generator -- /g/, and returns a pseudo-random value uniformly distributed over the -- closed interval /[lo,hi]/, together with a new generator. It is unspecified -- what happens if /lo>hi/, but usually the values will simply get swapped. -- -- >>> let gen = mkStdGen 2021 -- >>> fst $ randomR ('a', 'z') gen -- 't' -- >>> fst $ randomR ('z', 'a') gen -- 't' -- -- For continuous types there is no requirement that the values /lo/ and /hi/ are ever -- produced, but they may be, depending on the implementation and the interval. -- -- There is no requirement to follow the @Ord@ instance and the concept of range can be -- defined on per type basis. For example product types will treat their values -- independently: -- -- >>> fst $ randomR (('a', 5.0), ('z', 10.0)) $ mkStdGen 2021 -- ('t',6.240232662366563) -- -- In case when a lawful range is desired `uniformR` should be used -- instead. -- -- @since 1.0.0 {-# INLINE randomR #-} randomR :: RandomGen g => (a, a) -> g -> (a, g) default randomR :: (RandomGen g, UniformRange a) => (a, a) -> g -> (a, g) randomR r g = runStateGen g (uniformRM r) -- | The same as 'randomR', but using a default range determined by the type: -- -- * For bounded types (instances of 'Bounded', such as 'Char'), -- the range is normally the whole type. -- -- * For floating point types, the range is normally the closed interval @[0,1]@. -- -- * For 'Integer', the range is (arbitrarily) the range of 'Int'. -- -- @since 1.0.0 {-# INLINE random #-} random :: RandomGen g => g -> (a, g) default random :: (RandomGen g, Uniform a) => g -> (a, g) random g = runStateGen g uniformM -- | Plural variant of 'randomR', producing an infinite list of -- pseudo-random values instead of returning a new generator. -- -- @since 1.0.0 {-# INLINE randomRs #-} randomRs :: RandomGen g => (a,a) -> g -> [a] randomRs ival g = build (\cons _nil -> buildRandoms cons (randomR ival) g) -- | Plural variant of 'random', producing an infinite list of -- pseudo-random values instead of returning a new generator. -- -- @since 1.0.0 {-# INLINE randoms #-} randoms :: RandomGen g => g -> [a] randoms g = build (\cons _nil -> buildRandoms cons random g) -- | Produce an infinite list-equivalent of pseudo-random values. -- -- ====__Examples__ -- -- >>> import System.Random -- >>> let pureGen = mkStdGen 137 -- >>> (take 4 . buildRandoms (:) random $ pureGen) :: [Int] -- [7879794327570578227,6883935014316540929,-1519291874655152001,2353271688382626589] -- {-# INLINE buildRandoms #-} buildRandoms :: RandomGen g => (a -> as -> as) -- ^ E.g. @(:)@ but subject to fusion -> (g -> (a,g)) -- ^ E.g. 'random' -> g -- ^ A 'RandomGen' instance -> as buildRandoms cons rand = go where -- The seq fixes part of #4218 and also makes fused Core simpler. go g = x `seq` (x `cons` go g') where (x,g') = rand g -- | /Note/ - `random` generates values in the `Int` range instance Random Integer where random = first (toInteger :: Int -> Integer) . random {-# INLINE random #-} instance Random Int8 instance Random Int16 instance Random Int32 instance Random Int64 instance Random Int instance Random Word instance Random Word8 instance Random Word16 instance Random Word32 instance Random Word64 #if __GLASGOW_HASKELL__ >= 802 instance Random CBool #endif instance Random CChar instance Random CSChar instance Random CUChar instance Random CShort instance Random CUShort instance Random CInt instance Random CUInt instance Random CLong instance Random CULong instance Random CPtrdiff instance Random CSize instance Random CWchar instance Random CSigAtomic instance Random CLLong instance Random CULLong instance Random CIntPtr instance Random CUIntPtr instance Random CIntMax instance Random CUIntMax -- | /Note/ - `random` produces values in the closed range @[0,1]@. instance Random CFloat where randomR r = coerce . randomR (coerce r :: (Float, Float)) {-# INLINE randomR #-} random = first CFloat . random {-# INLINE random #-} -- | /Note/ - `random` produces values in the closed range @[0,1]@. instance Random CDouble where randomR r = coerce . randomR (coerce r :: (Double, Double)) {-# INLINE randomR #-} random = first CDouble . random {-# INLINE random #-} instance Random Char instance Random Bool -- | /Note/ - `random` produces values in the closed range @[0,1]@. instance Random Double where randomR r g = runStateGen g (uniformRM r) {-# INLINE randomR #-} -- We return 1 - uniformDouble01M here for backwards compatibility with -- v1.2.0. Just return the result of uniformDouble01M in the next major -- version. random g = runStateGen g (fmap (1 -) . uniformDouble01M) {-# INLINE random #-} -- | /Note/ - `random` produces values in the closed range @[0,1]@. instance Random Float where randomR r g = runStateGen g (uniformRM r) {-# INLINE randomR #-} -- We return 1 - uniformFloat01M here for backwards compatibility with -- v1.2.0. Just return the result of uniformFloat01M in the next major -- version. random g = runStateGen g (fmap (1 -) . uniformFloat01M) {-# INLINE random #-} -- | Initialize 'StdGen' using system entropy (i.e. @\/dev\/urandom@) when it is -- available, while falling back on using system time as the seed. -- -- @since 1.2.1 initStdGen :: MonadIO m => m StdGen initStdGen = liftIO (StdGen <$> SM.initSMGen) -- | /Note/ - `randomR` treats @a@ and @b@ types independently instance (Random a, Random b) => Random (a, b) where randomR ((al, bl), (ah, bh)) = runState $ (,) <$> state (randomR (al, ah)) <*> state (randomR (bl, bh)) {-# INLINE randomR #-} random = runState $ (,) <$> state random <*> state random {-# INLINE random #-} -- | /Note/ - `randomR` treats @a@, @b@ and @c@ types independently instance (Random a, Random b, Random c) => Random (a, b, c) where randomR ((al, bl, cl), (ah, bh, ch)) = runState $ (,,) <$> state (randomR (al, ah)) <*> state (randomR (bl, bh)) <*> state (randomR (cl, ch)) {-# INLINE randomR #-} random = runState $ (,,) <$> state random <*> state random <*> state random {-# INLINE random #-} -- | /Note/ - `randomR` treats @a@, @b@, @c@ and @d@ types independently instance (Random a, Random b, Random c, Random d) => Random (a, b, c, d) where randomR ((al, bl, cl, dl), (ah, bh, ch, dh)) = runState $ (,,,) <$> state (randomR (al, ah)) <*> state (randomR (bl, bh)) <*> state (randomR (cl, ch)) <*> state (randomR (dl, dh)) {-# INLINE randomR #-} random = runState $ (,,,) <$> state random <*> state random <*> state random <*> state random {-# INLINE random #-} -- | /Note/ - `randomR` treats @a@, @b@, @c@, @d@ and @e@ types independently instance (Random a, Random b, Random c, Random d, Random e) => Random (a, b, c, d, e) where randomR ((al, bl, cl, dl, el), (ah, bh, ch, dh, eh)) = runState $ (,,,,) <$> state (randomR (al, ah)) <*> state (randomR (bl, bh)) <*> state (randomR (cl, ch)) <*> state (randomR (dl, dh)) <*> state (randomR (el, eh)) {-# INLINE randomR #-} random = runState $ (,,,,) <$> state random <*> state random <*> state random <*> state random <*> state random {-# INLINE random #-} -- | /Note/ - `randomR` treats @a@, @b@, @c@, @d@, @e@ and @f@ types independently instance (Random a, Random b, Random c, Random d, Random e, Random f) => Random (a, b, c, d, e, f) where randomR ((al, bl, cl, dl, el, fl), (ah, bh, ch, dh, eh, fh)) = runState $ (,,,,,) <$> state (randomR (al, ah)) <*> state (randomR (bl, bh)) <*> state (randomR (cl, ch)) <*> state (randomR (dl, dh)) <*> state (randomR (el, eh)) <*> state (randomR (fl, fh)) {-# INLINE randomR #-} random = runState $ (,,,,,) <$> state random <*> state random <*> state random <*> state random <*> state random <*> state random {-# INLINE random #-} -- | /Note/ - `randomR` treats @a@, @b@, @c@, @d@, @e@, @f@ and @g@ types independently instance (Random a, Random b, Random c, Random d, Random e, Random f, Random g) => Random (a, b, c, d, e, f, g) where randomR ((al, bl, cl, dl, el, fl, gl), (ah, bh, ch, dh, eh, fh, gh)) = runState $ (,,,,,,) <$> state (randomR (al, ah)) <*> state (randomR (bl, bh)) <*> state (randomR (cl, ch)) <*> state (randomR (dl, dh)) <*> state (randomR (el, eh)) <*> state (randomR (fl, fh)) <*> state (randomR (gl, gh)) {-# INLINE randomR #-} random = runState $ (,,,,,,) <$> state random <*> state random <*> state random <*> state random <*> state random <*> state random <*> state random {-# INLINE random #-} ------------------------------------------------------------------------------- -- Global pseudo-random number generator ------------------------------------------------------------------------------- -- $globalstdgen -- -- There is a single, implicit, global pseudo-random number generator of type -- 'StdGen', held in a global mutable variable that can be manipulated from -- within the 'IO' monad. It is also available as -- 'System.Random.Stateful.globalStdGen', therefore it is recommended to use the -- new "System.Random.Stateful" interface to explicitly operate on the global -- pseudo-random number generator. -- -- It is initialised with 'initStdGen', although it is possible to override its -- value with 'setStdGen'. All operations on the global pseudo-random number -- generator are thread safe, however in presence of concurrency they are -- naturally become non-deterministic. Moreover, relying on the global mutable -- state makes it hard to know which of the dependent libraries are using it as -- well, making it unpredictable in the local context. Precisely of this reason, -- the global pseudo-random number generator is only suitable for uses in -- applications, test suites, etc. and is advised against in development of -- reusable libraries. -- -- It is also important to note that either using 'StdGen' with pure functions -- from other sections of this module or by relying on -- 'System.Random.Stateful.runStateGen' from stateful interface does not only -- give us deterministic behaviour without requiring 'IO', but it is also more -- efficient. -- | Sets the global pseudo-random number generator. Overwrites the contents of -- 'System.Random.Stateful.globalStdGen' -- -- @since 1.0.0 setStdGen :: MonadIO m => StdGen -> m () setStdGen = liftIO . writeIORef theStdGen -- | Gets the global pseudo-random number generator. Extracts the contents of -- 'System.Random.Stateful.globalStdGen' -- -- @since 1.0.0 getStdGen :: MonadIO m => m StdGen getStdGen = liftIO $ readIORef theStdGen -- | Applies 'split' to the current global pseudo-random generator -- 'System.Random.Stateful.globalStdGen', updates it with one of the results, -- and returns the other. -- -- @since 1.0.0 newStdGen :: MonadIO m => m StdGen newStdGen = liftIO $ atomicModifyIORef' theStdGen split -- | Uses the supplied function to get a value from the current global -- random generator, and updates the global generator with the new generator -- returned by the function. For example, @rollDice@ produces a pseudo-random integer -- between 1 and 6: -- -- >>> rollDice = getStdRandom (randomR (1, 6)) -- >>> replicateM 10 (rollDice :: IO Int) -- [5,6,6,1,1,6,4,2,4,1] -- -- This is an outdated function and it is recommended to switch to its -- equivalent 'System.Random.Stateful.applyAtomicGen' instead, possibly with the -- 'System.Random.Stateful.globalStdGen' if relying on the global state is -- acceptable. -- -- >>> import System.Random.Stateful -- >>> rollDice = applyAtomicGen (uniformR (1, 6)) globalStdGen -- >>> replicateM 10 (rollDice :: IO Int) -- [4,6,1,1,4,4,3,2,1,2] -- -- @since 1.0.0 getStdRandom :: MonadIO m => (StdGen -> (a, StdGen)) -> m a getStdRandom f = liftIO $ atomicModifyIORef' theStdGen (swap . f) where swap (v, g) = (g, v) -- | A variant of 'System.Random.Stateful.randomRM' that uses the global -- pseudo-random number generator 'System.Random.Stateful.globalStdGen' -- -- >>> randomRIO (2020, 2100) :: IO Int -- 2040 -- -- Similar to 'randomIO', this function is equivalent to @'getStdRandom' -- 'randomR'@ and is included in this interface for historical reasons and -- backwards compatibility. It is recommended to use -- 'System.Random.Stateful.uniformRM' instead, possibly with the -- 'System.Random.Stateful.globalStdGen' if relying on the global state is -- acceptable. -- -- >>> import System.Random.Stateful -- >>> uniformRM (2020, 2100) globalStdGen :: IO Int -- 2079 -- -- @since 1.0.0 randomRIO :: (Random a, MonadIO m) => (a, a) -> m a randomRIO range = getStdRandom (randomR range) -- | A variant of 'System.Random.Stateful.randomM' that uses the global -- pseudo-random number generator 'System.Random.Stateful.globalStdGen'. -- -- >>> import Data.Int -- >>> randomIO :: IO Int32 -- -1580093805 -- -- This function is equivalent to @'getStdRandom' 'random'@ and is included in -- this interface for historical reasons and backwards compatibility. It is -- recommended to use 'System.Random.Stateful.uniformM' instead, possibly with -- the 'System.Random.Stateful.globalStdGen' if relying on the global state is -- acceptable. -- -- >>> import System.Random.Stateful -- >>> uniformM globalStdGen :: IO Int32 -- -1649127057 -- -- @since 1.0.0 randomIO :: (Random a, MonadIO m) => m a randomIO = getStdRandom random ------------------------------------------------------------------------------- -- Notes ------------------------------------------------------------------------------- -- $implementrandomgen -- -- Consider these points when writing a 'RandomGen' instance for a given pure -- pseudo-random number generator: -- -- * If the pseudo-random number generator has a power-of-2 modulus, that is, -- it natively outputs @2^n@ bits of randomness for some @n@, implement -- 'genWord8', 'genWord16', 'genWord32' and 'genWord64'. See below for more -- details. -- -- * If the pseudo-random number generator does not have a power-of-2 -- modulus, implement 'next' and 'genRange'. See below for more details. -- -- * If the pseudo-random number generator is splittable, implement 'split'. -- If there is no suitable implementation, 'split' should fail with a -- helpful error message. -- -- === How to implement 'RandomGen' for a pseudo-random number generator with power-of-2 modulus -- -- Suppose you want to implement a [permuted congruential -- generator](https://en.wikipedia.org/wiki/Permuted_congruential_generator). -- -- >>> data PCGen = PCGen !Word64 !Word64 -- -- It produces a full 'Word32' of randomness per iteration. -- -- >>> import Data.Bits -- >>> :{ -- let stepGen :: PCGen -> (Word32, PCGen) -- stepGen (PCGen state inc) = let -- newState = state * 6364136223846793005 + (inc .|. 1) -- xorShifted = fromIntegral (((state `shiftR` 18) `xor` state) `shiftR` 27) :: Word32 -- rot = fromIntegral (state `shiftR` 59) :: Word32 -- out = (xorShifted `shiftR` (fromIntegral rot)) .|. (xorShifted `shiftL` fromIntegral ((-rot) .&. 31)) -- in (out, PCGen newState inc) -- :} -- -- >>> fst $ stepGen $ snd $ stepGen (PCGen 17 29) -- 3288430965 -- -- You can make it an instance of 'RandomGen' as follows: -- -- >>> :{ -- instance RandomGen PCGen where -- genWord32 = stepGen -- split _ = error "PCG is not splittable" -- :} -- -- -- === How to implement 'RandomGen' for a pseudo-random number generator without a power-of-2 modulus -- -- __We do not recommend you implement any new pseudo-random number generators without a power-of-2 modulus.__ -- -- Pseudo-random number generators without a power-of-2 modulus perform -- /significantly worse/ than pseudo-random number generators with a power-of-2 -- modulus with this library. This is because most functionality in this -- library is based on generating and transforming uniformly pseudo-random -- machine words, and generating uniformly pseudo-random machine words using a -- pseudo-random number generator without a power-of-2 modulus is expensive. -- -- The pseudo-random number generator from -- natively -- generates an integer value in the range @[1, 2147483562]@. This is the -- generator used by this library before it was replaced by SplitMix in version -- 1.2. -- -- >>> data LegacyGen = LegacyGen !Int32 !Int32 -- >>> :{ -- let legacyNext :: LegacyGen -> (Int, LegacyGen) -- legacyNext (LegacyGen s1 s2) = (fromIntegral z', LegacyGen s1'' s2'') where -- z' = if z < 1 then z + 2147483562 else z -- z = s1'' - s2'' -- k = s1 `quot` 53668 -- s1' = 40014 * (s1 - k * 53668) - k * 12211 -- s1'' = if s1' < 0 then s1' + 2147483563 else s1' -- k' = s2 `quot` 52774 -- s2' = 40692 * (s2 - k' * 52774) - k' * 3791 -- s2'' = if s2' < 0 then s2' + 2147483399 else s2' -- :} -- -- You can make it an instance of 'RandomGen' as follows: -- -- >>> :{ -- instance RandomGen LegacyGen where -- next = legacyNext -- genRange _ = (1, 2147483562) -- split _ = error "Not implemented" -- :} -- -- $deprecations -- -- Version 1.2 mostly maintains backwards compatibility with version 1.1. This -- has a few consequences users should be aware of: -- -- * The type class 'Random' is only provided for backwards compatibility. -- New code should use 'Uniform' and 'UniformRange' instead. -- -- * The methods 'next' and 'genRange' in 'RandomGen' are deprecated and only -- provided for backwards compatibility. New instances of 'RandomGen' should -- implement word-based methods instead. See below for more information -- about how to write a 'RandomGen' instance. -- -- * This library provides instances for 'Random' for some unbounded types -- for backwards compatibility. For an unbounded type, there is no way -- to generate a value with uniform probability out of its entire domain, so -- the 'random' implementation for unbounded types actually generates a -- value based on some fixed range. -- -- For 'Integer', 'random' generates a value in the 'Int' range. For 'Float' -- and 'Double', 'random' generates a floating point value in the range @[0, -- 1)@. -- -- This library does not provide 'Uniform' instances for any unbounded -- types. -- -- $reproducibility -- -- If you have two builds of a particular piece of code against this library, -- any deterministic function call should give the same result in the two -- builds if the builds are -- -- * compiled against the same major version of this library -- * on the same architecture (32-bit or 64-bit) -- -- $references -- -- 1. Guy L. Steele, Jr., Doug Lea, and Christine H. Flood. 2014. Fast -- splittable pseudorandom number generators. In Proceedings of the 2014 ACM -- International Conference on Object Oriented Programming Systems Languages & -- Applications (OOPSLA '14). ACM, New York, NY, USA, 453-472. DOI: -- -- $setup -- -- >>> import Control.Monad (replicateM) -- >>> import Data.List (unfoldr) random-1.2.1.1/src/System/Random/Internal.hs0000644000000000000000000013741214235761771016750 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE GHCForeignImportPrim #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UnliftedFFITypes #-} #if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE TypeFamilyDependencies #-} #else {-# LANGUAGE TypeFamilies #-} #endif {-# OPTIONS_HADDOCK hide, not-home #-} -- | -- Module : System.Random.Internal -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file LICENSE in the 'random' repository) -- Maintainer : libraries@haskell.org -- Stability : stable -- -- This library deals with the common task of pseudo-random number generation. module System.Random.Internal (-- * Pure and monadic pseudo-random number generator interfaces RandomGen(..) , StatefulGen(..) , FrozenGen(..) -- ** Standard pseudo-random number generator , StdGen(..) , mkStdGen , theStdGen -- * Monadic adapters for pure pseudo-random number generators -- ** Pure adapter , StateGen(..) , StateGenM(..) , splitGen , runStateGen , runStateGen_ , runStateGenT , runStateGenT_ , runStateGenST , runStateGenST_ -- * Pseudo-random values of various types , Uniform(..) , uniformViaFiniteM , UniformRange(..) , uniformByteStringM , uniformDouble01M , uniformDoublePositive01M , uniformFloat01M , uniformFloatPositive01M , uniformEnumM , uniformEnumRM -- * Generators for sequences of pseudo-random bytes , genShortByteStringIO , genShortByteStringST ) where import Control.Arrow import Control.DeepSeq (NFData) import Control.Monad (when) import Control.Monad.Cont (ContT, runContT) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.ST import Control.Monad.ST.Unsafe import Control.Monad.State.Strict (MonadState(..), State, StateT(..), runState) import Control.Monad.Trans (lift) import Data.Bits import Data.ByteString.Short.Internal (ShortByteString(SBS), fromShort) import Data.IORef (IORef, newIORef) import Data.Int import Data.Word import Foreign.C.Types import Foreign.Storable (Storable) import GHC.Exts import GHC.Generics import GHC.IO (IO(..)) import GHC.Word import Numeric.Natural (Natural) import System.IO.Unsafe (unsafePerformIO) import System.Random.GFinite (Cardinality(..), GFinite(..)) import qualified System.Random.SplitMix as SM import qualified System.Random.SplitMix32 as SM32 #if __GLASGOW_HASKELL__ >= 800 import Data.Kind #endif #if __GLASGOW_HASKELL__ >= 802 import Data.ByteString.Internal (ByteString(PS)) import GHC.ForeignPtr #else import Data.ByteString (ByteString) #endif -- Needed for WORDS_BIGENDIAN #include "MachDeps.h" -- | 'RandomGen' is an interface to pure pseudo-random number generators. -- -- 'StdGen' is the standard 'RandomGen' instance provided by this library. -- -- @since 1.0.0 {-# DEPRECATED next "No longer used" #-} {-# DEPRECATED genRange "No longer used" #-} class RandomGen g where {-# MINIMAL split,(genWord32|genWord64|(next,genRange)) #-} -- | Returns an 'Int' that is uniformly distributed over the range returned by -- 'genRange' (including both end points), and a new generator. Using 'next' -- is inefficient as all operations go via 'Integer'. See -- [here](https://alexey.kuleshevi.ch/blog/2019/12/21/random-benchmarks) for -- more details. It is thus deprecated. -- -- @since 1.0.0 next :: g -> (Int, g) next g = runStateGen g (uniformRM (genRange g)) -- | Returns a 'Word8' that is uniformly distributed over the entire 'Word8' -- range. -- -- @since 1.2.0 genWord8 :: g -> (Word8, g) genWord8 = first fromIntegral . genWord32 {-# INLINE genWord8 #-} -- | Returns a 'Word16' that is uniformly distributed over the entire 'Word16' -- range. -- -- @since 1.2.0 genWord16 :: g -> (Word16, g) genWord16 = first fromIntegral . genWord32 {-# INLINE genWord16 #-} -- | Returns a 'Word32' that is uniformly distributed over the entire 'Word32' -- range. -- -- @since 1.2.0 genWord32 :: g -> (Word32, g) genWord32 = randomIvalIntegral (minBound, maxBound) -- Once `next` is removed, this implementation should be used instead: -- first fromIntegral . genWord64 {-# INLINE genWord32 #-} -- | Returns a 'Word64' that is uniformly distributed over the entire 'Word64' -- range. -- -- @since 1.2.0 genWord64 :: g -> (Word64, g) genWord64 g = case genWord32 g of (l32, g') -> case genWord32 g' of (h32, g'') -> ((fromIntegral h32 `shiftL` 32) .|. fromIntegral l32, g'') {-# INLINE genWord64 #-} -- | @genWord32R upperBound g@ returns a 'Word32' that is uniformly -- distributed over the range @[0, upperBound]@. -- -- @since 1.2.0 genWord32R :: Word32 -> g -> (Word32, g) genWord32R m g = runStateGen g (unbiasedWordMult32 m) {-# INLINE genWord32R #-} -- | @genWord64R upperBound g@ returns a 'Word64' that is uniformly -- distributed over the range @[0, upperBound]@. -- -- @since 1.2.0 genWord64R :: Word64 -> g -> (Word64, g) genWord64R m g = runStateGen g (unsignedBitmaskWithRejectionM uniformWord64 m) {-# INLINE genWord64R #-} -- | @genShortByteString n g@ returns a 'ShortByteString' of length @n@ -- filled with pseudo-random bytes. -- -- @since 1.2.0 genShortByteString :: Int -> g -> (ShortByteString, g) genShortByteString n g = unsafePerformIO $ runStateGenT g (genShortByteStringIO n . uniformWord64) {-# INLINE genShortByteString #-} -- | Yields the range of values returned by 'next'. -- -- It is required that: -- -- * If @(a, b) = 'genRange' g@, then @a < b@. -- * 'genRange' must not examine its argument so the value it returns is -- determined only by the instance of 'RandomGen'. -- -- The default definition spans the full range of 'Int'. -- -- @since 1.0.0 genRange :: g -> (Int, Int) genRange _ = (minBound, maxBound) -- | Returns two distinct pseudo-random number generators. -- -- Implementations should take care to ensure that the resulting generators -- are not correlated. Some pseudo-random number generators are not -- splittable. In that case, the 'split' implementation should fail with a -- descriptive 'error' message. -- -- @since 1.0.0 split :: g -> (g, g) -- | 'StatefulGen' is an interface to monadic pseudo-random number generators. -- -- @since 1.2.0 class Monad m => StatefulGen g m where {-# MINIMAL (uniformWord32|uniformWord64) #-} -- | @uniformWord32R upperBound g@ generates a 'Word32' that is uniformly -- distributed over the range @[0, upperBound]@. -- -- @since 1.2.0 uniformWord32R :: Word32 -> g -> m Word32 uniformWord32R = unsignedBitmaskWithRejectionM uniformWord32 {-# INLINE uniformWord32R #-} -- | @uniformWord64R upperBound g@ generates a 'Word64' that is uniformly -- distributed over the range @[0, upperBound]@. -- -- @since 1.2.0 uniformWord64R :: Word64 -> g -> m Word64 uniformWord64R = unsignedBitmaskWithRejectionM uniformWord64 {-# INLINE uniformWord64R #-} -- | Generates a 'Word8' that is uniformly distributed over the entire 'Word8' -- range. -- -- The default implementation extracts a 'Word8' from 'uniformWord32'. -- -- @since 1.2.0 uniformWord8 :: g -> m Word8 uniformWord8 = fmap fromIntegral . uniformWord32 {-# INLINE uniformWord8 #-} -- | Generates a 'Word16' that is uniformly distributed over the entire -- 'Word16' range. -- -- The default implementation extracts a 'Word16' from 'uniformWord32'. -- -- @since 1.2.0 uniformWord16 :: g -> m Word16 uniformWord16 = fmap fromIntegral . uniformWord32 {-# INLINE uniformWord16 #-} -- | Generates a 'Word32' that is uniformly distributed over the entire -- 'Word32' range. -- -- The default implementation extracts a 'Word32' from 'uniformWord64'. -- -- @since 1.2.0 uniformWord32 :: g -> m Word32 uniformWord32 = fmap fromIntegral . uniformWord64 {-# INLINE uniformWord32 #-} -- | Generates a 'Word64' that is uniformly distributed over the entire -- 'Word64' range. -- -- The default implementation combines two 'Word32' from 'uniformWord32' into -- one 'Word64'. -- -- @since 1.2.0 uniformWord64 :: g -> m Word64 uniformWord64 g = do l32 <- uniformWord32 g h32 <- uniformWord32 g pure (shiftL (fromIntegral h32) 32 .|. fromIntegral l32) {-# INLINE uniformWord64 #-} -- | @uniformShortByteString n g@ generates a 'ShortByteString' of length @n@ -- filled with pseudo-random bytes. -- -- @since 1.2.0 uniformShortByteString :: Int -> g -> m ShortByteString default uniformShortByteString :: MonadIO m => Int -> g -> m ShortByteString uniformShortByteString n = genShortByteStringIO n . uniformWord64 {-# INLINE uniformShortByteString #-} -- | This class is designed for stateful pseudo-random number generators that -- can be saved as and restored from an immutable data type. -- -- @since 1.2.0 class StatefulGen (MutableGen f m) m => FrozenGen f m where -- | Represents the state of the pseudo-random number generator for use with -- 'thawGen' and 'freezeGen'. -- -- @since 1.2.0 #if __GLASGOW_HASKELL__ >= 800 type MutableGen f m = (g :: Type) | g -> f #else type MutableGen f m :: * #endif -- | Saves the state of the pseudo-random number generator as a frozen seed. -- -- @since 1.2.0 freezeGen :: MutableGen f m -> m f -- | Restores the pseudo-random number generator from its frozen seed. -- -- @since 1.2.0 thawGen :: f -> m (MutableGen f m) data MBA = MBA (MutableByteArray# RealWorld) -- | Efficiently generates a sequence of pseudo-random bytes in a platform -- independent manner. -- -- @since 1.2.0 genShortByteStringIO :: MonadIO m => Int -- ^ Number of bytes to generate -> m Word64 -- ^ IO action that can generate 8 random bytes at a time -> m ShortByteString genShortByteStringIO n0 gen64 = do let !n@(I# n#) = max 0 n0 !n64 = n `quot` 8 !nrem = n `rem` 8 mba@(MBA mba#) <- liftIO $ IO $ \s# -> case newByteArray# n# s# of (# s'#, mba# #) -> (# s'#, MBA mba# #) let go i = when (i < n64) $ do w64 <- gen64 -- Writing 8 bytes at a time in a Little-endian order gives us -- platform portability liftIO $ writeWord64LE mba i w64 go (i + 1) go 0 when (nrem > 0) $ do w64 <- gen64 -- In order to not mess up the byte order we write 1 byte at a time in -- Little endian order. It is tempting to simply generate as many bytes as we -- still need using smaller generators (eg. uniformWord8), but that would -- result in inconsistent tail when total length is slightly varied. liftIO $ writeByteSliceWord64LE mba (n - nrem) n w64 liftIO $ IO $ \s# -> case unsafeFreezeByteArray# mba# s# of (# s'#, ba# #) -> (# s'#, SBS ba# #) {-# INLINE genShortByteStringIO #-} -- Architecture independent helpers: io_ :: (State# RealWorld -> State# RealWorld) -> IO () io_ m# = IO $ \s# -> (# m# s#, () #) {-# INLINE io_ #-} writeWord8 :: MBA -> Int -> Word8 -> IO () writeWord8 (MBA mba#) (I# i#) (W8# w#) = io_ (writeWord8Array# mba# i# w#) {-# INLINE writeWord8 #-} writeByteSliceWord64LE :: MBA -> Int -> Int -> Word64 -> IO () writeByteSliceWord64LE mba fromByteIx toByteIx = go fromByteIx where go !i !z = when (i < toByteIx) $ do writeWord8 mba i (fromIntegral z :: Word8) go (i + 1) (z `shiftR` 8) {-# INLINE writeByteSliceWord64LE #-} writeWord64LE :: MBA -> Int -> Word64 -> IO () #ifdef WORDS_BIGENDIAN writeWord64LE mba i w64 = do let !i8 = i * 8 writeByteSliceWord64LE mba i8 (i8 + 8) w64 #else writeWord64LE (MBA mba#) (I# i#) w64@(W64# w64#) | wordSizeInBits == 64 = io_ (writeWord64Array# mba# i# w64#) | otherwise = do let !i32# = i# *# 2# !(W32# w32l#) = fromIntegral w64 !(W32# w32u#) = fromIntegral (w64 `shiftR` 32) io_ (writeWord32Array# mba# i32# w32l#) io_ (writeWord32Array# mba# (i32# +# 1#) w32u#) #endif {-# INLINE writeWord64LE #-} -- | Same as 'genShortByteStringIO', but runs in 'ST'. -- -- @since 1.2.0 genShortByteStringST :: Int -> ST s Word64 -> ST s ShortByteString genShortByteStringST n action = unsafeIOToST (genShortByteStringIO n (unsafeSTToIO action)) {-# INLINE genShortByteStringST #-} -- | Generates a pseudo-random 'ByteString' of the specified size. -- -- @since 1.2.0 uniformByteStringM :: StatefulGen g m => Int -> g -> m ByteString uniformByteStringM n g = do ba <- uniformShortByteString n g pure $ #if __GLASGOW_HASKELL__ < 802 fromShort ba #else let !(SBS ba#) = ba in if isTrue# (isByteArrayPinned# ba#) then pinnedByteArrayToByteString ba# else fromShort ba {-# INLINE uniformByteStringM #-} pinnedByteArrayToByteString :: ByteArray# -> ByteString pinnedByteArrayToByteString ba# = PS (pinnedByteArrayToForeignPtr ba#) 0 (I# (sizeofByteArray# ba#)) {-# INLINE pinnedByteArrayToByteString #-} pinnedByteArrayToForeignPtr :: ByteArray# -> ForeignPtr a pinnedByteArrayToForeignPtr ba# = ForeignPtr (byteArrayContents# ba#) (PlainPtr (unsafeCoerce# ba#)) {-# INLINE pinnedByteArrayToForeignPtr #-} #endif -- | Opaque data type that carries the type of a pure pseudo-random number -- generator. -- -- @since 1.2.0 data StateGenM g = StateGenM -- | Wrapper for pure state gen, which acts as an immutable seed for the corresponding -- stateful generator `StateGenM` -- -- @since 1.2.0 newtype StateGen g = StateGen { unStateGen :: g } deriving (Eq, Ord, Show, RandomGen, Storable, NFData) instance (RandomGen g, MonadState g m) => StatefulGen (StateGenM g) m where uniformWord32R r _ = state (genWord32R r) {-# INLINE uniformWord32R #-} uniformWord64R r _ = state (genWord64R r) {-# INLINE uniformWord64R #-} uniformWord8 _ = state genWord8 {-# INLINE uniformWord8 #-} uniformWord16 _ = state genWord16 {-# INLINE uniformWord16 #-} uniformWord32 _ = state genWord32 {-# INLINE uniformWord32 #-} uniformWord64 _ = state genWord64 {-# INLINE uniformWord64 #-} uniformShortByteString n _ = state (genShortByteString n) {-# INLINE uniformShortByteString #-} instance (RandomGen g, MonadState g m) => FrozenGen (StateGen g) m where type MutableGen (StateGen g) m = StateGenM g freezeGen _ = fmap StateGen get thawGen (StateGen g) = StateGenM <$ put g -- | Splits a pseudo-random number generator into two. Updates the state with -- one of the resulting generators and returns the other. -- -- @since 1.2.0 splitGen :: (MonadState g m, RandomGen g) => m g splitGen = state split {-# INLINE splitGen #-} -- | Runs a monadic generating action in the `State` monad using a pure -- pseudo-random number generator. -- -- ====__Examples__ -- -- >>> import System.Random.Stateful -- >>> let pureGen = mkStdGen 137 -- >>> runStateGen pureGen randomM :: (Int, StdGen) -- (7879794327570578227,StdGen {unStdGen = SMGen 11285859549637045894 7641485672361121627}) -- -- @since 1.2.0 runStateGen :: RandomGen g => g -> (StateGenM g -> State g a) -> (a, g) runStateGen g f = runState (f StateGenM) g {-# INLINE runStateGen #-} -- | Runs a monadic generating action in the `State` monad using a pure -- pseudo-random number generator. Returns only the resulting pseudo-random -- value. -- -- ====__Examples__ -- -- >>> import System.Random.Stateful -- >>> let pureGen = mkStdGen 137 -- >>> runStateGen_ pureGen randomM :: Int -- 7879794327570578227 -- -- @since 1.2.0 runStateGen_ :: RandomGen g => g -> (StateGenM g -> State g a) -> a runStateGen_ g = fst . runStateGen g {-# INLINE runStateGen_ #-} -- | Runs a monadic generating action in the `StateT` monad using a pure -- pseudo-random number generator. -- -- ====__Examples__ -- -- >>> import System.Random.Stateful -- >>> let pureGen = mkStdGen 137 -- >>> runStateGenT pureGen randomM :: IO (Int, StdGen) -- (7879794327570578227,StdGen {unStdGen = SMGen 11285859549637045894 7641485672361121627}) -- -- @since 1.2.0 runStateGenT :: RandomGen g => g -> (StateGenM g -> StateT g m a) -> m (a, g) runStateGenT g f = runStateT (f StateGenM) g {-# INLINE runStateGenT #-} -- | Runs a monadic generating action in the `StateT` monad using a pure -- pseudo-random number generator. Returns only the resulting pseudo-random -- value. -- -- ====__Examples__ -- -- >>> import System.Random.Stateful -- >>> let pureGen = mkStdGen 137 -- >>> runStateGenT_ pureGen randomM :: IO Int -- 7879794327570578227 -- -- @since 1.2.1 runStateGenT_ :: (RandomGen g, Functor f) => g -> (StateGenM g -> StateT g f a) -> f a runStateGenT_ g = fmap fst . runStateGenT g {-# INLINE runStateGenT_ #-} -- | Runs a monadic generating action in the `ST` monad using a pure -- pseudo-random number generator. -- -- @since 1.2.0 runStateGenST :: RandomGen g => g -> (forall s . StateGenM g -> StateT g (ST s) a) -> (a, g) runStateGenST g action = runST $ runStateGenT g action {-# INLINE runStateGenST #-} -- | Runs a monadic generating action in the `ST` monad using a pure -- pseudo-random number generator. Same as `runStateGenST`, but discards the -- resulting generator. -- -- @since 1.2.1 runStateGenST_ :: RandomGen g => g -> (forall s . StateGenM g -> StateT g (ST s) a) -> a runStateGenST_ g action = runST $ runStateGenT_ g action {-# INLINE runStateGenST_ #-} -- | The standard pseudo-random number generator. newtype StdGen = StdGen { unStdGen :: SM.SMGen } deriving (Show, RandomGen, NFData) instance Eq StdGen where StdGen x1 == StdGen x2 = SM.unseedSMGen x1 == SM.unseedSMGen x2 instance RandomGen SM.SMGen where next = SM.nextInt {-# INLINE next #-} genWord32 = SM.nextWord32 {-# INLINE genWord32 #-} genWord64 = SM.nextWord64 {-# INLINE genWord64 #-} split = SM.splitSMGen {-# INLINE split #-} instance RandomGen SM32.SMGen where next = SM32.nextInt {-# INLINE next #-} genWord32 = SM32.nextWord32 {-# INLINE genWord32 #-} genWord64 = SM32.nextWord64 {-# INLINE genWord64 #-} split = SM32.splitSMGen {-# INLINE split #-} -- | Constructs a 'StdGen' deterministically. mkStdGen :: Int -> StdGen mkStdGen = StdGen . SM.mkSMGen . fromIntegral -- | Global mutable veriable with `StdGen` theStdGen :: IORef StdGen theStdGen = unsafePerformIO $ SM.initSMGen >>= newIORef . StdGen {-# NOINLINE theStdGen #-} -- | The class of types for which a uniformly distributed value can be drawn -- from all possible values of the type. -- -- @since 1.2.0 class Uniform a where -- | Generates a value uniformly distributed over all possible values of that -- type. -- -- There is a default implementation via 'Generic': -- -- >>> :set -XDeriveGeneric -XDeriveAnyClass -- >>> import GHC.Generics (Generic) -- >>> import System.Random.Stateful -- >>> data MyBool = MyTrue | MyFalse deriving (Show, Generic, Finite, Uniform) -- >>> data Action = Code MyBool | Eat (Maybe Bool) | Sleep deriving (Show, Generic, Finite, Uniform) -- >>> gen <- newIOGenM (mkStdGen 42) -- >>> uniformListM 10 gen :: IO [Action] -- [Code MyTrue,Code MyTrue,Eat Nothing,Code MyFalse,Eat (Just False),Eat (Just True),Eat Nothing,Eat (Just False),Sleep,Code MyFalse] -- -- @since 1.2.0 uniformM :: StatefulGen g m => g -> m a default uniformM :: (StatefulGen g m, Generic a, GUniform (Rep a)) => g -> m a uniformM = fmap to . (`runContT` pure) . guniformM {-# INLINE uniformM #-} -- | Default implementation of 'Uniform' type class for 'Generic' data. -- It's important to use 'ContT', because without it 'fmap' and '>>=' remain -- polymorphic too long and GHC fails to inline or specialize it, ending up -- building full 'Rep' a structure in memory. 'ContT' -- makes 'fmap' and '>>=' used in 'guniformM' monomorphic, so GHC is able to -- specialize 'Generic' instance reasonably close to a handwritten one. class GUniform f where guniformM :: StatefulGen g m => g -> ContT r m (f a) instance GUniform f => GUniform (M1 i c f) where guniformM = fmap M1 . guniformM {-# INLINE guniformM #-} instance Uniform a => GUniform (K1 i a) where guniformM = fmap K1 . lift . uniformM {-# INLINE guniformM #-} instance GUniform U1 where guniformM = const $ return U1 {-# INLINE guniformM #-} instance (GUniform f, GUniform g) => GUniform (f :*: g) where guniformM g = (:*:) <$> guniformM g <*> guniformM g {-# INLINE guniformM #-} instance (GFinite f, GFinite g) => GUniform (f :+: g) where guniformM = lift . finiteUniformM {-# INLINE guniformM #-} finiteUniformM :: forall g m f a. (StatefulGen g m, GFinite f) => g -> m (f a) finiteUniformM = fmap toGFinite . case gcardinality (proxy# :: Proxy# f) of Shift n | n <= 64 -> fmap toInteger . unsignedBitmaskWithRejectionM uniformWord64 (bit n - 1) | otherwise -> boundedByPowerOf2ExclusiveIntegralM n Card n | n <= bit 64 -> fmap toInteger . unsignedBitmaskWithRejectionM uniformWord64 (fromInteger n - 1) | otherwise -> boundedExclusiveIntegralM n {-# INLINE finiteUniformM #-} -- | A definition of 'Uniform' for 'System.Random.Finite' types. -- If your data has several fields of sub-'Word' cardinality, -- this instance may be more efficient than one, derived via 'Generic' and 'GUniform'. -- -- >>> :set -XDeriveGeneric -XDeriveAnyClass -- >>> import GHC.Generics (Generic) -- >>> import System.Random.Stateful -- >>> data Triple = Triple Word8 Word8 Word8 deriving (Show, Generic, Finite) -- >>> instance Uniform Triple where uniformM = uniformViaFiniteM -- >>> gen <- newIOGenM (mkStdGen 42) -- >>> uniformListM 5 gen :: IO [Triple] -- [Triple 60 226 48,Triple 234 194 151,Triple 112 96 95,Triple 51 251 15,Triple 6 0 208] -- uniformViaFiniteM :: (StatefulGen g m, Generic a, GFinite (Rep a)) => g -> m a uniformViaFiniteM = fmap to . finiteUniformM {-# INLINE uniformViaFiniteM #-} -- | The class of types for which a uniformly distributed value can be drawn -- from a range. -- -- @since 1.2.0 class UniformRange a where -- | Generates a value uniformly distributed over the provided range, which -- is interpreted as inclusive in the lower and upper bound. -- -- * @uniformRM (1 :: Int, 4 :: Int)@ generates values uniformly from the -- set \(\{1,2,3,4\}\) -- -- * @uniformRM (1 :: Float, 4 :: Float)@ generates values uniformly from -- the set \(\{x\;|\;1 \le x \le 4\}\) -- -- The following law should hold to make the function always defined: -- -- > uniformRM (a, b) = uniformRM (b, a) -- -- @since 1.2.0 uniformRM :: StatefulGen g m => (a, a) -> g -> m a instance UniformRange Integer where uniformRM = uniformIntegralM {-# INLINE uniformRM #-} instance UniformRange Natural where uniformRM = uniformIntegralM {-# INLINE uniformRM #-} instance Uniform Int8 where uniformM = fmap (fromIntegral :: Word8 -> Int8) . uniformWord8 {-# INLINE uniformM #-} instance UniformRange Int8 where uniformRM = signedBitmaskWithRejectionRM (fromIntegral :: Int8 -> Word8) fromIntegral {-# INLINE uniformRM #-} instance Uniform Int16 where uniformM = fmap (fromIntegral :: Word16 -> Int16) . uniformWord16 {-# INLINE uniformM #-} instance UniformRange Int16 where uniformRM = signedBitmaskWithRejectionRM (fromIntegral :: Int16 -> Word16) fromIntegral {-# INLINE uniformRM #-} instance Uniform Int32 where uniformM = fmap (fromIntegral :: Word32 -> Int32) . uniformWord32 {-# INLINE uniformM #-} instance UniformRange Int32 where uniformRM = signedBitmaskWithRejectionRM (fromIntegral :: Int32 -> Word32) fromIntegral {-# INLINE uniformRM #-} instance Uniform Int64 where uniformM = fmap (fromIntegral :: Word64 -> Int64) . uniformWord64 {-# INLINE uniformM #-} instance UniformRange Int64 where uniformRM = signedBitmaskWithRejectionRM (fromIntegral :: Int64 -> Word64) fromIntegral {-# INLINE uniformRM #-} wordSizeInBits :: Int wordSizeInBits = finiteBitSize (0 :: Word) instance Uniform Int where uniformM | wordSizeInBits == 64 = fmap (fromIntegral :: Word64 -> Int) . uniformWord64 | otherwise = fmap (fromIntegral :: Word32 -> Int) . uniformWord32 {-# INLINE uniformM #-} instance UniformRange Int where uniformRM = signedBitmaskWithRejectionRM (fromIntegral :: Int -> Word) fromIntegral {-# INLINE uniformRM #-} instance Uniform Word where uniformM | wordSizeInBits == 64 = fmap (fromIntegral :: Word64 -> Word) . uniformWord64 | otherwise = fmap (fromIntegral :: Word32 -> Word) . uniformWord32 {-# INLINE uniformM #-} instance UniformRange Word where uniformRM = unsignedBitmaskWithRejectionRM {-# INLINE uniformRM #-} instance Uniform Word8 where uniformM = uniformWord8 {-# INLINE uniformM #-} instance UniformRange Word8 where uniformRM = unbiasedWordMult32RM {-# INLINE uniformRM #-} instance Uniform Word16 where uniformM = uniformWord16 {-# INLINE uniformM #-} instance UniformRange Word16 where uniformRM = unbiasedWordMult32RM {-# INLINE uniformRM #-} instance Uniform Word32 where uniformM = uniformWord32 {-# INLINE uniformM #-} instance UniformRange Word32 where uniformRM = unbiasedWordMult32RM {-# INLINE uniformRM #-} instance Uniform Word64 where uniformM = uniformWord64 {-# INLINE uniformM #-} instance UniformRange Word64 where uniformRM = unsignedBitmaskWithRejectionRM {-# INLINE uniformRM #-} #if __GLASGOW_HASKELL__ >= 802 instance Uniform CBool where uniformM = fmap CBool . uniformM {-# INLINE uniformM #-} instance UniformRange CBool where uniformRM (CBool b, CBool t) = fmap CBool . uniformRM (b, t) {-# INLINE uniformRM #-} #endif instance Uniform CChar where uniformM = fmap CChar . uniformM {-# INLINE uniformM #-} instance UniformRange CChar where uniformRM (CChar b, CChar t) = fmap CChar . uniformRM (b, t) {-# INLINE uniformRM #-} instance Uniform CSChar where uniformM = fmap CSChar . uniformM {-# INLINE uniformM #-} instance UniformRange CSChar where uniformRM (CSChar b, CSChar t) = fmap CSChar . uniformRM (b, t) {-# INLINE uniformRM #-} instance Uniform CUChar where uniformM = fmap CUChar . uniformM {-# INLINE uniformM #-} instance UniformRange CUChar where uniformRM (CUChar b, CUChar t) = fmap CUChar . uniformRM (b, t) {-# INLINE uniformRM #-} instance Uniform CShort where uniformM = fmap CShort . uniformM {-# INLINE uniformM #-} instance UniformRange CShort where uniformRM (CShort b, CShort t) = fmap CShort . uniformRM (b, t) {-# INLINE uniformRM #-} instance Uniform CUShort where uniformM = fmap CUShort . uniformM {-# INLINE uniformM #-} instance UniformRange CUShort where uniformRM (CUShort b, CUShort t) = fmap CUShort . uniformRM (b, t) {-# INLINE uniformRM #-} instance Uniform CInt where uniformM = fmap CInt . uniformM {-# INLINE uniformM #-} instance UniformRange CInt where uniformRM (CInt b, CInt t) = fmap CInt . uniformRM (b, t) {-# INLINE uniformRM #-} instance Uniform CUInt where uniformM = fmap CUInt . uniformM {-# INLINE uniformM #-} instance UniformRange CUInt where uniformRM (CUInt b, CUInt t) = fmap CUInt . uniformRM (b, t) {-# INLINE uniformRM #-} instance Uniform CLong where uniformM = fmap CLong . uniformM {-# INLINE uniformM #-} instance UniformRange CLong where uniformRM (CLong b, CLong t) = fmap CLong . uniformRM (b, t) {-# INLINE uniformRM #-} instance Uniform CULong where uniformM = fmap CULong . uniformM {-# INLINE uniformM #-} instance UniformRange CULong where uniformRM (CULong b, CULong t) = fmap CULong . uniformRM (b, t) {-# INLINE uniformRM #-} instance Uniform CPtrdiff where uniformM = fmap CPtrdiff . uniformM {-# INLINE uniformM #-} instance UniformRange CPtrdiff where uniformRM (CPtrdiff b, CPtrdiff t) = fmap CPtrdiff . uniformRM (b, t) {-# INLINE uniformRM #-} instance Uniform CSize where uniformM = fmap CSize . uniformM {-# INLINE uniformM #-} instance UniformRange CSize where uniformRM (CSize b, CSize t) = fmap CSize . uniformRM (b, t) {-# INLINE uniformRM #-} instance Uniform CWchar where uniformM = fmap CWchar . uniformM {-# INLINE uniformM #-} instance UniformRange CWchar where uniformRM (CWchar b, CWchar t) = fmap CWchar . uniformRM (b, t) {-# INLINE uniformRM #-} instance Uniform CSigAtomic where uniformM = fmap CSigAtomic . uniformM {-# INLINE uniformM #-} instance UniformRange CSigAtomic where uniformRM (CSigAtomic b, CSigAtomic t) = fmap CSigAtomic . uniformRM (b, t) {-# INLINE uniformRM #-} instance Uniform CLLong where uniformM = fmap CLLong . uniformM {-# INLINE uniformM #-} instance UniformRange CLLong where uniformRM (CLLong b, CLLong t) = fmap CLLong . uniformRM (b, t) {-# INLINE uniformRM #-} instance Uniform CULLong where uniformM = fmap CULLong . uniformM {-# INLINE uniformM #-} instance UniformRange CULLong where uniformRM (CULLong b, CULLong t) = fmap CULLong . uniformRM (b, t) {-# INLINE uniformRM #-} instance Uniform CIntPtr where uniformM = fmap CIntPtr . uniformM {-# INLINE uniformM #-} instance UniformRange CIntPtr where uniformRM (CIntPtr b, CIntPtr t) = fmap CIntPtr . uniformRM (b, t) {-# INLINE uniformRM #-} instance Uniform CUIntPtr where uniformM = fmap CUIntPtr . uniformM {-# INLINE uniformM #-} instance UniformRange CUIntPtr where uniformRM (CUIntPtr b, CUIntPtr t) = fmap CUIntPtr . uniformRM (b, t) {-# INLINE uniformRM #-} instance Uniform CIntMax where uniformM = fmap CIntMax . uniformM {-# INLINE uniformM #-} instance UniformRange CIntMax where uniformRM (CIntMax b, CIntMax t) = fmap CIntMax . uniformRM (b, t) {-# INLINE uniformRM #-} instance Uniform CUIntMax where uniformM = fmap CUIntMax . uniformM {-# INLINE uniformM #-} instance UniformRange CUIntMax where uniformRM (CUIntMax b, CUIntMax t) = fmap CUIntMax . uniformRM (b, t) {-# INLINE uniformRM #-} -- | See [Floating point number caveats](System-Random-Stateful.html#fpcaveats). instance UniformRange CFloat where uniformRM (CFloat l, CFloat h) = fmap CFloat . uniformRM (l, h) {-# INLINE uniformRM #-} -- | See [Floating point number caveats](System-Random-Stateful.html#fpcaveats). instance UniformRange CDouble where uniformRM (CDouble l, CDouble h) = fmap CDouble . uniformRM (l, h) {-# INLINE uniformRM #-} -- The `chr#` and `ord#` are the prim functions that will be called, regardless of which -- way you gonna do the `Char` conversion, so it is better to call them directly and -- bypass all the hoops. Also because `intToChar` and `charToInt` are internal functions -- and are called on valid character ranges it is impossible to generate an invalid -- `Char`, therefore it is totally fine to omit all the unnecessary checks involved in -- other paths of conversion. word32ToChar :: Word32 -> Char #if __GLASGOW_HASKELL__ < 902 word32ToChar (W32# w#) = C# (chr# (word2Int# w#)) #else word32ToChar (W32# w#) = C# (chr# (word2Int# (word32ToWord# w#))) #endif {-# INLINE word32ToChar #-} charToWord32 :: Char -> Word32 #if __GLASGOW_HASKELL__ < 902 charToWord32 (C# c#) = W32# (int2Word# (ord# c#)) #else charToWord32 (C# c#) = W32# (wordToWord32# (int2Word# (ord# c#))) #endif {-# INLINE charToWord32 #-} instance Uniform Char where uniformM g = word32ToChar <$> unbiasedWordMult32 (charToWord32 maxBound) g {-# INLINE uniformM #-} instance UniformRange Char where uniformRM (l, h) g = word32ToChar <$> unbiasedWordMult32RM (charToWord32 l, charToWord32 h) g {-# INLINE uniformRM #-} instance Uniform () where uniformM = const $ pure () {-# INLINE uniformM #-} instance UniformRange () where uniformRM = const $ const $ pure () {-# INLINE uniformRM #-} instance Uniform Bool where uniformM = fmap wordToBool . uniformWord8 where wordToBool w = (w .&. 1) /= 0 {-# INLINE wordToBool #-} {-# INLINE uniformM #-} instance UniformRange Bool where uniformRM (False, False) _g = return False uniformRM (True, True) _g = return True uniformRM _ g = uniformM g {-# INLINE uniformRM #-} -- | See [Floating point number caveats](System-Random-Stateful.html#fpcaveats). instance UniformRange Double where uniformRM (l, h) g | l == h = return l | isInfinite l || isInfinite h = -- Optimisation exploiting absorption: -- (-Infinity) + (anything but +Infinity) = -Infinity -- (anything but -Infinity) + (+Infinity) = +Infinity -- (-Infinity) + (+Infinity) = NaN return $! h + l | otherwise = do x <- uniformDouble01M g return $ x * l + (1 -x) * h {-# INLINE uniformRM #-} -- | Generates uniformly distributed 'Double' in the range \([0, 1]\). -- Numbers are generated by generating uniform 'Word64' and dividing -- it by \(2^{64}\). It's used to implement 'UniformRange' instance for -- 'Double'. -- -- @since 1.2.0 uniformDouble01M :: forall g m. StatefulGen g m => g -> m Double uniformDouble01M g = do w64 <- uniformWord64 g return $ fromIntegral w64 / m where m = fromIntegral (maxBound :: Word64) :: Double {-# INLINE uniformDouble01M #-} -- | Generates uniformly distributed 'Double' in the range -- \((0, 1]\). Number is generated as \(2^{-64}/2+\operatorname{uniformDouble01M}\). -- Constant is 1\/2 of smallest nonzero value which could be generated -- by 'uniformDouble01M'. -- -- @since 1.2.0 uniformDoublePositive01M :: forall g m. StatefulGen g m => g -> m Double uniformDoublePositive01M g = (+ d) <$> uniformDouble01M g where -- We add small constant to shift generated value from zero. It's -- selected as 1/2 of smallest possible nonzero value d = 2.710505431213761e-20 -- 2**(-65) {-# INLINE uniformDoublePositive01M #-} -- | See [Floating point number caveats](System-Random-Stateful.html#fpcaveats). instance UniformRange Float where uniformRM (l, h) g | l == h = return l | isInfinite l || isInfinite h = -- Optimisation exploiting absorption: -- (-Infinity) + (anything but +Infinity) = -Infinity -- (anything but -Infinity) + (+Infinity) = +Infinity -- (-Infinity) + (+Infinity) = NaN return $! h + l | otherwise = do x <- uniformFloat01M g return $ x * l + (1 - x) * h {-# INLINE uniformRM #-} -- | Generates uniformly distributed 'Float' in the range \([0, 1]\). -- Numbers are generated by generating uniform 'Word32' and dividing -- it by \(2^{32}\). It's used to implement 'UniformRange' instance for 'Float'. -- -- @since 1.2.0 uniformFloat01M :: forall g m. StatefulGen g m => g -> m Float uniformFloat01M g = do w32 <- uniformWord32 g return $ fromIntegral w32 / m where m = fromIntegral (maxBound :: Word32) :: Float {-# INLINE uniformFloat01M #-} -- | Generates uniformly distributed 'Float' in the range -- \((0, 1]\). Number is generated as \(2^{-32}/2+\operatorname{uniformFloat01M}\). -- Constant is 1\/2 of smallest nonzero value which could be generated -- by 'uniformFloat01M'. -- -- @since 1.2.0 uniformFloatPositive01M :: forall g m. StatefulGen g m => g -> m Float uniformFloatPositive01M g = (+ d) <$> uniformFloat01M g where -- See uniformDoublePositive01M d = 1.1641532182693481e-10 -- 2**(-33) {-# INLINE uniformFloatPositive01M #-} -- | Generates uniformly distributed 'Enum'. -- One can use it to define a 'Uniform' instance: -- -- > data Colors = Red | Green | Blue deriving (Enum, Bounded) -- > instance Uniform Colors where uniformM = uniformEnumM -- -- @since 1.2.1 uniformEnumM :: forall a g m. (Enum a, Bounded a, StatefulGen g m) => g -> m a uniformEnumM g = toEnum <$> uniformRM (fromEnum (minBound :: a), fromEnum (maxBound :: a)) g {-# INLINE uniformEnumM #-} -- | Generates uniformly distributed 'Enum' in the given range. -- One can use it to define a 'UniformRange' instance: -- -- > data Colors = Red | Green | Blue deriving (Enum) -- > instance UniformRange Colors where -- > uniformRM = uniformEnumRM -- > inInRange (lo, hi) x = isInRange (fromEnum lo, fromEnum hi) (fromEnum x) -- -- @since 1.2.1 uniformEnumRM :: forall a g m. (Enum a, StatefulGen g m) => (a, a) -> g -> m a uniformEnumRM (l, h) g = toEnum <$> uniformRM (fromEnum l, fromEnum h) g {-# INLINE uniformEnumRM #-} -- The two integer functions below take an [inclusive,inclusive] range. randomIvalIntegral :: (RandomGen g, Integral a) => (a, a) -> g -> (a, g) randomIvalIntegral (l, h) = randomIvalInteger (toInteger l, toInteger h) {-# SPECIALIZE randomIvalInteger :: (Num a) => (Integer, Integer) -> StdGen -> (a, StdGen) #-} randomIvalInteger :: (RandomGen g, Num a) => (Integer, Integer) -> g -> (a, g) randomIvalInteger (l, h) rng | l > h = randomIvalInteger (h,l) rng | otherwise = case f 1 0 rng of (v, rng') -> (fromInteger (l + v `mod` k), rng') where (genlo, genhi) = genRange rng b = fromIntegral genhi - fromIntegral genlo + 1 :: Integer -- Probabilities of the most likely and least likely result -- will differ at most by a factor of (1 +- 1/q). Assuming the RandomGen -- is uniform, of course -- On average, log q / log b more pseudo-random values will be generated -- than the minimum q = 1000 :: Integer k = h - l + 1 magtgt = k * q -- generate pseudo-random values until we exceed the target magnitude f mag v g | mag >= magtgt = (v, g) | otherwise = v' `seq`f (mag*b) v' g' where (x,g') = next g v' = v * b + (fromIntegral x - fromIntegral genlo) -- | Generate an integral in the range @[l, h]@ if @l <= h@ and @[h, l]@ -- otherwise. uniformIntegralM :: forall a g m. (Bits a, Integral a, StatefulGen g m) => (a, a) -> g -> m a uniformIntegralM (l, h) gen = case l `compare` h of LT -> do let limit = h - l bounded <- case toIntegralSized limit :: Maybe Word64 of Just limitAsWord64 -> -- Optimisation: if 'limit' fits into 'Word64', generate a bounded -- 'Word64' and then convert to 'Integer' fromIntegral <$> unsignedBitmaskWithRejectionM uniformWord64 limitAsWord64 gen Nothing -> boundedExclusiveIntegralM (limit + 1) gen return $ l + bounded GT -> uniformIntegralM (h, l) gen EQ -> pure l {-# INLINEABLE uniformIntegralM #-} {-# SPECIALIZE uniformIntegralM :: StatefulGen g m => (Integer, Integer) -> g -> m Integer #-} {-# SPECIALIZE uniformIntegralM :: StatefulGen g m => (Natural, Natural) -> g -> m Natural #-} -- | Generate an integral in the range @[0, s)@ using a variant of Lemire's -- multiplication method. -- -- Daniel Lemire. 2019. Fast Random Integer Generation in an Interval. In ACM -- Transactions on Modeling and Computer Simulation -- https://doi.org/10.1145/3230636 -- -- PRECONDITION (unchecked): s > 0 boundedExclusiveIntegralM :: forall a g m . (Bits a, Integral a, StatefulGen g m) => a -> g -> m a boundedExclusiveIntegralM s gen = go where n = integralWordSize s -- We renamed 'L' from the paper to 'k' here because 'L' is not a valid -- variable name in Haskell and 'l' is already used in the algorithm. k = wordSizeInBits * n twoToK = (1 :: a) `shiftL` k modTwoToKMask = twoToK - 1 t = (twoToK - s) `rem` s -- `rem`, instead of `mod` because `twoToK >= s` is guaranteed go :: (Bits a, Integral a, StatefulGen g m) => m a go = do x <- uniformIntegralWords n gen let m = x * s -- m .&. modTwoToKMask == m `mod` twoToK let l = m .&. modTwoToKMask if l < t then go -- m `shiftR` k == m `quot` twoToK else return $ m `shiftR` k {-# INLINE boundedExclusiveIntegralM #-} -- | boundedByPowerOf2ExclusiveIntegralM s ~ boundedExclusiveIntegralM (bit s) boundedByPowerOf2ExclusiveIntegralM :: forall a g m. (Bits a, Integral a, StatefulGen g m) => Int -> g -> m a boundedByPowerOf2ExclusiveIntegralM s gen = do let n = (s + wordSizeInBits - 1) `quot` wordSizeInBits x <- uniformIntegralWords n gen return $ x .&. (bit s - 1) {-# INLINE boundedByPowerOf2ExclusiveIntegralM #-} -- | @integralWordSize i@ returns that least @w@ such that -- @i <= WORD_SIZE_IN_BITS^w@. integralWordSize :: (Bits a, Num a) => a -> Int integralWordSize = go 0 where go !acc i | i == 0 = acc | otherwise = go (acc + 1) (i `shiftR` wordSizeInBits) {-# INLINE integralWordSize #-} -- | @uniformIntegralWords n@ is a uniformly pseudo-random integral in the range -- @[0, WORD_SIZE_IN_BITS^n)@. uniformIntegralWords :: forall a g m. (Bits a, Integral a, StatefulGen g m) => Int -> g -> m a uniformIntegralWords n gen = go 0 n where go !acc i | i == 0 = return acc | otherwise = do (w :: Word) <- uniformM gen go ((acc `shiftL` wordSizeInBits) .|. fromIntegral w) (i - 1) {-# INLINE uniformIntegralWords #-} -- | Uniformly generate an 'Integral' in an inclusive-inclusive range. -- -- Only use for integrals size less than or equal to that of 'Word32'. unbiasedWordMult32RM :: forall a g m. (Integral a, StatefulGen g m) => (a, a) -> g -> m a unbiasedWordMult32RM (b, t) g | b <= t = (+b) . fromIntegral <$> unbiasedWordMult32 (fromIntegral (t - b)) g | otherwise = (+t) . fromIntegral <$> unbiasedWordMult32 (fromIntegral (b - t)) g {-# INLINE unbiasedWordMult32RM #-} -- | Uniformly generate Word32 in @[0, s]@. unbiasedWordMult32 :: forall g m. StatefulGen g m => Word32 -> g -> m Word32 unbiasedWordMult32 s g | s == maxBound = uniformWord32 g | otherwise = unbiasedWordMult32Exclusive (s+1) g {-# INLINE unbiasedWordMult32 #-} -- | See [Lemire's paper](https://arxiv.org/pdf/1805.10941.pdf), -- [O\'Neill's -- blogpost](https://www.pcg-random.org/posts/bounded-rands.html) and -- more directly [O\'Neill's github -- repo](https://github.com/imneme/bounded-rands/blob/3d71f53c975b1e5b29f2f3b05a74e26dab9c3d84/bounded32.cpp#L234). -- N.B. The range is [0,r) **not** [0,r]. unbiasedWordMult32Exclusive :: forall g m . StatefulGen g m => Word32 -> g -> m Word32 unbiasedWordMult32Exclusive r g = go where t :: Word32 t = (-r) `mod` r -- Calculates 2^32 `mod` r!!! go :: StatefulGen g m => m Word32 go = do x <- uniformWord32 g let m :: Word64 m = fromIntegral x * fromIntegral r l :: Word32 l = fromIntegral m if l >= t then return (fromIntegral $ m `shiftR` 32) else go {-# INLINE unbiasedWordMult32Exclusive #-} -- | This only works for unsigned integrals unsignedBitmaskWithRejectionRM :: forall a g m . (FiniteBits a, Num a, Ord a, Uniform a, StatefulGen g m) => (a, a) -> g -> m a unsignedBitmaskWithRejectionRM (bottom, top) gen | bottom == top = pure top | otherwise = (b +) <$> unsignedBitmaskWithRejectionM uniformM r gen where (b, r) = if bottom > top then (top, bottom - top) else (bottom, top - bottom) {-# INLINE unsignedBitmaskWithRejectionRM #-} -- | This works for signed integrals by explicit conversion to unsigned and abusing -- overflow. It uses `unsignedBitmaskWithRejectionM`, therefore it requires functions that -- take the value to unsigned and back. signedBitmaskWithRejectionRM :: forall a b g m. (Num a, Num b, Ord b, Ord a, FiniteBits a, StatefulGen g m, Uniform a) => (b -> a) -- ^ Convert signed to unsigned. @a@ and @b@ must be of the same size. -> (a -> b) -- ^ Convert unsigned to signed. @a@ and @b@ must be of the same size. -> (b, b) -- ^ Range. -> g -- ^ Generator. -> m b signedBitmaskWithRejectionRM toUnsigned fromUnsigned (bottom, top) gen | bottom == top = pure top | otherwise = (b +) . fromUnsigned <$> unsignedBitmaskWithRejectionM uniformM r gen -- This works in all cases, see Appendix 1 at the end of the file. where (b, r) = if bottom > top then (top, toUnsigned bottom - toUnsigned top) else (bottom, toUnsigned top - toUnsigned bottom) {-# INLINE signedBitmaskWithRejectionRM #-} -- | Detailed explanation about the algorithm employed here can be found in this post: -- http://web.archive.org/web/20200520071940/https://www.pcg-random.org/posts/bounded-rands.html unsignedBitmaskWithRejectionM :: forall a g m. (Ord a, FiniteBits a, Num a, StatefulGen g m) => (g -> m a) -> a -> g -> m a unsignedBitmaskWithRejectionM genUniformM range gen = go where mask :: a mask = complement zeroBits `shiftR` countLeadingZeros (range .|. 1) go = do x <- genUniformM gen let x' = x .&. mask if x' > range then go else pure x' {-# INLINE unsignedBitmaskWithRejectionM #-} ------------------------------------------------------------------------------- -- 'Uniform' instances for tuples ------------------------------------------------------------------------------- instance (Uniform a, Uniform b) => Uniform (a, b) where uniformM g = (,) <$> uniformM g <*> uniformM g {-# INLINE uniformM #-} instance (Uniform a, Uniform b, Uniform c) => Uniform (a, b, c) where uniformM g = (,,) <$> uniformM g <*> uniformM g <*> uniformM g {-# INLINE uniformM #-} instance (Uniform a, Uniform b, Uniform c, Uniform d) => Uniform (a, b, c, d) where uniformM g = (,,,) <$> uniformM g <*> uniformM g <*> uniformM g <*> uniformM g {-# INLINE uniformM #-} instance (Uniform a, Uniform b, Uniform c, Uniform d, Uniform e) => Uniform (a, b, c, d, e) where uniformM g = (,,,,) <$> uniformM g <*> uniformM g <*> uniformM g <*> uniformM g <*> uniformM g {-# INLINE uniformM #-} instance (Uniform a, Uniform b, Uniform c, Uniform d, Uniform e, Uniform f) => Uniform (a, b, c, d, e, f) where uniformM g = (,,,,,) <$> uniformM g <*> uniformM g <*> uniformM g <*> uniformM g <*> uniformM g <*> uniformM g {-# INLINE uniformM #-} instance (Uniform a, Uniform b, Uniform c, Uniform d, Uniform e, Uniform f, Uniform g) => Uniform (a, b, c, d, e, f, g) where uniformM g = (,,,,,,) <$> uniformM g <*> uniformM g <*> uniformM g <*> uniformM g <*> uniformM g <*> uniformM g <*> uniformM g {-# INLINE uniformM #-} -- Appendix 1. -- -- @top@ and @bottom@ are signed integers of bit width @n@. @toUnsigned@ -- converts a signed integer to an unsigned number of the same bit width @n@. -- -- range = toUnsigned top - toUnsigned bottom -- -- This works out correctly thanks to modular arithmetic. Conceptually, -- -- toUnsigned x | x >= 0 = x -- toUnsigned x | x < 0 = 2^n + x -- -- The following combinations are possible: -- -- 1. @bottom >= 0@ and @top >= 0@ -- 2. @bottom < 0@ and @top >= 0@ -- 3. @bottom < 0@ and @top < 0@ -- -- Note that @bottom >= 0@ and @top < 0@ is impossible because of the -- invariant @bottom < top@. -- -- For any signed integer @i@ of width @n@, we have: -- -- -2^(n-1) <= i <= 2^(n-1) - 1 -- -- Considering each combination in turn, we have -- -- 1. @bottom >= 0@ and @top >= 0@ -- -- range = (toUnsigned top - toUnsigned bottom) `mod` 2^n -- --^ top >= 0, so toUnsigned top == top -- --^ bottom >= 0, so toUnsigned bottom == bottom -- = (top - bottom) `mod` 2^n -- --^ top <= 2^(n-1) - 1 and bottom >= 0 -- --^ top - bottom <= 2^(n-1) - 1 -- --^ 0 < top - bottom <= 2^(n-1) - 1 -- = top - bottom -- -- 2. @bottom < 0@ and @top >= 0@ -- -- range = (toUnsigned top - toUnsigned bottom) `mod` 2^n -- --^ top >= 0, so toUnsigned top == top -- --^ bottom < 0, so toUnsigned bottom == 2^n + bottom -- = (top - (2^n + bottom)) `mod` 2^n -- --^ summand -2^n cancels out in calculation modulo 2^n -- = (top - bottom) `mod` 2^n -- --^ top <= 2^(n-1) - 1 and bottom >= -2^(n-1) -- --^ top - bottom <= (2^(n-1) - 1) - (-2^(n-1)) = 2^n - 1 -- --^ 0 < top - bottom <= 2^n - 1 -- = top - bottom -- -- 3. @bottom < 0@ and @top < 0@ -- -- range = (toUnsigned top - toUnsigned bottom) `mod` 2^n -- --^ top < 0, so toUnsigned top == 2^n + top -- --^ bottom < 0, so toUnsigned bottom == 2^n + bottom -- = ((2^n + top) - (2^n + bottom)) `mod` 2^n -- --^ summand 2^n cancels out in calculation modulo 2^n -- = (top - bottom) `mod` 2^n -- --^ top <= -1 -- --^ bottom >= -2^(n-1) -- --^ top - bottom <= -1 - (-2^(n-1)) = 2^(n-1) - 1 -- --^ 0 < top - bottom <= 2^(n-1) - 1 -- = top - bottom random-1.2.1.1/src/System/Random/Stateful.hs0000644000000000000000000006537014235762653016766 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -- | -- Module : System.Random.Stateful -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file LICENSE in the 'random' repository) -- Maintainer : libraries@haskell.org -- Stability : stable -- -- This library deals with the common task of pseudo-random number generation. module System.Random.Stateful ( -- * Pure Random Generator module System.Random -- * Monadic Random Generator -- $introduction -- * Usage -- $usagemonadic -- * Mutable pseudo-random number generator interfaces -- $interfaces , StatefulGen(..) , FrozenGen(..) , RandomGenM(..) , withMutableGen , withMutableGen_ , randomM , randomRM , splitGenM -- * Monadic adapters for pure pseudo-random number generators #monadicadapters# -- $monadicadapters -- ** Pure adapter , StateGen(..) , StateGenM(..) , runStateGen , runStateGen_ , runStateGenT , runStateGenT_ , runStateGenST , runStateGenST_ -- ** Mutable adapter with atomic operations , AtomicGen(..) , AtomicGenM(..) , newAtomicGenM , applyAtomicGen , globalStdGen -- ** Mutable adapter in 'IO' , IOGen(..) , IOGenM(..) , newIOGenM , applyIOGen -- ** Mutable adapter in 'ST' , STGen(..) , STGenM(..) , newSTGenM , applySTGen , runSTGen , runSTGen_ -- ** Mutable adapter in 'STM' , TGen(..) , TGenM(..) , newTGenM , newTGenMIO , applyTGen -- * Pseudo-random values of various types -- $uniform , Uniform(..) , uniformListM , uniformViaFiniteM , UniformRange(..) -- * Generators for sequences of pseudo-random bytes , genShortByteStringIO , genShortByteStringST , uniformByteStringM , uniformDouble01M , uniformDoublePositive01M , uniformFloat01M , uniformFloatPositive01M , uniformEnumM , uniformEnumRM -- * Appendix -- ** How to implement 'StatefulGen' -- $implementmonadrandom -- ** Floating point number caveats #fpcaveats# -- $floating -- * References -- $references ) where import Control.DeepSeq import Control.Monad (replicateM) import Control.Monad.IO.Class import Control.Monad.ST import GHC.Conc.Sync (STM, TVar, newTVar, newTVarIO, readTVar, writeTVar) import Control.Monad.State.Strict (MonadState, state) import Data.IORef import Data.STRef import Foreign.Storable import System.Random import System.Random.Internal -- $introduction -- -- This module provides type classes and instances for the following concepts: -- -- [Monadic pseudo-random number generators] 'StatefulGen' is an interface to -- monadic pseudo-random number generators. -- -- [Monadic adapters] 'StateGenM', 'AtomicGenM', 'IOGenM', 'STGenM` and 'TGenM' -- turn a 'RandomGen' instance into a 'StatefulGen' instance. -- -- [Drawing from a range] 'UniformRange' is used to generate a value of a -- type uniformly within a range. -- -- This library provides instances of 'UniformRange' for many common -- numeric types. -- -- [Drawing from the entire domain of a type] 'Uniform' is used to generate a -- value of a type uniformly over all possible values of that type. -- -- This library provides instances of 'Uniform' for many common bounded -- numeric types. -- -- $usagemonadic -- -- In monadic code, use the relevant 'Uniform' and 'UniformRange' instances to -- generate pseudo-random values via 'uniformM' and 'uniformRM', respectively. -- -- As an example, @rollsM@ generates @n@ pseudo-random values of @Word@ in the -- range @[1, 6]@ in a 'StatefulGen' context; given a /monadic/ pseudo-random -- number generator, you can run this probabilistic computation as follows: -- -- >>> :{ -- let rollsM :: StatefulGen g m => Int -> g -> m [Word] -- rollsM n = replicateM n . uniformRM (1, 6) -- in do -- monadicGen <- MWC.create -- rollsM 10 monadicGen :: IO [Word] -- :} -- [3,4,3,1,4,6,1,6,1,4] -- -- Given a /pure/ pseudo-random number generator, you can run the monadic -- pseudo-random number computation @rollsM@ in an 'IO' or 'ST' context by -- applying a monadic adapter like 'AtomicGenM', 'IOGenM' or 'STGenM' -- (see [monadic-adapters](#monadicadapters)) to the pure pseudo-random number -- generator. -- -- >>> :{ -- let rollsM :: StatefulGen g m => Int -> g -> m [Word] -- rollsM n = replicateM n . uniformRM (1, 6) -- pureGen = mkStdGen 42 -- in -- newIOGenM pureGen >>= rollsM 10 :: IO [Word] -- :} -- [1,1,3,2,4,5,3,4,6,2] ------------------------------------------------------------------------------- -- Pseudo-random number generator interfaces ------------------------------------------------------------------------------- -- $interfaces -- -- Pseudo-random number generators come in two flavours: /pure/ and /monadic/. -- -- ['System.Random.RandomGen': pure pseudo-random number generators] -- See "System.Random" module. -- -- ['StatefulGen': monadic pseudo-random number generators] These generators -- mutate their own state as they produce pseudo-random values. They -- generally live in 'ST' or 'IO' or some transformer that implements -- @PrimMonad@. -- ------------------------------------------------------------------------------- -- Monadic adapters ------------------------------------------------------------------------------- -- $monadicadapters -- -- Pure pseudo-random number generators can be used in monadic code via the -- adapters 'StateGenM', 'AtomicGenM', 'IOGenM', 'STGenM' and 'TGenM' -- -- * 'StateGenM' can be used in any state monad. With strict 'StateT' there is -- no performance overhead compared to using the 'RandomGen' instance -- directly. 'StateGenM' is /not/ safe to use in the presence of exceptions -- and concurrency. -- -- * 'AtomicGenM' is safe in the presence of exceptions and concurrency since -- it performs all actions atomically. -- -- * 'IOGenM' is a wrapper around an 'IORef' that holds a pure generator. -- 'IOGenM' is safe in the presence of exceptions, but not concurrency. -- -- * 'STGenM' is a wrapper around an 'STRef' that holds a pure generator. -- 'STGenM' is safe in the presence of exceptions, but not concurrency. -- -- * 'TGenM' is a wrapper around a 'TVar' that holds a pure generator. 'TGenM' -- can be used in a software transactional memory monad 'STM`. It is not as -- performant as 'AtomicGenM`, but it can provide stronger guarantees in a -- concurrent setting. -- | Interface to operations on 'RandomGen' wrappers like 'IOGenM' and 'StateGenM'. -- -- @since 1.2.0 class (RandomGen r, StatefulGen g m) => RandomGenM g r m | g -> r where applyRandomGenM :: (r -> (a, r)) -> g -> m a -- | Splits a pseudo-random number generator into two. Overwrites the mutable -- wrapper with one of the resulting generators and returns the other. -- -- @since 1.2.0 splitGenM :: RandomGenM g r m => g -> m r splitGenM = applyRandomGenM split instance (RandomGen r, MonadIO m) => RandomGenM (IOGenM r) r m where applyRandomGenM = applyIOGen instance (RandomGen r, MonadIO m) => RandomGenM (AtomicGenM r) r m where applyRandomGenM = applyAtomicGen instance (RandomGen r, MonadState r m) => RandomGenM (StateGenM r) r m where applyRandomGenM f _ = state f instance RandomGen r => RandomGenM (STGenM r s) r (ST s) where applyRandomGenM = applySTGen instance RandomGen r => RandomGenM (TGenM r) r STM where applyRandomGenM = applyTGen -- | Runs a mutable pseudo-random number generator from its 'FrozenGen' state. -- -- ====__Examples__ -- -- >>> import Data.Int (Int8) -- >>> withMutableGen (IOGen (mkStdGen 217)) (uniformListM 5) :: IO ([Int8], IOGen StdGen) -- ([-74,37,-50,-2,3],IOGen {unIOGen = StdGen {unStdGen = SMGen 4273268533320920145 15251669095119325999}}) -- -- @since 1.2.0 withMutableGen :: FrozenGen f m => f -> (MutableGen f m -> m a) -> m (a, f) withMutableGen fg action = do g <- thawGen fg res <- action g fg' <- freezeGen g pure (res, fg') -- | Same as 'withMutableGen', but only returns the generated value. -- -- ====__Examples__ -- -- >>> import System.Random.Stateful -- >>> let pureGen = mkStdGen 137 -- >>> withMutableGen_ (IOGen pureGen) (uniformRM (1 :: Int, 6 :: Int)) -- 4 -- -- @since 1.2.0 withMutableGen_ :: FrozenGen f m => f -> (MutableGen f m -> m a) -> m a withMutableGen_ fg action = fst <$> withMutableGen fg action -- | Generates a list of pseudo-random values. -- -- ====__Examples__ -- -- >>> import System.Random.Stateful -- >>> let pureGen = mkStdGen 137 -- >>> g <- newIOGenM pureGen -- >>> uniformListM 10 g :: IO [Bool] -- [True,True,True,True,False,True,True,False,False,False] -- -- @since 1.2.0 uniformListM :: (StatefulGen g m, Uniform a) => Int -> g -> m [a] uniformListM n gen = replicateM n (uniformM gen) -- | Generates a pseudo-random value using monadic interface and `Random` instance. -- -- ====__Examples__ -- -- >>> import System.Random.Stateful -- >>> let pureGen = mkStdGen 137 -- >>> g <- newIOGenM pureGen -- >>> randomM g :: IO Double -- 0.5728354935654512 -- -- @since 1.2.0 randomM :: (RandomGenM g r m, Random a) => g -> m a randomM = applyRandomGenM random -- | Generates a pseudo-random value using monadic interface and `Random` instance. -- -- ====__Examples__ -- -- >>> import System.Random.Stateful -- >>> let pureGen = mkStdGen 137 -- >>> g <- newIOGenM pureGen -- >>> randomRM (1, 100) g :: IO Int -- 52 -- -- @since 1.2.0 randomRM :: (RandomGenM g r m, Random a) => (a, a) -> g -> m a randomRM r = applyRandomGenM (randomR r) -- | Wraps an 'IORef' that holds a pure pseudo-random number generator. All -- operations are performed atomically. -- -- * 'AtomicGenM' is safe in the presence of exceptions and concurrency. -- * 'AtomicGenM' is the slowest of the monadic adapters due to the overhead -- of its atomic operations. -- -- @since 1.2.0 newtype AtomicGenM g = AtomicGenM { unAtomicGenM :: IORef g} -- | Frozen version of mutable `AtomicGenM` generator -- -- @since 1.2.0 newtype AtomicGen g = AtomicGen { unAtomicGen :: g} deriving (Eq, Ord, Show, RandomGen, Storable, NFData) -- | Creates a new 'AtomicGenM'. -- -- @since 1.2.0 newAtomicGenM :: MonadIO m => g -> m (AtomicGenM g) newAtomicGenM = fmap AtomicGenM . liftIO . newIORef -- | Global mutable standard pseudo-random number generator. This is the same -- generator that was historically used by `randomIO` and `randomRIO` functions. -- -- >>> replicateM 10 (uniformRM ('a', 'z') globalStdGen) -- "tdzxhyfvgr" -- -- @since 1.2.1 globalStdGen :: AtomicGenM StdGen globalStdGen = AtomicGenM theStdGen instance (RandomGen g, MonadIO m) => StatefulGen (AtomicGenM g) m where uniformWord32R r = applyAtomicGen (genWord32R r) {-# INLINE uniformWord32R #-} uniformWord64R r = applyAtomicGen (genWord64R r) {-# INLINE uniformWord64R #-} uniformWord8 = applyAtomicGen genWord8 {-# INLINE uniformWord8 #-} uniformWord16 = applyAtomicGen genWord16 {-# INLINE uniformWord16 #-} uniformWord32 = applyAtomicGen genWord32 {-# INLINE uniformWord32 #-} uniformWord64 = applyAtomicGen genWord64 {-# INLINE uniformWord64 #-} uniformShortByteString n = applyAtomicGen (genShortByteString n) instance (RandomGen g, MonadIO m) => FrozenGen (AtomicGen g) m where type MutableGen (AtomicGen g) m = AtomicGenM g freezeGen = fmap AtomicGen . liftIO . readIORef . unAtomicGenM thawGen (AtomicGen g) = newAtomicGenM g -- | Atomically applies a pure operation to the wrapped pseudo-random number -- generator. -- -- ====__Examples__ -- -- >>> import System.Random.Stateful -- >>> let pureGen = mkStdGen 137 -- >>> g <- newAtomicGenM pureGen -- >>> applyAtomicGen random g :: IO Int -- 7879794327570578227 -- -- @since 1.2.0 applyAtomicGen :: MonadIO m => (g -> (a, g)) -> AtomicGenM g -> m a applyAtomicGen op (AtomicGenM gVar) = liftIO $ atomicModifyIORef' gVar $ \g -> case op g of (a, g') -> (g', a) {-# INLINE applyAtomicGen #-} -- | Wraps an 'IORef' that holds a pure pseudo-random number generator. -- -- * 'IOGenM' is safe in the presence of exceptions, but not concurrency. -- * 'IOGenM' is slower than 'StateGenM' due to the extra pointer indirection. -- * 'IOGenM' is faster than 'AtomicGenM' since the 'IORef' operations used by -- 'IOGenM' are not atomic. -- -- An example use case is writing pseudo-random bytes into a file: -- -- >>> import UnliftIO.Temporary (withSystemTempFile) -- >>> import Data.ByteString (hPutStr) -- >>> let ioGen g = withSystemTempFile "foo.bin" $ \_ h -> uniformRM (0, 100) g >>= flip uniformByteStringM g >>= hPutStr h -- -- and then run it: -- -- >>> newIOGenM (mkStdGen 1729) >>= ioGen -- -- @since 1.2.0 newtype IOGenM g = IOGenM { unIOGenM :: IORef g } -- | Frozen version of mutable `IOGenM` generator -- -- @since 1.2.0 newtype IOGen g = IOGen { unIOGen :: g } deriving (Eq, Ord, Show, RandomGen, Storable, NFData) -- | Creates a new 'IOGenM'. -- -- @since 1.2.0 newIOGenM :: MonadIO m => g -> m (IOGenM g) newIOGenM = fmap IOGenM . liftIO . newIORef instance (RandomGen g, MonadIO m) => StatefulGen (IOGenM g) m where uniformWord32R r = applyIOGen (genWord32R r) {-# INLINE uniformWord32R #-} uniformWord64R r = applyIOGen (genWord64R r) {-# INLINE uniformWord64R #-} uniformWord8 = applyIOGen genWord8 {-# INLINE uniformWord8 #-} uniformWord16 = applyIOGen genWord16 {-# INLINE uniformWord16 #-} uniformWord32 = applyIOGen genWord32 {-# INLINE uniformWord32 #-} uniformWord64 = applyIOGen genWord64 {-# INLINE uniformWord64 #-} uniformShortByteString n = applyIOGen (genShortByteString n) instance (RandomGen g, MonadIO m) => FrozenGen (IOGen g) m where type MutableGen (IOGen g) m = IOGenM g freezeGen = fmap IOGen . liftIO . readIORef . unIOGenM thawGen (IOGen g) = newIOGenM g -- | Applies a pure operation to the wrapped pseudo-random number generator. -- -- ====__Examples__ -- -- >>> import System.Random.Stateful -- >>> let pureGen = mkStdGen 137 -- >>> g <- newIOGenM pureGen -- >>> applyIOGen random g :: IO Int -- 7879794327570578227 -- -- @since 1.2.0 applyIOGen :: MonadIO m => (g -> (a, g)) -> IOGenM g -> m a applyIOGen f (IOGenM ref) = liftIO $ do g <- readIORef ref case f g of (!a, !g') -> a <$ writeIORef ref g' {-# INLINE applyIOGen #-} -- | Wraps an 'STRef' that holds a pure pseudo-random number generator. -- -- * 'STGenM' is safe in the presence of exceptions, but not concurrency. -- * 'STGenM' is slower than 'StateGenM' due to the extra pointer indirection. -- -- @since 1.2.0 newtype STGenM g s = STGenM { unSTGenM :: STRef s g } -- | Frozen version of mutable `STGenM` generator -- -- @since 1.2.0 newtype STGen g = STGen { unSTGen :: g } deriving (Eq, Ord, Show, RandomGen, Storable, NFData) -- | Creates a new 'STGenM'. -- -- @since 1.2.0 newSTGenM :: g -> ST s (STGenM g s) newSTGenM = fmap STGenM . newSTRef instance RandomGen g => StatefulGen (STGenM g s) (ST s) where uniformWord32R r = applySTGen (genWord32R r) {-# INLINE uniformWord32R #-} uniformWord64R r = applySTGen (genWord64R r) {-# INLINE uniformWord64R #-} uniformWord8 = applySTGen genWord8 {-# INLINE uniformWord8 #-} uniformWord16 = applySTGen genWord16 {-# INLINE uniformWord16 #-} uniformWord32 = applySTGen genWord32 {-# INLINE uniformWord32 #-} uniformWord64 = applySTGen genWord64 {-# INLINE uniformWord64 #-} uniformShortByteString n = applySTGen (genShortByteString n) instance RandomGen g => FrozenGen (STGen g) (ST s) where type MutableGen (STGen g) (ST s) = STGenM g s freezeGen = fmap STGen . readSTRef . unSTGenM thawGen (STGen g) = newSTGenM g -- | Applies a pure operation to the wrapped pseudo-random number generator. -- -- ====__Examples__ -- -- >>> import System.Random.Stateful -- >>> let pureGen = mkStdGen 137 -- >>> (runSTGen pureGen (\g -> applySTGen random g)) :: (Int, StdGen) -- (7879794327570578227,StdGen {unStdGen = SMGen 11285859549637045894 7641485672361121627}) -- -- @since 1.2.0 applySTGen :: (g -> (a, g)) -> STGenM g s -> ST s a applySTGen f (STGenM ref) = do g <- readSTRef ref case f g of (!a, !g') -> a <$ writeSTRef ref g' {-# INLINE applySTGen #-} -- | Runs a monadic generating action in the `ST` monad using a pure -- pseudo-random number generator. -- -- ====__Examples__ -- -- >>> import System.Random.Stateful -- >>> let pureGen = mkStdGen 137 -- >>> (runSTGen pureGen (\g -> applySTGen random g)) :: (Int, StdGen) -- (7879794327570578227,StdGen {unStdGen = SMGen 11285859549637045894 7641485672361121627}) -- -- @since 1.2.0 runSTGen :: RandomGen g => g -> (forall s . STGenM g s -> ST s a) -> (a, g) runSTGen g action = unSTGen <$> runST (withMutableGen (STGen g) action) -- | Runs a monadic generating action in the `ST` monad using a pure -- pseudo-random number generator. Returns only the resulting pseudo-random -- value. -- -- ====__Examples__ -- -- >>> import System.Random.Stateful -- >>> let pureGen = mkStdGen 137 -- >>> (runSTGen_ pureGen (\g -> applySTGen random g)) :: Int -- 7879794327570578227 -- -- @since 1.2.0 runSTGen_ :: RandomGen g => g -> (forall s . STGenM g s -> ST s a) -> a runSTGen_ g action = fst $ runSTGen g action -- | Wraps a 'TVar' that holds a pure pseudo-random number generator. -- -- @since 1.2.1 newtype TGenM g = TGenM { unTGenM :: TVar g } -- | Frozen version of mutable `TGenM` generator -- -- @since 1.2.1 newtype TGen g = TGen { unTGen :: g } deriving (Eq, Ord, Show, RandomGen, Storable, NFData) -- | Creates a new 'TGenM' in `STM`. -- -- @since 1.2.1 newTGenM :: g -> STM (TGenM g) newTGenM = fmap TGenM . newTVar -- | Creates a new 'TGenM' in `IO`. -- -- @since 1.2.1 newTGenMIO :: MonadIO m => g -> m (TGenM g) newTGenMIO g = liftIO (TGenM <$> newTVarIO g) -- | @since 1.2.1 instance RandomGen g => StatefulGen (TGenM g) STM where uniformWord32R r = applyTGen (genWord32R r) {-# INLINE uniformWord32R #-} uniformWord64R r = applyTGen (genWord64R r) {-# INLINE uniformWord64R #-} uniformWord8 = applyTGen genWord8 {-# INLINE uniformWord8 #-} uniformWord16 = applyTGen genWord16 {-# INLINE uniformWord16 #-} uniformWord32 = applyTGen genWord32 {-# INLINE uniformWord32 #-} uniformWord64 = applyTGen genWord64 {-# INLINE uniformWord64 #-} uniformShortByteString n = applyTGen (genShortByteString n) -- | @since 1.2.1 instance RandomGen g => FrozenGen (TGen g) STM where type MutableGen (TGen g) STM = TGenM g freezeGen = fmap TGen . readTVar . unTGenM thawGen (TGen g) = newTGenM g -- | Applies a pure operation to the wrapped pseudo-random number generator. -- -- ====__Examples__ -- -- >>> import Control.Concurrent.STM -- >>> import System.Random.Stateful -- >>> import Data.Int (Int32) -- >>> let pureGen = mkStdGen 137 -- >>> stmGen <- newTGenMIO pureGen -- >>> atomically $ applyTGen uniform stmGen :: IO Int32 -- 637238067 -- -- @since 1.2.1 applyTGen :: (g -> (a, g)) -> TGenM g -> STM a applyTGen f (TGenM tvar) = do g <- readTVar tvar case f g of (a, !g') -> a <$ writeTVar tvar g' {-# INLINE applyTGen #-} -- $uniform -- -- This library provides two type classes to generate pseudo-random values: -- -- * 'UniformRange' is used to generate a value of a type uniformly within a -- range. -- * 'Uniform' is used to generate a value of a type uniformly over all -- possible values of that type. -- -- Types may have instances for both or just one of 'UniformRange' and -- 'Uniform'. A few examples illustrate this: -- -- * 'Int', 'Data.Word.Word16' and 'Bool' are instances of both 'UniformRange' and -- 'Uniform'. -- * 'Integer', 'Float' and 'Double' each have an instance for 'UniformRange' -- but no 'Uniform' instance. -- * A hypothetical type @Radian@ representing angles by taking values in the -- range @[0, 2Ï€)@ has a trivial 'Uniform' instance, but no 'UniformRange' -- instance: the problem is that two given @Radian@ values always span /two/ -- ranges, one clockwise and one anti-clockwise. -- * It is trivial to construct a @Uniform (a, b)@ instance given -- @Uniform a@ and @Uniform b@ (and this library provides this tuple -- instance). -- * On the other hand, there is no correct way to construct a -- @UniformRange (a, b)@ instance based on just @UniformRange a@ and -- @UniformRange b@. ------------------------------------------------------------------------------- -- Notes ------------------------------------------------------------------------------- -- $floating -- -- The 'UniformRange' instances for 'Float' and 'Double' use the following -- procedure to generate a random value in a range for @uniformRM (a, b) g@: -- -- If \(a = b\), return \(a\). Otherwise: -- -- 1. Generate \(x\) uniformly such that \(0 \leq x \leq 1\). -- -- The method by which \(x\) is sampled does not cover all representable -- floating point numbers in the unit interval. The method never generates -- denormal floating point numbers, for example. -- -- 2. Return \(x \cdot a + (1 - x) \cdot b\). -- -- Due to rounding errors, floating point operations are neither -- associative nor distributive the way the corresponding operations on -- real numbers are. Additionally, floating point numbers admit special -- values @NaN@ as well as negative and positive infinity. -- -- For pathological values, step 2 can yield surprising results. -- -- * The result may be greater than @max a b@. -- -- >>> :{ -- let (a, b, x) = (-2.13238e-29, -2.1323799e-29, 0.27736077) -- result = x * a + (1 - x) * b :: Float -- in (result, result > max a b) -- :} -- (-2.1323797e-29,True) -- -- * The result may be smaller than @min a b@. -- -- >>> :{ -- let (a, b, x) = (-1.9087862, -1.908786, 0.4228573) -- result = x * a + (1 - x) * b :: Float -- in (result, result < min a b) -- :} -- (-1.9087863,True) -- -- What happens when @NaN@ or @Infinity@ are given to 'uniformRM'? We first -- define them as constants: -- -- >>> nan = read "NaN" :: Float -- >>> inf = read "Infinity" :: Float -- -- * If at least one of \(a\) or \(b\) is @NaN@, the result is @NaN@. -- -- >>> let (a, b, x) = (nan, 1, 0.5) in x * a + (1 - x) * b -- NaN -- >>> let (a, b, x) = (-1, nan, 0.5) in x * a + (1 - x) * b -- NaN -- -- * If \(a\) is @-Infinity@ and \(b\) is @Infinity@, the result is @NaN@. -- -- >>> let (a, b, x) = (-inf, inf, 0.5) in x * a + (1 - x) * b -- NaN -- -- * Otherwise, if \(a\) is @Infinity@ or @-Infinity@, the result is \(a\). -- -- >>> let (a, b, x) = (inf, 1, 0.5) in x * a + (1 - x) * b -- Infinity -- >>> let (a, b, x) = (-inf, 1, 0.5) in x * a + (1 - x) * b -- -Infinity -- -- * Otherwise, if \(b\) is @Infinity@ or @-Infinity@, the result is \(b\). -- -- >>> let (a, b, x) = (1, inf, 0.5) in x * a + (1 - x) * b -- Infinity -- >>> let (a, b, x) = (1, -inf, 0.5) in x * a + (1 - x) * b -- -Infinity -- -- Note that the [GCC 10.1.0 C++ standard library](https://gcc.gnu.org/git/?p=gcc.git;a=blob;f=libstdc%2B%2B-v3/include/bits/random.h;h=19307fbc3ca401976ef6823e8fda893e4a263751;hb=63fa67847628e5f358e7e2e7edb8314f0ee31f30#l1859), -- the [Java 10 standard library](https://docs.oracle.com/javase/10/docs/api/java/util/Random.html#doubles%28double,double%29) -- and [CPython 3.8](https://github.com/python/cpython/blob/3.8/Lib/random.py#L417) -- use the same procedure to generate floating point values in a range. -- -- $implementmonadrandom -- -- Typically, a monadic pseudo-random number generator has facilities to save -- and restore its internal state in addition to generating pseudo-random numbers. -- -- Here is an example instance for the monadic pseudo-random number generator -- from the @mwc-random@ package: -- -- > instance (s ~ PrimState m, PrimMonad m) => StatefulGen (MWC.Gen s) m where -- > uniformWord8 = MWC.uniform -- > uniformWord16 = MWC.uniform -- > uniformWord32 = MWC.uniform -- > uniformWord64 = MWC.uniform -- > uniformShortByteString n g = unsafeSTToPrim (genShortByteStringST n (MWC.uniform g)) -- -- > instance PrimMonad m => FrozenGen MWC.Seed m where -- > type MutableGen MWC.Seed m = MWC.Gen (PrimState m) -- > thawGen = MWC.restore -- > freezeGen = MWC.save -- -- === @FrozenGen@ -- -- `FrozenGen` gives us ability to use any stateful pseudo-random number generator in its -- immutable form, if one exists that is. This concept is commonly known as a seed, which -- allows us to save and restore the actual mutable state of a pseudo-random number -- generator. The biggest benefit that can be drawn from a polymorphic access to a -- stateful pseudo-random number generator in a frozen form is the ability to serialize, -- deserialize and possibly even use the stateful generator in a pure setting without -- knowing the actual type of a generator ahead of time. For example we can write a -- function that accepts a frozen state of some pseudo-random number generator and -- produces a short list with random even integers. -- -- >>> import Data.Int (Int8) -- >>> :{ -- myCustomRandomList :: FrozenGen f m => f -> m [Int8] -- myCustomRandomList f = -- withMutableGen_ f $ \gen -> do -- len <- uniformRM (5, 10) gen -- replicateM len $ do -- x <- uniformM gen -- pure $ if even x then x else x + 1 -- :} -- -- and later we can apply it to a frozen version of a stateful generator, such as `STGen`: -- -- >>> print $ runST $ myCustomRandomList (STGen (mkStdGen 217)) -- [-50,-2,4,-8,-58,-40,24,-32,-110,24] -- -- or a @Seed@ from @mwc-random@: -- -- >>> import Data.Vector.Primitive as P -- >>> print $ runST $ myCustomRandomList (MWC.toSeed (P.fromList [1,2,3])) -- [24,40,10,40,-8,48,-78,70,-12] -- -- Alternatively, instead of discarding the final state of the generator, as it happens -- above, we could have used `withMutableGen`, which together with the result would give -- us back its frozen form. This would allow us to store the end state of our generator -- somewhere for the later reuse. -- -- -- $references -- -- 1. Guy L. Steele, Jr., Doug Lea, and Christine H. Flood. 2014. Fast -- splittable pseudorandom number generators. In Proceedings of the 2014 ACM -- International Conference on Object Oriented Programming Systems Languages & -- Applications (OOPSLA '14). ACM, New York, NY, USA, 453-472. DOI: -- -- $setup -- >>> import Control.Monad.Primitive -- >>> import qualified System.Random.MWC as MWC -- >>> writeIORef theStdGen $ mkStdGen 2021 -- -- >>> :set -XFlexibleContexts -- >>> :set -XFlexibleInstances -- >>> :set -XMultiParamTypeClasses -- >>> :set -XTypeFamilies -- >>> :set -XUndecidableInstances -- -- >>> :{ -- instance (s ~ PrimState m, PrimMonad m) => StatefulGen (MWC.Gen s) m where -- uniformWord8 = MWC.uniform -- uniformWord16 = MWC.uniform -- uniformWord32 = MWC.uniform -- uniformWord64 = MWC.uniform -- uniformShortByteString n g = unsafeSTToPrim (genShortByteStringST n (MWC.uniform g)) -- instance PrimMonad m => FrozenGen MWC.Seed m where -- type MutableGen MWC.Seed m = MWC.Gen (PrimState m) -- thawGen = MWC.restore -- freezeGen = MWC.save -- :} -- random-1.2.1.1/src/System/Random/GFinite.hs0000644000000000000000000002076514235761771016523 0ustar0000000000000000-- | -- Module : System.Random.GFinite -- Copyright : (c) Andrew Lelechenko 2020 -- License : BSD-style (see the file LICENSE in the 'random' repository) -- Maintainer : libraries@haskell.org -- {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} module System.Random.GFinite ( Cardinality(..) , Finite(..) , GFinite(..) ) where import Data.Bits import Data.Int import Data.Void import Data.Word import GHC.Exts (Proxy#, proxy#) import GHC.Generics -- | Cardinality of a set. data Cardinality = Shift !Int -- ^ Shift n is equivalent to Card (bit n) | Card !Integer deriving (Eq, Ord, Show) -- | This is needed only as a superclass of 'Integral'. instance Enum Cardinality where toEnum = fromIntegral fromEnum = fromIntegral succ = (+ 1) pred = subtract 1 enumFrom x = map fromInteger (enumFrom (toInteger x)) enumFromThen x y = map fromInteger (enumFromThen (toInteger x) (toInteger y)) enumFromTo x y = map fromInteger (enumFromTo (toInteger x) (toInteger y)) enumFromThenTo x y z = map fromInteger (enumFromThenTo (toInteger x) (toInteger y) (toInteger z)) instance Num Cardinality where fromInteger 1 = Shift 0 -- () fromInteger 2 = Shift 1 -- Bool fromInteger n = Card n {-# INLINE fromInteger #-} x + y = fromInteger (toInteger x + toInteger y) {-# INLINE (+) #-} Shift x * Shift y = Shift (x + y) Shift x * Card y = Card (y `shiftL` x) Card x * Shift y = Card (x `shiftL` y) Card x * Card y = Card (x * y) {-# INLINE (*) #-} abs = Card . abs . toInteger signum = Card . signum . toInteger negate = Card . negate . toInteger -- | This is needed only as a superclass of 'Integral'. instance Real Cardinality where toRational = fromIntegral instance Integral Cardinality where toInteger = \case Shift n -> bit n Card n -> n {-# INLINE toInteger #-} quotRem x' = \case Shift n -> (Card (x `shiftR` n), Card (x .&. (bit n - 1))) Card n -> let (q, r) = x `quotRem` n in (Card q, Card r) where x = toInteger x' {-# INLINE quotRem #-} -- | A type class for data with a finite number of inhabitants. -- This type class is used -- in default implementations of 'System.Random.Stateful.Uniform'. -- -- Users are not supposed to write instances of 'Finite' manually. -- There is a default implementation in terms of 'Generic' instead. -- -- >>> :set -XDeriveGeneric -XDeriveAnyClass -- >>> import GHC.Generics (Generic) -- >>> data MyBool = MyTrue | MyFalse deriving (Generic, Finite) -- >>> data Action = Code MyBool | Eat (Maybe Bool) | Sleep deriving (Generic, Finite) -- class Finite a where cardinality :: Proxy# a -> Cardinality toFinite :: Integer -> a fromFinite :: a -> Integer default cardinality :: (Generic a, GFinite (Rep a)) => Proxy# a -> Cardinality cardinality _ = gcardinality (proxy# :: Proxy# (Rep a)) {-# INLINE cardinality #-} default toFinite :: (Generic a, GFinite (Rep a)) => Integer -> a toFinite = to . toGFinite {-# INLINE toFinite #-} default fromFinite :: (Generic a, GFinite (Rep a)) => a -> Integer fromFinite = fromGFinite . from {-# INLINE fromFinite #-} class GFinite f where gcardinality :: Proxy# f -> Cardinality toGFinite :: Integer -> f a fromGFinite :: f a -> Integer instance GFinite V1 where gcardinality _ = 0 {-# INLINE gcardinality #-} toGFinite = const $ error "GFinite: V1 has no inhabitants" {-# INLINE toGFinite #-} fromGFinite = const $ error "GFinite: V1 has no inhabitants" {-# INLINE fromGFinite #-} instance GFinite U1 where gcardinality _ = 1 {-# INLINE gcardinality #-} toGFinite = const U1 {-# INLINE toGFinite #-} fromGFinite = const 0 {-# INLINE fromGFinite #-} instance Finite a => GFinite (K1 _x a) where gcardinality _ = cardinality (proxy# :: Proxy# a) {-# INLINE gcardinality #-} toGFinite = K1 . toFinite {-# INLINE toGFinite #-} fromGFinite = fromFinite . unK1 {-# INLINE fromGFinite #-} instance GFinite a => GFinite (M1 _x _y a) where gcardinality _ = gcardinality (proxy# :: Proxy# a) {-# INLINE gcardinality #-} toGFinite = M1 . toGFinite {-# INLINE toGFinite #-} fromGFinite = fromGFinite . unM1 {-# INLINE fromGFinite #-} instance (GFinite a, GFinite b) => GFinite (a :+: b) where gcardinality _ = gcardinality (proxy# :: Proxy# a) + gcardinality (proxy# :: Proxy# b) {-# INLINE gcardinality #-} toGFinite n | n < cardA = L1 $ toGFinite n | otherwise = R1 $ toGFinite (n - cardA) where cardA = toInteger (gcardinality (proxy# :: Proxy# a)) {-# INLINE toGFinite #-} fromGFinite = \case L1 x -> fromGFinite x R1 x -> fromGFinite x + toInteger (gcardinality (proxy# :: Proxy# a)) {-# INLINE fromGFinite #-} instance (GFinite a, GFinite b) => GFinite (a :*: b) where gcardinality _ = gcardinality (proxy# :: Proxy# a) * gcardinality (proxy# :: Proxy# b) {-# INLINE gcardinality #-} toGFinite n = toGFinite (toInteger q) :*: toGFinite (toInteger r) where cardB = gcardinality (proxy# :: Proxy# b) (q, r) = Card n `quotRem` cardB {-# INLINE toGFinite #-} fromGFinite (q :*: r) = toInteger (gcardinality (proxy# :: Proxy# b) * Card (fromGFinite q)) + fromGFinite r {-# INLINE fromGFinite #-} instance Finite Void instance Finite () instance Finite Bool instance Finite Ordering instance Finite Char where cardinality _ = Card $ toInteger (fromEnum (maxBound :: Char)) + 1 {-# INLINE cardinality #-} toFinite = toEnum . fromInteger {-# INLINE toFinite #-} fromFinite = toInteger . fromEnum {-# INLINE fromFinite #-} cardinalityDef :: forall a. (Num a, FiniteBits a) => Proxy# a -> Cardinality cardinalityDef _ = Shift (finiteBitSize (0 :: a)) toFiniteDef :: forall a. (Num a, FiniteBits a) => Integer -> a toFiniteDef n | isSigned (0 :: a) = fromInteger (n - bit (finiteBitSize (0 :: a) - 1)) | otherwise = fromInteger n fromFiniteDef :: (Integral a, FiniteBits a) => a -> Integer fromFiniteDef x | isSigned x = toInteger x + bit (finiteBitSize x - 1) | otherwise = toInteger x instance Finite Word8 where cardinality = cardinalityDef {-# INLINE cardinality #-} toFinite = toFiniteDef {-# INLINE toFinite #-} fromFinite = fromFiniteDef {-# INLINE fromFinite #-} instance Finite Word16 where cardinality = cardinalityDef {-# INLINE cardinality #-} toFinite = toFiniteDef {-# INLINE toFinite #-} fromFinite = fromFiniteDef {-# INLINE fromFinite #-} instance Finite Word32 where cardinality = cardinalityDef {-# INLINE cardinality #-} toFinite = toFiniteDef {-# INLINE toFinite #-} fromFinite = fromFiniteDef {-# INLINE fromFinite #-} instance Finite Word64 where cardinality = cardinalityDef {-# INLINE cardinality #-} toFinite = toFiniteDef {-# INLINE toFinite #-} fromFinite = fromFiniteDef {-# INLINE fromFinite #-} instance Finite Word where cardinality = cardinalityDef {-# INLINE cardinality #-} toFinite = toFiniteDef {-# INLINE toFinite #-} fromFinite = fromFiniteDef {-# INLINE fromFinite #-} instance Finite Int8 where cardinality = cardinalityDef {-# INLINE cardinality #-} toFinite = toFiniteDef {-# INLINE toFinite #-} fromFinite = fromFiniteDef {-# INLINE fromFinite #-} instance Finite Int16 where cardinality = cardinalityDef {-# INLINE cardinality #-} toFinite = toFiniteDef {-# INLINE toFinite #-} fromFinite = fromFiniteDef {-# INLINE fromFinite #-} instance Finite Int32 where cardinality = cardinalityDef {-# INLINE cardinality #-} toFinite = toFiniteDef {-# INLINE toFinite #-} fromFinite = fromFiniteDef {-# INLINE fromFinite #-} instance Finite Int64 where cardinality = cardinalityDef {-# INLINE cardinality #-} toFinite = toFiniteDef {-# INLINE toFinite #-} fromFinite = fromFiniteDef {-# INLINE fromFinite #-} instance Finite Int where cardinality = cardinalityDef {-# INLINE cardinality #-} toFinite = toFiniteDef {-# INLINE toFinite #-} fromFinite = fromFiniteDef {-# INLINE fromFinite #-} instance Finite a => Finite (Maybe a) instance (Finite a, Finite b) => Finite (Either a b) instance (Finite a, Finite b) => Finite (a, b) instance (Finite a, Finite b, Finite c) => Finite (a, b, c) instance (Finite a, Finite b, Finite c, Finite d) => Finite (a, b, c, d) instance (Finite a, Finite b, Finite c, Finite d, Finite e) => Finite (a, b, c, d, e) instance (Finite a, Finite b, Finite c, Finite d, Finite e, Finite f) => Finite (a, b, c, d, e, f) random-1.2.1.1/test-inspection/Spec.hs0000644000000000000000000000057014121726764015712 0ustar0000000000000000{-# LANGUAGE CPP #-} module Main (main) where #if __GLASGOW_HASKELL__ >= 800 import qualified Spec.Inspection as Inspection import Test.Tasty main :: IO () main = defaultMain $ testGroup "InspectionSpec" [ Inspection.inspectionTests ] #else main :: IO () main = putStrLn "\nInspection testing is not supported for pre ghc-8.0 versions\n" #endif random-1.2.1.1/test-inspection/Spec/Inspection.hs0000644000000000000000000000372714121726764020034 0ustar0000000000000000{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-missing-signatures -O -dsuppress-all -dno-suppress-type-signatures -fplugin=Test.Tasty.Inspection.Plugin #-} module Spec.Inspection (inspectionTests) where import Data.Int import Data.Void import Data.Word import GHC.Generics import System.Random import System.Random.Stateful import Test.Tasty import Test.Tasty.Inspection uniform' :: Uniform a => (a, StdGen) uniform' = uniform (mkStdGen 42) uniform_Word8 = uniform' @Word8 uniform_Int8 = uniform' @Int8 uniform_Char = uniform' @Char data MyAction = Code (Maybe Bool) | Never Void | Eat (Bool, Bool) | Sleep () deriving (Eq, Ord, Show, Generic, Finite) instance Uniform MyAction uniform_MyAction = uniform' @MyAction uniformR' :: (Bounded a, UniformRange a) => (a, StdGen) uniformR' = uniformR (minBound, maxBound) (mkStdGen 42) uniformR_Word8 = uniformR' @Word8 uniformR_Int8 = uniformR' @Int8 uniformR_Char = uniformR' @Char uniformR_Double = uniformR (0 :: Double, 1) (mkStdGen 42) inspectionTests :: TestTree inspectionTests = testGroup "Inspection" $ [ $(inspectObligations [(`doesNotUse` 'StateGenM), hasNoGenerics, hasNoTypeClasses] 'uniform_Word8) , $(inspectObligations [(`doesNotUse` 'StateGenM), hasNoGenerics, hasNoTypeClasses] 'uniform_Int8) , $(inspectObligations [(`doesNotUse` 'StateGenM), hasNoGenerics, hasNoTypeClasses] 'uniform_Char) , $(inspectObligations [(`doesNotUse` 'StateGenM), hasNoGenerics, hasNoTypeClasses] 'uniform_MyAction) , $(inspectObligations [(`doesNotUse` 'StateGenM), hasNoGenerics, hasNoTypeClasses] 'uniformR_Word8) , $(inspectObligations [(`doesNotUse` 'StateGenM), hasNoGenerics, hasNoTypeClasses] 'uniformR_Int8) , $(inspectObligations [(`doesNotUse` 'StateGenM), hasNoGenerics, hasNoTypeClasses] 'uniformR_Char) , $(inspectObligations [(`doesNotUse` 'StateGenM), hasNoGenerics, hasNoTypeClasses] 'uniformR_Double) ] random-1.2.1.1/test/Spec.hs0000644000000000000000000002147614235761771013554 0ustar0000000000000000{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} module Main (main) where import Control.Monad (replicateM, forM_) import qualified Data.ByteString as BS import qualified Data.ByteString.Short as SBS import Data.Int import Data.Typeable import Data.Void import Data.Word import Foreign.C.Types import GHC.Generics import Numeric.Natural (Natural) import System.Random.Stateful import Test.SmallCheck.Series as SC import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.SmallCheck as SC import qualified Spec.Range as Range import qualified Spec.Run as Run import qualified Spec.Stateful as Stateful main :: IO () main = defaultMain $ testGroup "Spec" [ floatingSpec (Proxy :: Proxy Double) , floatingSpec (Proxy :: Proxy Float) , floatingSpec (Proxy :: Proxy CDouble) , floatingSpec (Proxy :: Proxy CFloat) , integralSpec (Proxy :: Proxy Word8) , integralSpec (Proxy :: Proxy Word16) , integralSpec (Proxy :: Proxy Word32) , integralSpec (Proxy :: Proxy Word64) , integralSpec (Proxy :: Proxy Word) , integralSpec (Proxy :: Proxy Int8) , integralSpec (Proxy :: Proxy Int16) , integralSpec (Proxy :: Proxy Int32) , integralSpec (Proxy :: Proxy Int64) , integralSpec (Proxy :: Proxy Int) , integralSpec (Proxy :: Proxy Char) , integralSpec (Proxy :: Proxy Bool) #if __GLASGOW_HASKELL__ >= 802 , integralSpec (Proxy :: Proxy CBool) #endif , integralSpec (Proxy :: Proxy CChar) , integralSpec (Proxy :: Proxy CSChar) , integralSpec (Proxy :: Proxy CUChar) , integralSpec (Proxy :: Proxy CShort) , integralSpec (Proxy :: Proxy CUShort) , integralSpec (Proxy :: Proxy CInt) , integralSpec (Proxy :: Proxy CUInt) , integralSpec (Proxy :: Proxy CLong) , integralSpec (Proxy :: Proxy CULong) , integralSpec (Proxy :: Proxy CPtrdiff) , integralSpec (Proxy :: Proxy CSize) , integralSpec (Proxy :: Proxy CWchar) , integralSpec (Proxy :: Proxy CSigAtomic) , integralSpec (Proxy :: Proxy CLLong) , integralSpec (Proxy :: Proxy CULLong) , integralSpec (Proxy :: Proxy CIntPtr) , integralSpec (Proxy :: Proxy CUIntPtr) , integralSpec (Proxy :: Proxy CIntMax) , integralSpec (Proxy :: Proxy CUIntMax) , integralSpec (Proxy :: Proxy Integer) , integralSpec (Proxy :: Proxy Natural) , enumSpec (Proxy :: Proxy Colors) , runSpec , floatTests , byteStringSpec , SC.testProperty "uniformRangeWithinExcludedF" $ seeded Range.uniformRangeWithinExcludedF , SC.testProperty "uniformRangeWithinExcludedD" $ seeded Range.uniformRangeWithinExcludedD , randomSpec (Proxy :: Proxy (CFloat, CDouble)) , randomSpec (Proxy :: Proxy (Int8, Int16, Int32)) , randomSpec (Proxy :: Proxy (Int8, Int16, Int32, Int64)) , randomSpec (Proxy :: Proxy (Word8, Word16, Word32, Word64, Word)) , randomSpec (Proxy :: Proxy (Int8, Word8, Word16, Word32, Word64, Word)) , randomSpec (Proxy :: Proxy (Int8, Int16, Word8, Word16, Word32, Word64, Word)) , uniformSpec (Proxy :: Proxy (Int, Bool)) , uniformSpec (Proxy :: Proxy (Int8, Int16, Int32)) , uniformSpec (Proxy :: Proxy (Int8, Int16, Int32, Int64)) , uniformSpec (Proxy :: Proxy (Word8, Word16, Word32, Word64, Word)) , uniformSpec (Proxy :: Proxy (Int8, Word8, Word16, Word32, Word64, Word)) , uniformSpec (Proxy :: Proxy (Int8, Int16, Word8, Word16, Word32, Word64, Word)) , Stateful.statefulSpec ] floatTests :: TestTree floatTests = testGroup "(Float)" [ -- Check that https://github.com/haskell/random/issues/53 does not regress testCase "Subnormal generation not above upper bound" $ [] @?= filter (>4.0e-45) (take 100000 $ randomRs (0, 4.0e-45::Float) $ mkStdGen 0) , testCase "Subnormal generation includes upper bound" $ 1.0e-45 `elem` take 100 (randomRs (0, 1.0e-45::Float) $ mkStdGen 0) @? "Does not contain 1.0e-45" ] showsType :: forall t . Typeable t => Proxy t -> ShowS showsType px = showsTypeRep (typeRep px) byteStringSpec :: TestTree byteStringSpec = testGroup "ByteString" [ SC.testProperty "genShortByteString" $ seededWithLen $ \n g -> SBS.length (fst (genShortByteString n g)) == n , SC.testProperty "genByteString" $ seededWithLen $ \n g -> SBS.toShort (fst (genByteString n g)) == fst (genShortByteString n g) , testCase "genByteString/ShortByteString consistency" $ do let g = mkStdGen 2021 bs = [78,232,117,189,13,237,63,84,228,82,19,36,191,5,128,192] :: [Word8] forM_ [0 .. length bs - 1] $ \ n -> do xs <- SBS.unpack <$> runStateGenT_ g (uniformShortByteString n) xs @?= take n bs ys <- BS.unpack <$> runStateGenT_ g (uniformByteStringM n) ys @?= xs ] rangeSpec :: forall a. (SC.Serial IO a, Typeable a, Ord a, UniformRange a, Show a) => Proxy a -> TestTree rangeSpec px = testGroup ("Range (" ++ showsType px ")") [ SC.testProperty "uniformR" $ seeded $ Range.uniformRangeWithin px ] integralSpec :: forall a. (SC.Serial IO a, Typeable a, Ord a, UniformRange a, Show a) => Proxy a -> TestTree integralSpec px = testGroup ("(" ++ showsType px ")") [ SC.testProperty "symmetric" $ seeded $ Range.symmetric px , SC.testProperty "bounded" $ seeded $ Range.bounded px , SC.testProperty "singleton" $ seeded $ Range.singleton px , rangeSpec px -- TODO: Add more tests ] enumSpec :: forall a. (SC.Serial IO a, Typeable a, Ord a, UniformRange a, Show a) => Proxy a -> TestTree enumSpec = integralSpec floatingSpec :: forall a. (SC.Serial IO a, Typeable a, Num a, Ord a, Random a, UniformRange a, Read a, Show a) => Proxy a -> TestTree floatingSpec px = testGroup ("(" ++ showsType px ")") [ SC.testProperty "uniformR" $ seeded $ Range.uniformRangeWithin px , testCase "r = +inf, x = 0" $ positiveInf @?= fst (uniformR (0, positiveInf) (ConstGen 0)) , testCase "r = +inf, x = 1" $ positiveInf @?= fst (uniformR (0, positiveInf) (ConstGen 1)) , testCase "l = -inf, x = 0" $ negativeInf @?= fst (uniformR (negativeInf, 0) (ConstGen 0)) , testCase "l = -inf, x = 1" $ negativeInf @?= fst (uniformR (negativeInf, 0) (ConstGen 1)) -- TODO: Add more tests ] where positiveInf, negativeInf :: a positiveInf = read "Infinity" negativeInf = read "-Infinity" randomSpec :: forall a. (Typeable a, Eq a, Random a, Show a) => Proxy a -> TestTree randomSpec px = testGroup ("Random " ++ showsType px ")") [ SC.testProperty "randoms" $ seededWithLen $ \len g -> take len (randoms g :: [a]) == runStateGen_ g (replicateM len . randomM) , SC.testProperty "randomRs" $ seededWithLen $ \len g -> case random g of (l, g') -> case random g' of (h, g'') -> take len (randomRs (l, h) g'' :: [a]) == runStateGen_ g'' (replicateM len . randomRM (l, h)) ] uniformSpec :: forall a. (Typeable a, Eq a, Random a, Uniform a, Show a) => Proxy a -> TestTree uniformSpec px = testGroup ("Uniform " ++ showsType px ")") [ SC.testProperty "uniformListM" $ seededWithLen $ \len g -> take len (randoms g :: [a]) == runStateGen_ g (uniformListM len) ] runSpec :: TestTree runSpec = testGroup "runStateGen_ and runPrimGenIO_" [ SC.testProperty "equal outputs" $ seeded $ \g -> monadic $ Run.runsEqual g ] -- | Create a StdGen instance from an Int and pass it to the given function. seeded :: (StdGen -> a) -> Int -> a seeded f = f . mkStdGen -- | Same as `seeded`, but also produces a length in range 0-255 suitable for generating -- lists and such seededWithLen :: (Int -> StdGen -> a) -> Word8 -> Int -> a seededWithLen f w8 = seeded (f (fromIntegral w8)) data MyBool = MyTrue | MyFalse deriving (Eq, Ord, Show, Generic, Finite, Uniform) instance Monad m => Serial m MyBool data MyAction = Code (Maybe MyBool) | Never Void | Eat (Bool, Bool) | Sleep () deriving (Eq, Ord, Show, Generic, Finite) instance Monad m => Serial m MyAction instance Uniform MyAction data Foo = Quux Char | Bar Int | Baz Word | Bar8 Int8 | Baz8 Word8 | Bar16 Int16 | Baz16 Word16 | Bar32 Int32 | Baz32 Word32 | Bar64 Int64 | Baz64 Word64 | Final () deriving (Eq, Ord, Show, Generic, Finite, Uniform) instance Monad m => Serial m Foo newtype ConstGen = ConstGen Word64 instance RandomGen ConstGen where genWord64 g@(ConstGen c) = (c, g) split g = (g, g) data Colors = Red | Green | Blue | Purple | Yellow | Black | White | Orange deriving (Eq, Ord, Show, Generic, Enum, Bounded) instance Monad m => Serial m Colors instance Uniform Colors where uniformM = uniformEnumM instance UniformRange Colors where uniformRM = uniformEnumRM random-1.2.1.1/test/Spec/Range.hs0000644000000000000000000000255114235761771014601 0ustar0000000000000000module Spec.Range ( symmetric , bounded , singleton , uniformRangeWithin , uniformRangeWithinExcludedF , uniformRangeWithinExcludedD ) where import System.Random.Internal import System.Random.Stateful import Data.Proxy symmetric :: (RandomGen g, UniformRange a, Eq a) => Proxy a -> g -> (a, a) -> Bool symmetric _ g (l, r) = fst (uniformR (l, r) g) == fst (uniformR (r, l) g) bounded :: (RandomGen g, UniformRange a, Ord a) => Proxy a -> g -> (a, a) -> Bool bounded _ g (l, r) = bottom <= result && result <= top where bottom = min l r top = max l r result = fst (uniformR (l, r) g) singleton :: (RandomGen g, UniformRange a, Eq a) => Proxy a -> g -> a -> Bool singleton _ g x = result == x where result = fst (uniformR (x, x) g) uniformRangeWithin :: (RandomGen g, UniformRange a, Ord a) => Proxy a -> g -> (a, a) -> Bool uniformRangeWithin _ gen (l, r) = runStateGen_ gen $ \g -> (\result -> min l r <= result && result <= max l r) <$> uniformRM (l, r) g uniformRangeWithinExcludedF :: RandomGen g => g -> Bool uniformRangeWithinExcludedF gen = runStateGen_ gen $ \g -> (\result -> 0 < result && result <= 1) <$> uniformFloatPositive01M g uniformRangeWithinExcludedD :: RandomGen g => g -> Bool uniformRangeWithinExcludedD gen = runStateGen_ gen $ \g -> (\result -> 0 < result && result <= 1) <$> uniformDoublePositive01M g random-1.2.1.1/test/Spec/Run.hs0000644000000000000000000000067113674377445014321 0ustar0000000000000000module Spec.Run (runsEqual) where import Data.Word (Word64) import System.Random.Stateful runsEqual :: RandomGen g => g -> IO Bool runsEqual g = do let pureResult = runStateGen_ g uniformM :: Word64 stResult = runSTGen_ g uniformM :: Word64 ioGenM <- newIOGenM g ioResult <- uniformM ioGenM atomicGenM <- newAtomicGenM g atomicResult <- uniformM atomicGenM return $ all (pureResult ==) [stResult, ioResult, atomicResult] random-1.2.1.1/test/Spec/Stateful.hs0000644000000000000000000000712614121726764015334 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Spec.Stateful where import Control.Concurrent.STM import Control.Monad.ST import Control.Monad.Trans.State.Strict import Data.Proxy import Data.Typeable import System.Random.Stateful import Test.SmallCheck.Series import Test.Tasty import Test.Tasty.SmallCheck as SC instance Monad m => Serial m StdGen where series = mkStdGen <$> series instance (Monad m, Serial m g) => Serial m (AtomicGen g) where series = AtomicGen <$> series instance (Monad m, Serial m g) => Serial m (IOGen g) where series = IOGen <$> series instance (Monad m, Serial m g) => Serial m (STGen g) where series = STGen <$> series instance (Monad m, Serial m g) => Serial m (TGen g) where series = TGen <$> series instance (Monad m, Serial m g) => Serial m (StateGen g) where series = StateGen <$> series matchRandomGenSpec :: forall b f m. (FrozenGen f m, Eq f, Show f, Eq b) => (forall a. m a -> IO a) -> (MutableGen f m -> m b) -> (StdGen -> (b, StdGen)) -> (f -> StdGen) -> f -> Property IO matchRandomGenSpec toIO genM gen toStdGen frozen = monadic $ do (x1, fg1) <- toIO $ withMutableGen frozen genM let (x2, g2) = gen $ toStdGen frozen pure $ x1 == x2 && toStdGen fg1 == g2 withMutableGenSpec :: forall f m. (FrozenGen f m, Eq f, Show f) => (forall a. m a -> IO a) -> f -> Property IO withMutableGenSpec toIO frozen = forAll $ \n -> monadic $ do let gen = uniformListM n x :: ([Word], f) <- toIO $ withMutableGen frozen gen y <- toIO $ withMutableGen frozen gen pure $ x == y statefulSpecFor :: forall f m. (FrozenGen f m, Eq f, Show f, Serial IO f, Typeable f) => (forall a. m a -> IO a) -> (f -> StdGen) -> TestTree statefulSpecFor toIO toStdGen = testGroup (showsTypeRep (typeRep (Proxy :: Proxy f)) "") [ testProperty "withMutableGen" $ forAll $ \(f :: f) -> withMutableGenSpec toIO f , testGroup "matchRandomGenSpec" [ testProperty "uniformWord8/genWord8" $ forAll $ \(f :: f) -> matchRandomGenSpec toIO uniformWord8 genWord8 toStdGen f , testProperty "uniformWord16/genWord16" $ forAll $ \(f :: f) -> matchRandomGenSpec toIO uniformWord16 genWord16 toStdGen f , testProperty "uniformWord32/genWord32" $ forAll $ \(f :: f) -> matchRandomGenSpec toIO uniformWord32 genWord32 toStdGen f , testProperty "uniformWord64/genWord64" $ forAll $ \(f :: f) -> matchRandomGenSpec toIO uniformWord64 genWord64 toStdGen f , testProperty "uniformWord32R/genWord32R" $ forAll $ \(w32, f :: f) -> matchRandomGenSpec toIO (uniformWord32R w32) (genWord32R w32) toStdGen f , testProperty "uniformWord64R/genWord64R" $ forAll $ \(w64, f :: f) -> matchRandomGenSpec toIO (uniformWord64R w64) (genWord64R w64) toStdGen f , testProperty "uniformShortByteString/genShortByteString" $ forAll $ \(n', f :: f) -> let n = abs n' `mod` 1000 -- Ensure it is not too big in matchRandomGenSpec toIO (uniformShortByteString n) (genShortByteString n) toStdGen f ] ] statefulSpec :: TestTree statefulSpec = testGroup "Stateful" [ statefulSpecFor id unIOGen , statefulSpecFor id unAtomicGen , statefulSpecFor stToIO unSTGen , statefulSpecFor atomically unTGen , statefulSpecFor (`evalStateT` mkStdGen 0) unStateGen ] random-1.2.1.1/test/doctests.hs0000644000000000000000000000051314235761240014466 0ustar0000000000000000{-# LANGUAGE CPP #-} module Main where #if __GLASGOW_HASKELL__ >= 802 && __GLASGOW_HASKELL__ < 810 import Test.DocTest (doctest) main :: IO () main = doctest ["src"] #else -- Also disabled in cabal file. -- TODO: fix doctest support main :: IO () main = putStrLn "\nDoctests are not supported for older ghc version\n" #endif random-1.2.1.1/test-legacy/Legacy.hs0000644000000000000000000000054614115211345015303 0ustar0000000000000000module Main (main) where import qualified Random1283 as Random1283 import qualified RangeTest as RangeTest import qualified T7936 as T7936 import qualified TestRandomIOs as TestRandomIOs import qualified TestRandomRs as TestRandomRs main :: IO () main = do Random1283.main RangeTest.main T7936.main TestRandomIOs.main TestRandomRs.main random-1.2.1.1/test-legacy/T7936.hs0000644000000000000000000000050213674377445014652 0ustar0000000000000000-- Test for ticket #7936: -- https://ghc.haskell.org/trac/ghc/ticket/7936 -- -- Used to fail with: -- -- $ cabal test T7936 --test-options="+RTS -M1M -RTS" -- T7936: Heap exhausted; module T7936 where import System.Random (newStdGen) import Control.Monad (replicateM_) main :: IO () main = replicateM_ 100000 newStdGen random-1.2.1.1/test-legacy/TestRandomIOs.hs0000644000000000000000000000112113674377445016607 0ustar0000000000000000-- Test for ticket #4218 (TestRandomIOs): -- https://ghc.haskell.org/trac/ghc/ticket/4218 -- -- Used to fail with: -- -- $ cabal test TestRandomIOs --test-options="+RTS -M1M -RTS" -- TestRandomIOs: Heap exhausted; module TestRandomIOs where import Control.Monad (replicateM) import System.Random (randomIO) -- Build a list of 5000 random ints in memory (IO Monad is strict), and print -- the last one. -- Should use less than 1Mb of heap space, or we are generating a list of -- unevaluated thunks. main :: IO () main = do rs <- replicateM 5000 randomIO :: IO [Int] print $ last rs random-1.2.1.1/test-legacy/TestRandomRs.hs0000644000000000000000000000122213674377445016503 0ustar0000000000000000-- Test for ticket #4218 (TestRandomRs): -- https://ghc.haskell.org/trac/ghc/ticket/4218 -- -- Fixed together with ticket #8704 -- https://ghc.haskell.org/trac/ghc/ticket/8704 -- Commit 4695ffa366f659940369f05e419a4f2249c3a776 -- -- Used to fail with: -- -- $ cabal test TestRandomRs --test-options="+RTS -M1M -RTS" -- TestRandomRs: Heap exhausted; module TestRandomRs where import Control.Monad (liftM) import System.Random (randomRs, getStdGen) -- Return the five-thousandth random number: -- Should run in constant space (< 1Mb heap). main :: IO () main = do n <- (last . take 5000 . randomRs (0, 1000000)) `liftM` getStdGen print (n::Integer) random-1.2.1.1/test-legacy/Random1283.hs0000644000000000000000000000242613674377445015663 0ustar0000000000000000module Random1283 (main) where import Control.Concurrent import Control.Monad import Data.Sequence (Seq, ViewL(..), empty, fromList, viewl, (<|), (|>), (><)) import System.Random -- This test threads, samples :: Int threads = 4 samples = 5000 main :: IO () main = loopTest threads samples loopTest :: Int -> Int -> IO () loopTest t s = do isClean <- testRace t s unless isClean $ putStrLn "race condition!" testRace :: Int -> Int -> IO Bool testRace t s = do ref <- liftM (take (t*s) . randoms) getStdGen iss <- threadRandoms t s return (isInterleavingOf (ref::[Int]) iss) threadRandoms :: Random a => Int -> Int -> IO [[a]] threadRandoms t s = do vs <- sequence $ replicate t $ do v <- newEmptyMVar _ <- forkIO (sequence (replicate s randomIO) >>= putMVar v) return v mapM takeMVar vs isInterleavingOf :: Eq a => [a] -> [[a]] -> Bool isInterleavingOf xs' yss' = iio xs' (viewl $ fromList yss') EmptyL where iio (x:xs) ((y:ys) :< yss) zss | x /= y = iio (x:xs) (viewl yss) (viewl (fromViewL zss |> (y:ys))) | x == y = iio xs (viewl ((ys <| yss) >< fromViewL zss)) EmptyL iio xs ([] :< yss) zss = iio xs (viewl yss) zss iio [] EmptyL EmptyL = True iio _ _ _ = False fromViewL :: ViewL a -> Seq a fromViewL EmptyL = empty fromViewL (x :< xs) = x <| xs random-1.2.1.1/test-legacy/RangeTest.hs0000644000000000000000000002165514235763105016010 0ustar0000000000000000module RangeTest (main) where import Control.Monad import System.Random import Data.Int import Data.Word import Foreign.C.Types -- Take many measurements and record the max/min/average random values. approxBounds :: (RandomGen g, Random a, Ord a, Num a) => (g -> (a,g)) -> Int -> a -> (a,a) -> g -> ((a,a,a),g) -- Here we do a little hack to essentially pass in the type in the last argument: approxBounds nxt iters unused (explo,exphi) initrng = if False then ((unused,unused,unused),undefined) -- else loop initrng iters 100 (-100) 0 -- Oops, can't use minBound/maxBound here. else loop initrng iters exphi explo 0 where loop rng 0 mn mx sum' = ((mn,mx,sum'),rng) loop rng n mn mx sum' = case nxt rng of (x, rng') -> loop rng' (n-1) (min x mn) (max x mx) (x+sum') -- We check that: -- (1) all generated numbers are in bounds -- (2) we get "close" to the bounds -- The with (2) is that we do enough trials to ensure that we can at -- least hit the 90% mark. checkBounds :: (Real a, Show a, Ord a) => String -> (Bool, a, a) -> ((a,a) -> StdGen -> ((a, a, t), StdGen)) -> IO () checkBounds msg (exclusive,lo,hi) fun = do -- (lo,hi) is [inclusive,exclusive) putStr $ msg ++ ": " (mn,mx,_) <- getStdRandom (fun (lo,hi)) when (mn < lo) $ error $ "broke lower bound: " ++ show mn when (mx > hi) $ error $ "broke upper bound: " ++ show mx when (exclusive && mx >= hi)$ error$ "hit upper bound: " ++ show mx let epsilon = 0.1 * (toRational hi - toRational lo) when (toRational (hi - mx) > epsilon) $ error $ "didn't get close enough to upper bound: "++ show mx when (toRational (mn - lo) > epsilon) $ error $ "didn't get close enough to lower bound: "++ show mn putStrLn "Passed" boundedRange :: (Num a, Bounded a) => (Bool, a, a) boundedRange = ( False, minBound, maxBound ) trials :: Int trials = 5000 -- Keep in mind here that on some architectures (e.g. ARM) CChar, CWchar, and CSigAtomic -- are unsigned main :: IO () main = do checkBounds "Int" boundedRange (approxBounds random trials (undefined::Int)) checkBounds "Integer" (False, fromIntegral (minBound::Int), fromIntegral (maxBound::Int)) (approxBounds random trials (undefined::Integer)) checkBounds "Int8" boundedRange (approxBounds random trials (undefined::Int8)) checkBounds "Int16" boundedRange (approxBounds random trials (undefined::Int16)) checkBounds "Int32" boundedRange (approxBounds random trials (undefined::Int32)) checkBounds "Int64" boundedRange (approxBounds random trials (undefined::Int64)) checkBounds "Word" boundedRange (approxBounds random trials (undefined::Word)) checkBounds "Word8" boundedRange (approxBounds random trials (undefined::Word8)) checkBounds "Word16" boundedRange (approxBounds random trials (undefined::Word16)) checkBounds "Word32" boundedRange (approxBounds random trials (undefined::Word32)) checkBounds "Word64" boundedRange (approxBounds random trials (undefined::Word64)) checkBounds "Double" (False,0.0,1.0) (approxBounds random trials (undefined::Double)) checkBounds "Float" (False,0.0,1.0) (approxBounds random trials (undefined::Float)) checkBounds "CChar" boundedRange (approxBounds random trials (undefined:: CChar)) checkBounds "CSChar" boundedRange (approxBounds random trials (undefined:: CSChar)) checkBounds "CUChar" boundedRange (approxBounds random trials (undefined:: CUChar)) checkBounds "CShort" boundedRange (approxBounds random trials (undefined:: CShort)) checkBounds "CUShort" boundedRange (approxBounds random trials (undefined:: CUShort)) checkBounds "CInt" boundedRange (approxBounds random trials (undefined:: CInt)) checkBounds "CUInt" boundedRange (approxBounds random trials (undefined:: CUInt)) checkBounds "CLong" boundedRange (approxBounds random trials (undefined:: CLong)) checkBounds "CULong" boundedRange (approxBounds random trials (undefined:: CULong)) checkBounds "CPtrdiff" boundedRange (approxBounds random trials (undefined:: CPtrdiff)) checkBounds "CSize" boundedRange (approxBounds random trials (undefined:: CSize)) checkBounds "CWchar" boundedRange (approxBounds random trials (undefined:: CWchar)) checkBounds "CSigAtomic" boundedRange (approxBounds random trials (undefined:: CSigAtomic)) checkBounds "CLLong" boundedRange (approxBounds random trials (undefined:: CLLong)) checkBounds "CULLong" boundedRange (approxBounds random trials (undefined:: CULLong)) checkBounds "CIntPtr" boundedRange (approxBounds random trials (undefined:: CIntPtr)) checkBounds "CUIntPtr" boundedRange (approxBounds random trials (undefined:: CUIntPtr)) checkBounds "CIntMax" boundedRange (approxBounds random trials (undefined:: CIntMax)) checkBounds "CUIntMax" boundedRange (approxBounds random trials (undefined:: CUIntMax)) -- Then check all the range-restricted versions: checkBounds "Int R" (False,-100,100) (approxBounds (randomR (-100,100)) trials (undefined::Int)) checkBounds "Integer R" (False,-100000000000000000000,100000000000000000000) (approxBounds (randomR (-100000000000000000000,100000000000000000000)) trials (undefined::Integer)) checkBounds "Int8 R" (False,-100,100) (approxBounds (randomR (-100,100)) trials (undefined::Int8)) checkBounds "Int8 Rsmall" (False,-50,50) (approxBounds (randomR (-50,50)) trials (undefined::Int8)) checkBounds "Int8 Rmini" (False,3,4) (approxBounds (randomR (3,4)) trials (undefined::Int8)) checkBounds "Int8 Rtrivial" (False,3,3) (approxBounds (randomR (3,3)) trials (undefined::Int8)) checkBounds "Int16 R" (False,-100,100) (approxBounds (randomR (-100,100)) trials (undefined::Int16)) checkBounds "Int32 R" (False,-100,100) (approxBounds (randomR (-100,100)) trials (undefined::Int32)) checkBounds "Int64 R" (False,-100,100) (approxBounds (randomR (-100,100)) trials (undefined::Int64)) checkBounds "Word R" (False,0,200) (approxBounds (randomR (0,200)) trials (undefined::Word)) checkBounds "Word8 R" (False,0,200) (approxBounds (randomR (0,200)) trials (undefined::Word8)) checkBounds "Word16 R" (False,0,200) (approxBounds (randomR (0,200)) trials (undefined::Word16)) checkBounds "Word32 R" (False,0,200) (approxBounds (randomR (0,200)) trials (undefined::Word32)) checkBounds "Word64 R" (False,0,200) (approxBounds (randomR (0,200)) trials (undefined::Word64)) checkBounds "Double R" (False,10.0,77.0) (approxBounds (randomR (10,77)) trials (undefined::Double)) checkBounds "Float R" (False,10.0,77.0) (approxBounds (randomR (10,77)) trials (undefined::Float)) checkBounds "CChar R" (False,0,100) (approxBounds (randomR (0,100)) trials (undefined:: CChar)) checkBounds "CSChar R" (False,-100,100) (approxBounds (randomR (-100,100)) trials (undefined:: CSChar)) checkBounds "CUChar R" (False,0,200) (approxBounds (randomR (0,200)) trials (undefined:: CUChar)) checkBounds "CShort R" (False,-100,100) (approxBounds (randomR (-100,100)) trials (undefined:: CShort)) checkBounds "CUShort R" (False,0,200) (approxBounds (randomR (0,200)) trials (undefined:: CUShort)) checkBounds "CInt R" (False,-100,100) (approxBounds (randomR (-100,100)) trials (undefined:: CInt)) checkBounds "CUInt R" (False,0,200) (approxBounds (randomR (0,200)) trials (undefined:: CUInt)) checkBounds "CLong R" (False,-100,100) (approxBounds (randomR (-100,100)) trials (undefined:: CLong)) checkBounds "CULong R" (False,0,200) (approxBounds (randomR (0,200)) trials (undefined:: CULong)) checkBounds "CPtrdiff R" (False,-100,100) (approxBounds (randomR (-100,100)) trials (undefined:: CPtrdiff)) checkBounds "CSize R" (False,0,200) (approxBounds (randomR (0,200)) trials (undefined:: CSize)) checkBounds "CWchar R" (False,0,100) (approxBounds (randomR (0,100)) trials (undefined:: CWchar)) checkBounds "CSigAtomic R" (False,0,100) (approxBounds (randomR (0,100)) trials (undefined:: CSigAtomic)) checkBounds "CLLong R" (False,-100,100) (approxBounds (randomR (-100,100)) trials (undefined:: CLLong)) checkBounds "CULLong R" (False,0,200) (approxBounds (randomR (0,200)) trials (undefined:: CULLong)) checkBounds "CIntPtr R" (False,-100,100) (approxBounds (randomR (-100,100)) trials (undefined:: CIntPtr)) checkBounds "CUIntPtr R" (False,0,200) (approxBounds (randomR (0,200)) trials (undefined:: CUIntPtr)) checkBounds "CIntMax R" (False,-100,100) (approxBounds (randomR (-100,100)) trials (undefined:: CIntMax)) checkBounds "CUIntMax R" (False,0,200) (approxBounds (randomR (0,200)) trials (undefined:: CUIntMax)) -- Untested: -- instance Random Char where -- instance Random Bool where -- instance Random Integer where random-1.2.1.1/bench/Main.hs0000644000000000000000000003570414121726764013642 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} module Main (main) where import Control.Monad import Control.Monad.State.Strict import Data.Int import Data.Proxy import Data.Typeable import Data.Word import Foreign.C.Types import Numeric.Natural (Natural) import System.Random.SplitMix as SM import Test.Tasty.Bench import Control.Monad.Primitive import Data.Primitive.PrimArray import Data.Primitive.Types import System.Random.Stateful seed :: Int seed = 1337 main :: IO () main = do let !sz = 100000 genLengths = -- create 5000 small lengths that are needed for ShortByteString generation runStateGen (mkStdGen 2020) $ \g -> replicateM 5000 (uniformRM (16 + 1, 16 + 7) g) setStdGen $ mkStdGen seed defaultMain [ bgroup "baseline" [ env (pure $ SM.mkSMGen $ fromIntegral seed) $ \smGen -> bench "nextWord32" $ whnf (genMany SM.nextWord32 smGen) sz , env (pure $ SM.mkSMGen $ fromIntegral seed) $ \smGen -> bench "nextWord64" $ whnf (genMany SM.nextWord64 smGen) sz , env (pure $ SM.mkSMGen $ fromIntegral seed) $ \smGen -> bench "nextInt" $ whnf (genMany SM.nextInt smGen) sz , env (pure $ SM.mkSMGen $ fromIntegral seed) $ \smGen -> bench "split" $ whnf (genMany SM.splitSMGen smGen) sz ] , bgroup "pure" [ bgroup "random" [ pureBench random sz (Proxy :: Proxy Word8) , pureBench random sz (Proxy :: Proxy Word16) , pureBench random sz (Proxy :: Proxy Word32) , pureBench random sz (Proxy :: Proxy Word64) , pureBench random sz (Proxy :: Proxy Int8) , pureBench random sz (Proxy :: Proxy Int16) , pureBench random sz (Proxy :: Proxy Int32) , pureBench random sz (Proxy :: Proxy Int64) , pureBench random sz (Proxy :: Proxy Bool) , pureBench random sz (Proxy :: Proxy Char) , pureBench random sz (Proxy :: Proxy Float) , pureBench random sz (Proxy :: Proxy Double) , pureBench random sz (Proxy :: Proxy Integer) ] , bgroup "uniform" [ pureBench uniform sz (Proxy :: Proxy Word8) , pureBench uniform sz (Proxy :: Proxy Word16) , pureBench uniform sz (Proxy :: Proxy Word32) , pureBench uniform sz (Proxy :: Proxy Word64) , pureBench uniform sz (Proxy :: Proxy Int8) , pureBench uniform sz (Proxy :: Proxy Int16) , pureBench uniform sz (Proxy :: Proxy Int32) , pureBench uniform sz (Proxy :: Proxy Int64) , pureBench uniform sz (Proxy :: Proxy Bool) , pureBench uniform sz (Proxy :: Proxy Char) , pureBench uniform sz (Proxy :: Proxy CChar) , pureBench uniform sz (Proxy :: Proxy CSChar) , pureBench uniform sz (Proxy :: Proxy CUChar) , pureBench uniform sz (Proxy :: Proxy CShort) , pureBench uniform sz (Proxy :: Proxy CUShort) , pureBench uniform sz (Proxy :: Proxy CInt) , pureBench uniform sz (Proxy :: Proxy CUInt) , pureBench uniform sz (Proxy :: Proxy CLong) , pureBench uniform sz (Proxy :: Proxy CULong) , pureBench uniform sz (Proxy :: Proxy CPtrdiff) , pureBench uniform sz (Proxy :: Proxy CSize) , pureBench uniform sz (Proxy :: Proxy CWchar) , pureBench uniform sz (Proxy :: Proxy CSigAtomic) , pureBench uniform sz (Proxy :: Proxy CLLong) , pureBench uniform sz (Proxy :: Proxy CULLong) , pureBench uniform sz (Proxy :: Proxy CIntPtr) , pureBench uniform sz (Proxy :: Proxy CUIntPtr) , pureBench uniform sz (Proxy :: Proxy CIntMax) , pureBench uniform sz (Proxy :: Proxy CUIntMax) ] , bgroup "uniformR" [ bgroup "full" [ pureUniformRFullBench (Proxy :: Proxy Word8) sz , pureUniformRFullBench (Proxy :: Proxy Word16) sz , pureUniformRFullBench (Proxy :: Proxy Word32) sz , pureUniformRFullBench (Proxy :: Proxy Word64) sz , pureUniformRFullBench (Proxy :: Proxy Word) sz , pureUniformRFullBench (Proxy :: Proxy Int8) sz , pureUniformRFullBench (Proxy :: Proxy Int16) sz , pureUniformRFullBench (Proxy :: Proxy Int32) sz , pureUniformRFullBench (Proxy :: Proxy Int64) sz , pureUniformRFullBench (Proxy :: Proxy Int) sz , pureUniformRFullBench (Proxy :: Proxy Char) sz , pureUniformRFullBench (Proxy :: Proxy Bool) sz , pureUniformRFullBench (Proxy :: Proxy CChar) sz , pureUniformRFullBench (Proxy :: Proxy CSChar) sz , pureUniformRFullBench (Proxy :: Proxy CUChar) sz , pureUniformRFullBench (Proxy :: Proxy CShort) sz , pureUniformRFullBench (Proxy :: Proxy CUShort) sz , pureUniformRFullBench (Proxy :: Proxy CInt) sz , pureUniformRFullBench (Proxy :: Proxy CUInt) sz , pureUniformRFullBench (Proxy :: Proxy CLong) sz , pureUniformRFullBench (Proxy :: Proxy CULong) sz , pureUniformRFullBench (Proxy :: Proxy CPtrdiff) sz , pureUniformRFullBench (Proxy :: Proxy CSize) sz , pureUniformRFullBench (Proxy :: Proxy CWchar) sz , pureUniformRFullBench (Proxy :: Proxy CSigAtomic) sz , pureUniformRFullBench (Proxy :: Proxy CLLong) sz , pureUniformRFullBench (Proxy :: Proxy CULLong) sz , pureUniformRFullBench (Proxy :: Proxy CIntPtr) sz , pureUniformRFullBench (Proxy :: Proxy CUIntPtr) sz , pureUniformRFullBench (Proxy :: Proxy CIntMax) sz , pureUniformRFullBench (Proxy :: Proxy CUIntMax) sz ] , bgroup "excludeMax" [ pureUniformRExcludeMaxBench (Proxy :: Proxy Word8) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy Word16) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy Word32) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy Word64) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy Word) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy Int8) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy Int16) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy Int32) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy Int64) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy Int) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy Char) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy Bool) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy CChar) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy CSChar) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy CUChar) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy CShort) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy CUShort) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy CInt) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy CUInt) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy CLong) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy CULong) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy CPtrdiff) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy CSize) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy CWchar) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy CSigAtomic) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy CLLong) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy CULLong) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy CIntPtr) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy CUIntPtr) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy CIntMax) sz , pureUniformRExcludeMaxBench (Proxy :: Proxy CUIntMax) sz ] , bgroup "includeHalf" [ pureUniformRIncludeHalfBench (Proxy :: Proxy Word8) sz , pureUniformRIncludeHalfBench (Proxy :: Proxy Word16) sz , pureUniformRIncludeHalfBench (Proxy :: Proxy Word32) sz , pureUniformRIncludeHalfBench (Proxy :: Proxy Word64) sz , pureUniformRIncludeHalfBench (Proxy :: Proxy Word) sz , pureUniformRIncludeHalfBench (Proxy :: Proxy Int8) sz , pureUniformRIncludeHalfBench (Proxy :: Proxy Int16) sz , pureUniformRIncludeHalfBench (Proxy :: Proxy Int32) sz , pureUniformRIncludeHalfBench (Proxy :: Proxy Int64) sz , pureUniformRIncludeHalfBench (Proxy :: Proxy Int) sz , pureUniformRIncludeHalfEnumBench (Proxy :: Proxy Char) sz , pureUniformRIncludeHalfEnumBench (Proxy :: Proxy Bool) sz , pureUniformRIncludeHalfBench (Proxy :: Proxy CChar) sz , pureUniformRIncludeHalfBench (Proxy :: Proxy CSChar) sz , pureUniformRIncludeHalfBench (Proxy :: Proxy CUChar) sz , pureUniformRIncludeHalfBench (Proxy :: Proxy CShort) sz , pureUniformRIncludeHalfBench (Proxy :: Proxy CUShort) sz , pureUniformRIncludeHalfBench (Proxy :: Proxy CInt) sz , pureUniformRIncludeHalfBench (Proxy :: Proxy CUInt) sz , pureUniformRIncludeHalfBench (Proxy :: Proxy CLong) sz , pureUniformRIncludeHalfBench (Proxy :: Proxy CULong) sz , pureUniformRIncludeHalfBench (Proxy :: Proxy CPtrdiff) sz , pureUniformRIncludeHalfBench (Proxy :: Proxy CSize) sz , pureUniformRIncludeHalfBench (Proxy :: Proxy CWchar) sz , pureUniformRIncludeHalfBench (Proxy :: Proxy CSigAtomic) sz , pureUniformRIncludeHalfBench (Proxy :: Proxy CLLong) sz , pureUniformRIncludeHalfBench (Proxy :: Proxy CULLong) sz , pureUniformRIncludeHalfBench (Proxy :: Proxy CIntPtr) sz , pureUniformRIncludeHalfBench (Proxy :: Proxy CUIntPtr) sz , pureUniformRIncludeHalfBench (Proxy :: Proxy CIntMax) sz , pureUniformRIncludeHalfBench (Proxy :: Proxy CUIntMax) sz ] , bgroup "unbounded" [ pureUniformRBench (Proxy :: Proxy Float) (1.23e-4, 5.67e8) sz , pureUniformRBench (Proxy :: Proxy Double) (1.23e-4, 5.67e8) sz , let !i = (10 :: Integer) ^ (100 :: Integer) !range = (-i - 1, i + 1) in pureUniformRBench (Proxy :: Proxy Integer) range sz , let !n = (10 :: Natural) ^ (100 :: Natural) !range = (1, n - 1) in pureUniformRBench (Proxy :: Proxy Natural) range sz ] , bgroup "floating" [ bgroup "IO" [ env ((,) <$> getStdGen <*> newAlignedPinnedPrimArray sz) $ \ ~(gen, ma) -> bench "uniformFloat01M" $ nfIO (runStateGenT gen (fillMutablePrimArrayM uniformFloat01M ma)) , env ((,) <$> getStdGen <*> newAlignedPinnedPrimArray sz) $ \ ~(gen, ma) -> bench "uniformFloatPositive01M" $ nfIO (runStateGenT gen (fillMutablePrimArrayM uniformFloatPositive01M ma)) , env ((,) <$> getStdGen <*> newAlignedPinnedPrimArray sz) $ \ ~(gen, ma) -> bench "uniformDouble01M" $ nfIO (runStateGenT gen (fillMutablePrimArrayM uniformDouble01M ma)) , env ((,) <$> getStdGen <*> newAlignedPinnedPrimArray sz) $ \ ~(gen, ma) -> bench "uniformDoublePositive01M" $ nfIO (runStateGenT gen (fillMutablePrimArrayM uniformDoublePositive01M ma)) ] , bgroup "State" [ env getStdGen $ bench "uniformFloat01M" . nf (`runStateGen` (replicateM_ sz . uniformFloat01M)) , env getStdGen $ bench "uniformFloatPositive01M" . nf (`runStateGen` (replicateM_ sz . uniformFloatPositive01M)) , env getStdGen $ bench "uniformDouble01M" . nf (`runStateGen` (replicateM_ sz . uniformDouble01M)) , env getStdGen $ bench "uniformDoublePositive01M" . nf (`runStateGen` (replicateM_ sz . uniformDoublePositive01M)) ] , bgroup "pure" [ env getStdGen $ \gen -> bench "uniformFloat01M" $ nf (genMany (runState $ uniformFloat01M (StateGenM :: StateGenM StdGen)) gen) sz , env getStdGen $ \gen -> bench "uniformFloatPositive01M" $ nf (genMany (runState $ uniformFloatPositive01M (StateGenM :: StateGenM StdGen)) gen) sz , env getStdGen $ \gen -> bench "uniformDouble01M" $ nf (genMany (runState $ uniformDouble01M (StateGenM :: StateGenM StdGen)) gen) sz , env getStdGen $ \gen -> bench "uniformDoublePositive01M" $ nf (genMany (runState $ uniformDoublePositive01M (StateGenM :: StateGenM StdGen)) gen) sz ] ] , bgroup "ShortByteString" [ env (pure genLengths) $ \ ~(ns, gen) -> bench "genShortByteString" $ nfIO $ runStateGenT gen $ \g -> mapM (`uniformShortByteString` g) ns ] ] ] ] pureUniformRFullBench :: forall a. (Typeable a, UniformRange a, Bounded a) => Proxy a -> Int -> Benchmark pureUniformRFullBench px = let range = (minBound :: a, maxBound :: a) in pureUniformRBench px range {-# INLINE pureUniformRFullBench #-} pureUniformRExcludeMaxBench :: forall a. (Typeable a, UniformRange a, Bounded a, Enum a) => Proxy a -> Int -> Benchmark pureUniformRExcludeMaxBench px = let range = (minBound :: a, pred (maxBound :: a)) in pureUniformRBench px range {-# INLINE pureUniformRExcludeMaxBench #-} pureUniformRIncludeHalfBench :: forall a. (Typeable a, UniformRange a, Bounded a, Integral a) => Proxy a -> Int -> Benchmark pureUniformRIncludeHalfBench px = let range = ((minBound :: a) + 1, ((maxBound :: a) `div` 2) + 1) in pureUniformRBench px range {-# INLINE pureUniformRIncludeHalfBench #-} pureUniformRIncludeHalfEnumBench :: forall a. (Typeable a, UniformRange a, Bounded a, Enum a) => Proxy a -> Int -> Benchmark pureUniformRIncludeHalfEnumBench px = let range = (succ (minBound :: a), toEnum ((fromEnum (maxBound :: a) `div` 2) + 1)) in pureUniformRBench px range {-# INLINE pureUniformRIncludeHalfEnumBench #-} pureUniformRBench :: forall a. (Typeable a, UniformRange a) => Proxy a -> (a, a) -> Int -> Benchmark pureUniformRBench px range@(!_, !_) sz = pureBench (uniformR range) sz px {-# INLINE pureUniformRBench #-} pureBench :: forall a. Typeable a => (StdGen -> (a, StdGen)) -> Int -> Proxy a -> Benchmark pureBench f sz px = env getStdGen $ \gen -> bench (showsTypeRep (typeRep px) "") $ whnf (genMany f gen) sz {-# INLINE pureBench #-} genMany :: (g -> (a, g)) -> g -> Int -> a genMany f g0 n = go 0 $ f g0 where go i (!y, !g) | i < n = go (i + 1) $ f g | otherwise = y fillMutablePrimArrayM :: (Prim a, PrimMonad m) => (gen -> m a) -> MutablePrimArray (PrimState m) a -> gen -> m (PrimArray a) fillMutablePrimArrayM f ma g = do n <- getSizeofMutablePrimArray ma let go i | i < n = f g >>= writePrimArray ma i >> go (i + 1) | otherwise = pure () go 0 unsafeFreezePrimArray ma random-1.2.1.1/bench-legacy/SimpleRNGBench.hs0000644000000000000000000002340614121726764016754 0ustar0000000000000000{-# LANGUAGE BangPatterns, ScopedTypeVariables, ForeignFunctionInterface #-} {-# OPTIONS_GHC -fwarn-unused-imports #-} -- | A simple script to do some very basic timing of the RNGs. module Main where import System.Exit (exitSuccess, exitFailure) import System.Environment import System.Random import System.CPUTime (getCPUTime) import System.CPUTime.Rdtsc import System.Console.GetOpt import GHC.Conc import Control.Concurrent import Control.Monad import Control.Exception import Data.IORef import Data.Word import Data.List hiding (last,sum) import Data.Int import Data.List.Split hiding (split) import Text.Printf import Foreign.Ptr import Foreign.C.Types import Foreign.ForeignPtr import Foreign.Storable (peek,poke) import Prelude hiding (last,sum) import BinSearch ---------------------------------------------------------------------------------------------------- -- Miscellaneous helpers: -- Readable large integer printing: commaint :: Show a => a -> String commaint n = reverse $ concat $ intersperse "," $ chunk 3 $ reverse (show n) padleft :: Int -> String -> String padleft n str | length str >= n = str padleft n str | otherwise = take (n - length str) (repeat ' ') ++ str padright :: Int -> String -> String padright n str | length str >= n = str padright n str | otherwise = str ++ take (n - length str) (repeat ' ') fmt_num :: (RealFrac a, PrintfArg a) => a -> String fmt_num n = if n < 100 then printf "%.2f" n else commaint (round n :: Integer) -- Measure clock frequency, spinning rather than sleeping to try to -- stay on the same core. measureFreq :: IO Int64 measureFreq = do let second = 1000 * 1000 * 1000 * 1000 -- picoseconds are annoying t1 <- rdtsc start <- getCPUTime let loop !n !last = do t2 <- rdtsc when (t2 < last) $ putStrLn $ "COUNTERS WRAPPED " ++ show (last, t2) cput <- getCPUTime if cput - start < second then loop (n + 1) t2 else return (n, t2) (n, t2) <- loop 0 t1 putStrLn $ " Approx getCPUTime calls per second: " ++ commaint (n :: Int64) when (t2 < t1) $ putStrLn $ "WARNING: rdtsc not monotonically increasing, first " ++ show t1 ++ " then " ++ show t2 ++ " on the same OS thread" return $ fromIntegral (t2 - t1) ---------------------------------------------------------------------------------------------------- -- Test overheads without actually generating any random numbers: data NoopRNG = NoopRNG instance RandomGen NoopRNG where next g = (0, g) genRange _ = (0, 0) split g = (g, g) -- An RNG generating only 0 or 1: data BinRNG = BinRNG StdGen instance RandomGen BinRNG where next (BinRNG g) = (x `mod` 2, BinRNG g') where (x, g') = next g genRange _ = (0, 1) split (BinRNG g) = (BinRNG g1, BinRNG g2) where (g1, g2) = split g ---------------------------------------------------------------------------------------------------- -- Drivers to get random numbers repeatedly. type Kern = Int -> Ptr Int -> IO () -- [2011.01.28] Changing this to take "count" and "accumulator ptr" as arguments: -- foreign import ccall "cbits/c_test.c" blast_rands :: Kern -- foreign import ccall "cbits/c_test.c" store_loop :: Kern -- foreign import ccall unsafe "stdlib.hs" rand :: IO Int {-# INLINE timeit #-} timeit :: (Random a, RandomGen g) => Int -> Int64 -> String -> g -> (g -> (a,g)) -> IO () timeit numthreads freq msg gen nxt = do counters <- forM [1 .. numthreads] (const $ newIORef (1 :: Int64)) tids <- forM counters $ \counter -> forkIO $ infloop counter (nxt gen) threadDelay (1000 * 1000) -- One second mapM_ killThread tids finals <- mapM readIORef counters let mean :: Double = fromIntegral (foldl1 (+) finals) / fromIntegral numthreads cycles_per :: Double = fromIntegral freq / mean printResult (round mean :: Int64) msg cycles_per where infloop !counter (!_, !g) = do incr counter infloop counter (nxt g) incr !counter -- modifyIORef counter (+1) -- Not strict enough! = do c <- readIORef counter let c' = c + 1 _ <- evaluate c' writeIORef counter c' -- This function times an IO function on one or more threads. Rather -- than running a fixed number of iterations, it uses a binary search -- to find out how many iterations can be completed in a second. timeit_foreign :: Int -> Int64 -> String -> (Int -> Ptr Int -> IO ()) -> IO Int64 timeit_foreign numthreads freq msg ffn = do ptr :: ForeignPtr Int <- mallocForeignPtr let kern = if numthreads == 1 then ffn else replicate_kernel numthreads ffn wrapped n = withForeignPtr ptr (kern $ fromIntegral n) (n, t) <- binSearch False 1 (1.0, 1.05) wrapped let total_per_second = round $ fromIntegral n * (1 / t) cycles_per = fromIntegral freq * t / fromIntegral n printResult total_per_second msg cycles_per return total_per_second -- This lifts a C kernel to operate simultaneously on N threads. where replicate_kernel :: Int -> Kern -> Kern replicate_kernel nthreads kern n ptr = do ptrs <- forM [1 .. nthreads] (const mallocForeignPtr) tmpchan <- newChan -- let childwork = ceiling$ fromIntegral n / fromIntegral nthreads let childwork = n -- Keep it the same.. interested in per-thread throughput. -- Fork/join pattern: forM_ ptrs $ \pt -> forkIO $ withForeignPtr pt $ \p -> do kern (fromIntegral childwork) p result <- peek p writeChan tmpchan result results <- forM [1 .. nthreads] $ \_ -> readChan tmpchan -- Meaningless semantics here... sum the child ptrs and write to the input one: poke ptr (foldl1 (+) results) printResult :: Int64 -> String -> Double -> IO () printResult total msg cycles_per = putStrLn $ " " ++ padleft 11 (commaint total) ++ " randoms generated " ++ padright 27 ("[" ++ msg ++ "]") ++ " ~ " ++ fmt_num cycles_per ++ " cycles/int" ---------------------------------------------------------------------------------------------------- -- Main Script data Flag = NoC | Help deriving (Show, Eq) options :: [OptDescr Flag] options = [ Option ['h'] ["help"] (NoArg Help) "print program help" , Option [] ["noC"] (NoArg NoC) "omit C benchmarks, haskell only" ] main :: IO () main = do argv <- getArgs let (opts,_,other) = getOpt Permute options argv unless (null other) $ do putStrLn "ERROR: Unrecognized options: " mapM_ putStr other exitFailure when (Help `elem` opts) $ do putStr $ usageInfo "Benchmark random number generation" options exitSuccess putStrLn "\nHow many random numbers can we generate in a second on one thread?" t1 <- rdtsc t2 <- rdtsc putStrLn (" Cost of rdtsc (ffi call): " ++ show (t2 - t1)) freq <- measureFreq putStrLn $ " Approx clock frequency: " ++ commaint freq let randInt = random :: RandomGen g => g -> (Int,g) randWord16 = random :: RandomGen g => g -> (Word16,g) randFloat = random :: RandomGen g => g -> (Float,g) randCFloat = random :: RandomGen g => g -> (CFloat,g) randDouble = random :: RandomGen g => g -> (Double,g) randCDouble = random :: RandomGen g => g -> (CDouble,g) randInteger = random :: RandomGen g => g -> (Integer,g) randBool = random :: RandomGen g => g -> (Bool,g) randChar = random :: RandomGen g => g -> (Char,g) gen = mkStdGen 238523586 gamut th = do putStrLn " First, timing System.Random.next:" timeit th freq "constant zero gen" NoopRNG next timeit th freq "System.Random stdGen/next" gen next putStrLn "\n Second, timing System.Random.random at different types:" timeit th freq "System.Random Ints" gen randInt timeit th freq "System.Random Word16" gen randWord16 timeit th freq "System.Random Floats" gen randFloat timeit th freq "System.Random CFloats" gen randCFloat timeit th freq "System.Random Doubles" gen randDouble timeit th freq "System.Random CDoubles" gen randCDouble timeit th freq "System.Random Integers" gen randInteger timeit th freq "System.Random Bools" gen randBool timeit th freq "System.Random Chars" gen randChar putStrLn "\n Next timing range-restricted System.Random.randomR:" timeit th freq "System.Random Ints" gen (randomR (-100, 100::Int)) timeit th freq "System.Random Word16s" gen (randomR ( 100, 300::Word16)) timeit th freq "System.Random Floats" gen (randomR (-100, 100::Float)) timeit th freq "System.Random CFloats" gen (randomR (-100, 100::CFloat)) timeit th freq "System.Random Doubles" gen (randomR (-100, 100::Double)) timeit th freq "System.Random CDoubles" gen (randomR (-100, 100::CDouble)) timeit th freq "System.Random Integers" gen (randomR (-100, 100::Integer)) timeit th freq "System.Random Bools" gen (randomR (False, True::Bool)) timeit th freq "System.Random Chars" gen (randomR ('a', 'z')) timeit th freq "System.Random BIG Integers" gen (randomR (0, (2::Integer) ^ (5000::Int))) -- when (not$ NoC `elem` opts) $ do -- putStrLn$ " Comparison to C's rand():" -- timeit_foreign th freq "ptr store in C loop" store_loop -- timeit_foreign th freq "rand/store in C loop" blast_rands -- timeit_foreign th freq "rand in Haskell loop" (\n ptr -> forM_ [1..n]$ \_ -> rand ) -- timeit_foreign th freq "rand/store in Haskell loop" (\n ptr -> forM_ [1..n]$ \_ -> do n <- rand; poke ptr n ) -- return () -- Test with 1 thread and numCapabilities threads: gamut 1 when (numCapabilities > 1) $ do putStrLn $ "\nNow "++ show numCapabilities ++" threads, reporting mean randoms-per-second-per-thread:" void $ gamut numCapabilities putStrLn "Finished." random-1.2.1.1/bench-legacy/BinSearch.hs0000644000000000000000000001320013674377445016053 0ustar0000000000000000 {- Binary search over benchmark input sizes. There are many good ways to measure the time it takes to perform a certain computation on a certain input. However, frequently, it's challenging to pick the right input size for all platforms and all compilataion modes. Sometimes for linear-complexity benchmarks it is better to measure /throughput/, i.e. elements processed per second. That is, fixing the time of execution and measuring the amount of work done (rather than the reverse). This library provides a simple way to search for an appropriate input size that results in the desired execution time. An alternative approach is to kill the computation after a certain amount of time and observe how much work it has completed. -} module BinSearch ( binSearch ) where import Control.Monad import Data.Time.Clock -- Not in 6.10 import Data.List import System.IO import Prelude hiding (min,max,log) -- | Binary search for the number of inputs to a computation that -- results in a specified amount of execution time in seconds. For example: -- -- > binSearch verbose N (min,max) kernel -- -- ... will find the right input size that results in a time -- between min and max, then it will then run for N trials and -- return the median (input,time-in-seconds) pair. binSearch :: Bool -> Integer -> (Double,Double) -> (Integer -> IO ()) -> IO (Integer, Double) binSearch verbose trials (min, max) kernel = do when verbose $ putStrLn $ "[binsearch] Binary search for input size resulting in time in range " ++ show (min, max) let desired_exec_length = 1.0 good_trial t = (toRational t <= toRational max) && (toRational t >= toRational min) -- At some point we must give up... loop n | n > ((2 :: Integer) ^ (100 :: Integer)) = error "ERROR binSearch: This function doesn't seem to scale in proportion to its last argument." -- Not allowed to have "0" size input, bump it back to one: loop 0 = loop 1 loop n = do when verbose $ putStr $ "[binsearch:" ++ show n ++ "] " time <- timeit $ kernel n when verbose $ putStrLn $ "Time consumed: " ++ show time let rate = fromIntegral n / time -- [2010.06.09] Introducing a small fudge factor to help our guess get over the line: let initial_fudge_factor = 1.10 fudge_factor = 1.01 -- Even in the steady state we fudge a little guess = desired_exec_length * rate -- TODO: We should keep more history here so that we don't re-explore input space we -- have already explored. This is a balancing act because of randomness in -- execution time. if good_trial time then do when verbose $ putStrLn "[binsearch] Time in range. LOCKING input size and performing remaining trials." print_trial 1 n time lockin (trials - 1) n [time] else if time < 0.100 then loop (2 * n) else do when verbose $ putStrLn $ "[binsearch] Estimated rate to be " ++ show (round rate :: Integer) ++ " per second. Trying to scale up..." -- Here we've exited the doubling phase, but we're making our -- first guess as to how big a real execution should be: if time > 0.100 && time < 0.33 * desired_exec_length then do when verbose $ putStrLn "[binsearch] (Fudging first guess a little bit extra)" loop (round $ guess * initial_fudge_factor) else loop (round $ guess * fudge_factor) -- Termination condition: Done with all trials. lockin 0 n log = do when verbose $ putStrLn $ "[binsearch] Time-per-unit for all trials: " ++ concat (intersperse " " (map (show . (/ toDouble n) . toDouble) $ sort log)) return (n, log !! (length log `quot` 2)) -- Take the median lockin trials_left n log = do when verbose $ putStrLn "[binsearch]------------------------------------------------------------" time <- timeit $ kernel n -- hFlush stdout print_trial (trials - trials_left + 1) n time -- whenverbose$ hFlush stdout lockin (trials_left - 1) n (time : log) print_trial :: Integer -> Integer -> NominalDiffTime -> IO () print_trial trialnum n time = let rate = fromIntegral n / time timeperunit = time / fromIntegral n in when verbose $ putStrLn $ "[binsearch] TRIAL: " ++ show trialnum ++ " secPerUnit: " ++ showTime timeperunit ++ " ratePerSec: " ++ show rate ++ " seconds: " ++ showTime time (n, t) <- loop 1 return (n, fromRational $ toRational t) showTime :: NominalDiffTime -> String showTime t = show ((fromRational $ toRational t) :: Double) toDouble :: Real a => a -> Double toDouble = fromRational . toRational -- Could use cycle counters here.... but the point of this is to time -- things on the order of a second. timeit :: IO () -> IO NominalDiffTime timeit io = do strt <- getCurrentTime io end <- getCurrentTime return (diffUTCTime end strt) {- test :: IO (Integer,Double) test = binSearch True 3 (1.0, 1.05) (\n -> do v <- newIORef 0 forM_ [1..n] $ \i -> do old <- readIORef v writeIORef v (old+i)) -} random-1.2.1.1/LICENSE0000644000000000000000000000556613674377441012361 0ustar0000000000000000This library (libraries/base) is derived from code from two sources: * Code from the GHC project which is largely (c) The University of Glasgow, and distributable under a BSD-style license (see below), * Code from the Haskell 98 Report which is (c) Simon Peyton Jones and freely redistributable (but see the full license for restrictions). The full text of these licenses is reproduced below. Both of the licenses are BSD-style or compatible. ----------------------------------------------------------------------------- The Glasgow Haskell Compiler License Copyright 2004, The University Court of the University of Glasgow. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ----------------------------------------------------------------------------- Code derived from the document "Report on the Programming Language Haskell 98", is distributed under the following license: Copyright (c) 2002 Simon Peyton Jones The authors intend this Report to belong to the entire Haskell community, and so we grant permission to copy and distribute it for any purpose, provided that it is reproduced in its entirety, including this Notice. Modified versions of this Report may also be copied and distributed for any purpose, provided that the modified version is clearly presented as such, and that it does not claim to be a definition of the Haskell 98 Language. ----------------------------------------------------------------------------- random-1.2.1.1/Setup.hs0000644000000000000000000000007513674377445013002 0ustar0000000000000000import Distribution.Simple main :: IO () main = defaultMain random-1.2.1.1/random.cabal0000644000000000000000000001461514236070300013566 0ustar0000000000000000cabal-version: >=1.10 name: random version: 1.2.1.1 license: BSD3 license-file: LICENSE maintainer: core-libraries-committee@haskell.org bug-reports: https://github.com/haskell/random/issues synopsis: Pseudo-random number generation description: This package provides basic pseudo-random number generation, including the ability to split random number generators. . == "System.Random": pure pseudo-random number interface . In pure code, use 'System.Random.uniform' and 'System.Random.uniformR' from "System.Random" to generate pseudo-random numbers with a pure pseudo-random number generator like 'System.Random.StdGen'. . As an example, here is how you can simulate rolls of a six-sided die using 'System.Random.uniformR': . >>> let roll = uniformR (1, 6) :: RandomGen g => g -> (Word, g) >>> let rolls = unfoldr (Just . roll) :: RandomGen g => g -> [Word] >>> let pureGen = mkStdGen 42 >>> take 10 (rolls pureGen) :: [Word] [1,1,3,2,4,5,3,4,6,2] . See "System.Random" for more details. . == "System.Random.Stateful": monadic pseudo-random number interface . In monadic code, use 'System.Random.Stateful.uniformM' and 'System.Random.Stateful.uniformRM' from "System.Random.Stateful" to generate pseudo-random numbers with a monadic pseudo-random number generator, or using a monadic adapter. . As an example, here is how you can simulate rolls of a six-sided die using 'System.Random.Stateful.uniformRM': . >>> let rollM = uniformRM (1, 6) :: StatefulGen g m => g -> m Word >>> let pureGen = mkStdGen 42 >>> runStateGen_ pureGen (replicateM 10 . rollM) :: [Word] [1,1,3,2,4,5,3,4,6,2] . The monadic adapter 'System.Random.Stateful.runStateGen_' is used here to lift the pure pseudo-random number generator @pureGen@ into the 'System.Random.Stateful.StatefulGen' context. . The monadic interface can also be used with existing monadic pseudo-random number generators. In this example, we use the one provided in the package: . >>> import System.Random.MWC as MWC >>> let rollM = uniformRM (1, 6) :: StatefulGen g m => g -> m Word >>> monadicGen <- MWC.create >>> replicateM 10 (rollM monadicGen) :: IO [Word] [2,3,6,6,4,4,3,1,5,4] . See "System.Random.Stateful" for more details. category: System build-type: Simple extra-source-files: README.md CHANGELOG.md tested-with: GHC == 7.10.2 , GHC == 7.10.3 , GHC == 8.0.2 , GHC == 8.2.2 , GHC == 8.4.3 , GHC == 8.4.4 , GHC == 8.6.3 , GHC == 8.6.4 , GHC == 8.6.5 , GHC == 8.8.1 , GHC == 8.8.2 , GHC == 8.10.1 source-repository head type: git location: https://github.com/haskell/random.git library exposed-modules: System.Random System.Random.Internal System.Random.Stateful other-modules: System.Random.GFinite hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall if impl(ghc >= 8.0) ghc-options: -Wincomplete-record-updates -Wincomplete-uni-patterns build-depends: base >=4.8 && <5, bytestring >=0.10.4 && <0.12, deepseq >=1.1 && <2, mtl >=2.2 && <2.4, splitmix >=0.1 && <0.2 if impl(ghc < 8.0) build-depends: transformers test-suite legacy-test type: exitcode-stdio-1.0 main-is: Legacy.hs hs-source-dirs: test-legacy other-modules: T7936 TestRandomIOs TestRandomRs Random1283 RangeTest default-language: Haskell2010 ghc-options: -with-rtsopts=-M8M if impl(ghc >= 8.0) ghc-options: -Wno-deprecations build-depends: base, containers >=0.5 && <0.7, random test-suite doctests type: exitcode-stdio-1.0 main-is: doctests.hs hs-source-dirs: test default-language: Haskell2010 build-depends: base, doctest >=0.15 && <0.21 if impl(ghc >= 8.2) && impl(ghc < 8.10) build-depends: mwc-random >=0.13 && <0.16, primitive >=0.6 && <0.8, random, stm, unliftio >=0.2 && <0.3, vector >= 0.10 && <0.14 test-suite spec type: exitcode-stdio-1.0 main-is: Spec.hs hs-source-dirs: test other-modules: Spec.Range Spec.Run Spec.Stateful default-language: Haskell2010 ghc-options: -Wall build-depends: base, bytestring, random, smallcheck >=1.2 && <1.3, stm, tasty >=1.0 && <1.5, tasty-smallcheck >=0.8 && <0.9, tasty-hunit >=0.10 && <0.11, transformers -- Note. Fails when compiled with coverage: -- https://github.com/haskell/random/issues/107 test-suite spec-inspection type: exitcode-stdio-1.0 main-is: Spec.hs hs-source-dirs: test-inspection build-depends: default-language: Haskell2010 ghc-options: -Wall build-depends: base, random, tasty >=1.0 && <1.5 if impl(ghc >= 8.0) build-depends: tasty-inspection-testing other-modules: Spec.Inspection benchmark legacy-bench type: exitcode-stdio-1.0 main-is: SimpleRNGBench.hs hs-source-dirs: bench-legacy other-modules: BinSearch default-language: Haskell2010 ghc-options: -Wall -O2 -threaded -rtsopts -with-rtsopts=-N if impl(ghc >= 8.0) ghc-options: -Wno-deprecations build-depends: base, random, rdtsc, split >=0.2 && <0.3, time >=1.4 && <1.13 benchmark bench type: exitcode-stdio-1.0 main-is: Main.hs hs-source-dirs: bench default-language: Haskell2010 ghc-options: -Wall -O2 build-depends: base, mtl, primitive >= 0.7.1, random, splitmix >=0.1 && <0.2, tasty-bench random-1.2.1.1/README.md0000644000000000000000000000354314121726764012616 0ustar0000000000000000# The Haskell Standard Library ## Random Number Generation ### Status | Language | Github Actions | Drone.io | Coveralls | |:--------:|:--------------:|:--------:|:---------:| | ![GitHub top language](https://img.shields.io/github/languages/top/haskell/random.svg) | [![Build Status](https://github.com/haskell/random/workflows/random-CI/badge.svg)](https://github.com/haskell/random/actions) | [![Build Status](https://cloud.drone.io/api/badges/haskell/random/status.svg?ref=refs/heads/master)](https://cloud.drone.io/haskell/random/) | [![Coverage Status](https://coveralls.io/repos/github/haskell/random/badge.svg?branch=master)](https://coveralls.io/github/haskell/random?branch=master) | Github Repo | Hackage | Nightly | LTS | |:-------------------|:-------:|:-------:|:---:| | [`random`](https://github.com/haskell/random)| [![Hackage](https://img.shields.io/hackage/v/random.svg)](https://hackage.haskell.org/package/random)| [![Nightly](https://www.stackage.org/package/random/badge/nightly)](https://www.stackage.org/nightly/package/random)| [![LTS](https://www.stackage.org/package/random/badge/lts)](https://www.stackage.org/lts/package/random) ### Description This library provides a basic interface for (splittable) pseudo-random number generators. The API documentation can be found here: > http://hackage.haskell.org/package/random/docs/System-Random.html An [older version][haskell98-version] of this library is included with GHC in the `haskell98` package. This newer version is included in the [Haskell Platform][haskell-platform]. Please report bugs in the [GitHub issue tracker][issue-tracker] (no longer in the GHC trac). [haskell-platform]: http://www.haskell.org/platform/contents.html [haskell98-version]: https://downloads.haskell.org/~ghc/7.6.3/docs/html/libraries/haskell98/Random.html [issue-tracker]: https://github.com/haskell/random/issues random-1.2.1.1/CHANGELOG.md0000644000000000000000000001370314235761771013152 0ustar0000000000000000# 1.2.1 * Fix support for ghc-9.2 [#99](https://github.com/haskell/random/pull/99) * Fix performance regression for ghc-9.0 [#101](https://github.com/haskell/random/pull/101) * Add `uniformEnumM` and `uniformEnumRM` * Add `initStdGen` [#103](https://github.com/haskell/random/pull/103) * Add `globalStdGen` [#117](https://github.com/haskell/random/pull/117) * Add `runStateGenST_` * Ensure that default implementation of `ShortByteString` generation uses unpinned memory. [#116](https://github.com/haskell/random/pull/116) * Fix [#54](https://github.com/haskell/random/issues/54) with [#68](https://github.com/haskell/random/pull/68) - if exactly one value in the range of floating point is infinite, then `uniformRM`/`randomR` returns that value. * Add default implementation of `uniformM` that uses `Generic` [#70](https://github.com/haskell/random/pull/70) * `Random` instance for `CBool` [#77](https://github.com/haskell/random/pull/77) * Addition of `TGen` and `TGenM` [#95](https://github.com/haskell/random/pull/95) * Addition of tuple instances for `Random` up to 7-tuple [#72](https://github.com/haskell/random/pull/72) # 1.2.0 1. Breaking change which mostly maintains backwards compatibility, see "Breaking Changes" below. 2. Support for monadic generators e.g. [mwc-random](https://hackage.haskell.org/package/mwc-random). 3. Monadic adapters for pure generators (providing a uniform monadic interface to pure and monadic generators). 4. Faster in all cases except one by more than x18 (N.B. x18 not 18%) and some cases (depending on the type) faster by more than x1000 - see below for benchmarks. 5. Passes a large number of random number test suites: * [dieharder](http://webhome.phy.duke.edu/~rgb/General/dieharder.php "venerable") * [TestU01 (SmallCrush, Crush, BigCrush)](http://simul.iro.umontreal.ca/testu01/tu01.html "venerable") * [PractRand](http://pracrand.sourceforge.net/ "active") * [gjrand](http://gjrand.sourceforge.net/ "active") * See [random-quality](https://github.com/tweag/random-quality) for details on how to do this yourself. 6. Better quality split as judged by these [tests](https://www.cambridge.org/core/journals/journal-of-functional-programming/article/evaluation-of-splittable-pseudorandom-generators/3EBAA9F14939C5BB5560E32D1A132637). Again see [random-quality](https://github.com/tweag/random-quality) for details on how to do this yourself. 7. Unbiased generation of ranges. 8. Updated tests and benchmarks. 9. [Continuous integration](https://travis-ci.org/github/haskell/random). ### Breaking Changes Version 1.2.0 introduces these breaking changes: * requires `base >= 4.8` (GHC-7.10) * `StdGen` is no longer an instance of `Read` * `randomIO` and `randomRIO` were extracted from the `Random` class into separate functions In addition, there may be import clashes with new functions, e.g. `uniform` and `uniformR`. ### Deprecations Version 1.2.0 introduces `genWord64`, `genWord32` and similar methods to the `RandomGen` class. The significantly slower method `next` and its companion `genRange` are now deprecated. ### Issues Addressed Issue Number | Description | Comment --------------|-------------|-------- [25](https://github.com/haskell/random/issues/25) | The seeds generated by split are not independent | Fixed: changed algorithm to SplitMix, which provides a robust split operation [26](https://github.com/haskell/random/issues/26) | Add Random instances for tuples | Addressed: added `Uniform` instances for up to 6-tuples [44](https://github.com/haskell/random/issues/44) | Add Random instance for Natural | Addressed: added UniformRange instance for Natural [51](https://github.com/haskell/random/issues/51) | Very low throughput | Fixed: see benchmarks below [53](https://github.com/haskell/random/issues/53) | incorrect distribution of randomR for floating-point numbers | (\*) [55](https://github.com/haskell/random/issues/55) | System/Random.hs:43:1: warning: [-Wtabs] | Fixed: No more tabs [58](https://github.com/haskell/random/issues/58) | Why does random for Float and Double produce exactly 24 or 53 bits? | (\*) [59](https://github.com/haskell/random/issues/59) | read :: StdGen fails for strings longer than 6 | Addressed: StdGen is no longer an instance of Read #### Comments (\*) 1.2 samples more bits but does not sample every `Float` or `Double`. There are methods to do this but they have some downsides; see [here](https://github.com/idontgetoutmuch/random/issues/105) for a fuller discussion. ## Benchmarks Here are some benchmarks run on a 3.1 GHz Intel Core i7. The full benchmarks can be run using e.g. `stack bench`. The benchmarks are measured in milliseconds per 100,000 generations. In some cases, the performance is over x1000 times better; the minimum performance increase for the types listed below is more than x36. Name | 1.1 Mean | 1.2 Mean ------------|----------|---------- Float | 27.819 | 0.305 Double | 50.644 | 0.328 Integer | 42.332 | 0.332 Word | 40.739 | 0.027 Int | 43.847 | 0.028 Char | 17.009 | 0.462 Bool | 17.542 | 0.027 # 1.1 * breaking change to `randomIValInteger` to improve RNG quality and performance see https://github.com/haskell/random/pull/4 and ghc https://ghc.haskell.org/trac/ghc/ticket/8898 * correct documentation about generated range of Int32 sized values of type Int https://github.com/haskell/random/pull/7 * fix memory leaks by using strict fields and strict atomicModifyIORef' https://github.com/haskell/random/pull/8 related to ghc trac tickets #7936 and #4218 * support for base < 4.6 (which doesnt provide strict atomicModifyIORef') and integrating Travis CI support. https://github.com/haskell/random/pull/12 * fix C type in test suite https://github.com/haskell/random/pull/9 # 1.0.1.1 bump for overflow bug fixes # 1.0.1.2 bump for ticket 8704, build fusion # 1.0.1.0 bump for bug fixes, # 1.0.0.4 bumped version for float/double range bugfix