{-# 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  :  [email protected]
-- 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
g = forall g a.
RandomGen g =>
g -> (StateGenM g -> State g a) -> (a, g)
runStateGen g
g (forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (forall g. RandomGen g => g -> (Int, Int)
genRange g
g))

  -- | Returns a 'Word8' that is uniformly distributed over the entire 'Word8'
  -- range.
  --
  -- @since 1.2.0
  genWord8 :: g -> (Word8, g)
  genWord8 = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g. RandomGen g => g -> (Word32, g)
genWord32
  {-# INLINE genWord8 #-}

  -- | Returns a 'Word16' that is uniformly distributed over the entire 'Word16'
  -- range.
  --
  -- @since 1.2.0
  genWord16 :: g -> (Word16, g)
  genWord16 = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g. RandomGen g => g -> (Word32, g)
genWord32
  {-# INLINE genWord16 #-}

  -- | Returns a 'Word32' that is uniformly distributed over the entire 'Word32'
  -- range.
  --
  -- @since 1.2.0
  genWord32 :: g -> (Word32, g)
  genWord32 = forall g a. (RandomGen g, Integral a) => (a, a) -> g -> (a, g)
randomIvalIntegral (forall a. Bounded a => a
minBound, forall a. Bounded a => a
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
g =
    case forall g. RandomGen g => g -> (Word32, g)
genWord32 g
g of
      (Word32
l32, g
g') ->
        case forall g. RandomGen g => g -> (Word32, g)
genWord32 g
g' of
          (Word32
h32, g
g'') ->
            ((forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
h32 forall a. Bits a => a -> Int -> a
`shiftL` Int
32) forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
l32, g
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 Word32
m g
g = forall g a.
RandomGen g =>
g -> (StateGenM g -> State g a) -> (a, g)
runStateGen g
g (forall g (m :: * -> *). StatefulGen g m => Word32 -> g -> m Word32
unbiasedWordMult32 Word32
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 Word64
m g
g = forall g a.
RandomGen g =>
g -> (StateGenM g -> State g a) -> (a, g)
runStateGen g
g (forall a g (m :: * -> *).
(Ord a, FiniteBits a, Num a, StatefulGen g m) =>
(g -> m a) -> a -> g -> m a
unsignedBitmaskWithRejectionM forall g (m :: * -> *). StatefulGen g m => g -> m Word64
uniformWord64 Word64
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 Int
n g
g =
    forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall g (m :: * -> *) a.
RandomGen g =>
g -> (StateGenM g -> StateT g m a) -> m (a, g)
runStateGenT g
g (forall (m :: * -> *).
MonadIO m =>
Int -> m Word64 -> m ShortByteString
genShortByteStringIO Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (m :: * -> *). StatefulGen g m => g -> m Word64
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 g
_ = (forall a. Bounded a => a
minBound, forall a. Bounded a => a
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 = forall a g (m :: * -> *).
(Ord a, FiniteBits a, Num a, StatefulGen g m) =>
(g -> m a) -> a -> g -> m a
unsignedBitmaskWithRejectionM forall g (m :: * -> *). StatefulGen g m => g -> m Word32
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 = forall a g (m :: * -> *).
(Ord a, FiniteBits a, Num a, StatefulGen g m) =>
(g -> m a) -> a -> g -> m a
unsignedBitmaskWithRejectionM forall g (m :: * -> *). StatefulGen g m => g -> m Word64
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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (m :: * -> *). StatefulGen g m => g -> m Word32
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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (m :: * -> *). StatefulGen g m => g -> m Word32
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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (m :: * -> *). StatefulGen g m => g -> m Word64
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
g = do
    Word32
l32 <- forall g (m :: * -> *). StatefulGen g m => g -> m Word32
uniformWord32 g
g
    Word32
h32 <- forall g (m :: * -> *). StatefulGen g m => g -> m Word32
uniformWord32 g
g
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
h32) Int
32 forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
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 Int
n = forall (m :: * -> *).
MonadIO m =>
Int -> m Word64 -> m ShortByteString
genShortByteStringIO Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (m :: * -> *). StatefulGen g m => g -> m Word64
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 :: forall (m :: * -> *).
MonadIO m =>
Int -> m Word64 -> m ShortByteString
genShortByteStringIO Int
n0 m Word64
gen64 = do
  let !n :: Int
n@(I# Int#
n#) = forall a. Ord a => a -> a -> a
max Int
0 Int
n0
      !n64 :: Int
n64 = Int
n forall a. Integral a => a -> a -> a
`quot` Int
8
      !nrem :: Int
nrem = Int
n forall a. Integral a => a -> a -> a
`rem` Int
8
  mba :: MBA
mba@(MBA MutableByteArray# RealWorld
mba#) <-
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# ->
      case forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
n# State# RealWorld
s# of
        (# State# RealWorld
s'#, MutableByteArray# RealWorld
mba# #) -> (# State# RealWorld
s'#, MutableByteArray# RealWorld -> MBA
MBA MutableByteArray# RealWorld
mba# #)
  let go :: Int -> m ()
go Int
i =
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Ord a => a -> a -> Bool
< Int
n64) forall a b. (a -> b) -> a -> b
$ do
          Word64
w64 <- m Word64
gen64
          -- Writing 8 bytes at a time in a Little-endian order gives us
          -- platform portability
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ MBA -> Int -> Word64 -> IO ()
writeWord64LE MBA
mba Int
i Word64
w64
          Int -> m ()
go (Int
i forall a. Num a => a -> a -> a
+ Int
1)
  Int -> m ()
go Int
0
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nrem forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ do
    Word64
w64 <- m Word64
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.
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ MBA -> Int -> Int -> Word64 -> IO ()
writeByteSliceWord64LE MBA
mba (Int
n forall a. Num a => a -> a -> a
- Int
nrem) Int
n Word64
w64
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# ->
    case forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
mba# State# RealWorld
s# of
      (# State# RealWorld
s'#, ByteArray#
ba# #) -> (# State# RealWorld
s'#, ByteArray# -> ShortByteString
SBS ByteArray#
ba# #)
{-# INLINE genShortByteStringIO #-}

-- Architecture independent helpers:
io_ :: (State# RealWorld -> State# RealWorld) -> IO ()
io_ :: (State# RealWorld -> State# RealWorld) -> IO ()
io_ State# RealWorld -> State# RealWorld
m# = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# -> (# State# RealWorld -> State# RealWorld
m# State# RealWorld
s#, () #)
{-# INLINE io_ #-}

writeWord8 :: MBA -> Int -> Word8 -> IO ()
writeWord8 :: MBA -> Int -> Word8 -> IO ()
writeWord8 (MBA MutableByteArray# RealWorld
mba#) (I# Int#
i#) (W8# Word8#
w#) = (State# RealWorld -> State# RealWorld) -> IO ()
io_ (forall d.
MutableByteArray# d -> Int# -> Word8# -> State# d -> State# d
writeWord8Array# MutableByteArray# RealWorld
mba# Int#
i# Word8#
w#)
{-# INLINE writeWord8 #-}

writeByteSliceWord64LE :: MBA -> Int -> Int -> Word64 -> IO ()
writeByteSliceWord64LE :: MBA -> Int -> Int -> Word64 -> IO ()
writeByteSliceWord64LE MBA
mba Int
fromByteIx Int
toByteIx = Int -> Word64 -> IO ()
go Int
fromByteIx
  where
    go :: Int -> Word64 -> IO ()
go !Int
i !Word64
z =
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Ord a => a -> a -> Bool
< Int
toByteIx) forall a b. (a -> b) -> a -> b
$ do
        MBA -> Int -> Word8 -> IO ()
writeWord8 MBA
mba Int
i (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
z :: Word8)
        Int -> Word64 -> IO ()
go (Int
i forall a. Num a => a -> a -> a
+ Int
1) (Word64
z forall a. Bits a => a -> Int -> a
`shiftR` Int
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 -> Int -> Word64 -> IO ()
writeWord64LE (MBA MutableByteArray# RealWorld
mba#) (I# Int#
i#) w64 :: Word64
w64@(W64# Word#
w64#)
  | Int
wordSizeInBits forall a. Eq a => a -> a -> Bool
== Int
64 = (State# RealWorld -> State# RealWorld) -> IO ()
io_ (forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord64Array# MutableByteArray# RealWorld
mba# Int#
i# Word#
w64#)
  | Bool
otherwise = do
    let !i32# :: Int#
i32# = Int#
i# Int# -> Int# -> Int#
*# Int#
2#
        !(W32# Word32#
w32l#) = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w64
        !(W32# Word32#
w32u#) = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w64 forall a. Bits a => a -> Int -> a
`shiftR` Int
32)
    (State# RealWorld -> State# RealWorld) -> IO ()
io_ (forall d.
MutableByteArray# d -> Int# -> Word32# -> State# d -> State# d
writeWord32Array# MutableByteArray# RealWorld
mba# Int#
i32# Word32#
w32l#)
    (State# RealWorld -> State# RealWorld) -> IO ()
io_ (forall d.
MutableByteArray# d -> Int# -> Word32# -> State# d -> State# d
writeWord32Array# MutableByteArray# RealWorld
mba# (Int#
i32# Int# -> Int# -> Int#
+# Int#
1#) Word32#
w32u#)
#endif
{-# INLINE writeWord64LE #-}


-- | Same as 'genShortByteStringIO', but runs in 'ST'.
--
-- @since 1.2.0
genShortByteStringST :: Int -> ST s Word64 -> ST s ShortByteString
genShortByteStringST :: forall s. Int -> ST s Word64 -> ST s ShortByteString
genShortByteStringST Int
n ST s Word64
action =
  forall a s. IO a -> ST s a
unsafeIOToST (forall (m :: * -> *).
MonadIO m =>
Int -> m Word64 -> m ShortByteString
genShortByteStringIO Int
n (forall s a. ST s a -> IO a
unsafeSTToIO ST s Word64
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 :: forall g (m :: * -> *). StatefulGen g m => Int -> g -> m ByteString
uniformByteStringM Int
n g
g = do
  ShortByteString
ba <- forall g (m :: * -> *).
StatefulGen g m =>
Int -> g -> m ShortByteString
uniformShortByteString Int
n g
g
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
#if __GLASGOW_HASKELL__ < 802
       fromShort ba
#else
    let !(SBS ByteArray#
ba#) = ShortByteString
ba in
    if Int# -> Bool
isTrue# (ByteArray# -> Int#
isByteArrayPinned# ByteArray#
ba#)
      then ByteArray# -> ByteString
pinnedByteArrayToByteString ByteArray#
ba#
      else ShortByteString -> ByteString
fromShort ShortByteString
ba
{-# INLINE uniformByteStringM #-}

pinnedByteArrayToByteString :: ByteArray# -> ByteString
pinnedByteArrayToByteString :: ByteArray# -> ByteString
pinnedByteArrayToByteString ByteArray#
ba# =
  ForeignPtr Word8 -> Int -> Int -> ByteString
PS (forall a. ByteArray# -> ForeignPtr a
pinnedByteArrayToForeignPtr ByteArray#
ba#) Int
0 (Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba#))
{-# INLINE pinnedByteArrayToByteString #-}

pinnedByteArrayToForeignPtr :: ByteArray# -> ForeignPtr a
pinnedByteArrayToForeignPtr :: forall a. ByteArray# -> ForeignPtr a
pinnedByteArrayToForeignPtr ByteArray#
ba# =
  forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr (ByteArray# -> Addr#
byteArrayContents# ByteArray#
ba#) (MutableByteArray# RealWorld -> ForeignPtrContents
PlainPtr (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# ByteArray#
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 { forall g. StateGen g -> g
unStateGen :: g }
  deriving (StateGen g -> StateGen g -> Bool
forall g. Eq g => StateGen g -> StateGen g -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StateGen g -> StateGen g -> Bool
$c/= :: forall g. Eq g => StateGen g -> StateGen g -> Bool
== :: StateGen g -> StateGen g -> Bool
$c== :: forall g. Eq g => StateGen g -> StateGen g -> Bool
Eq, StateGen g -> StateGen g -> Bool
StateGen g -> StateGen g -> Ordering
StateGen g -> StateGen g -> StateGen g
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {g}. Ord g => Eq (StateGen g)
forall g. Ord g => StateGen g -> StateGen g -> Bool
forall g. Ord g => StateGen g -> StateGen g -> Ordering
forall g. Ord g => StateGen g -> StateGen g -> StateGen g
min :: StateGen g -> StateGen g -> StateGen g
$cmin :: forall g. Ord g => StateGen g -> StateGen g -> StateGen g
max :: StateGen g -> StateGen g -> StateGen g
$cmax :: forall g. Ord g => StateGen g -> StateGen g -> StateGen g
>= :: StateGen g -> StateGen g -> Bool
$c>= :: forall g. Ord g => StateGen g -> StateGen g -> Bool
> :: StateGen g -> StateGen g -> Bool
$c> :: forall g. Ord g => StateGen g -> StateGen g -> Bool
<= :: StateGen g -> StateGen g -> Bool
$c<= :: forall g. Ord g => StateGen g -> StateGen g -> Bool
< :: StateGen g -> StateGen g -> Bool
$c< :: forall g. Ord g => StateGen g -> StateGen g -> Bool
compare :: StateGen g -> StateGen g -> Ordering
$ccompare :: forall g. Ord g => StateGen g -> StateGen g -> Ordering
Ord, Int -> StateGen g -> ShowS
forall g. Show g => Int -> StateGen g -> ShowS
forall g. Show g => [StateGen g] -> ShowS
forall g. Show g => StateGen g -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StateGen g] -> ShowS
$cshowList :: forall g. Show g => [StateGen g] -> ShowS
show :: StateGen g -> String
$cshow :: forall g. Show g => StateGen g -> String
showsPrec :: Int -> StateGen g -> ShowS
$cshowsPrec :: forall g. Show g => Int -> StateGen g -> ShowS
Show, Int -> StateGen g -> (ShortByteString, StateGen g)
Word32 -> StateGen g -> (Word32, StateGen g)
Word64 -> StateGen g -> (Word64, StateGen g)
StateGen g -> (Int, Int)
StateGen g -> (Int, StateGen g)
StateGen g -> (Word8, StateGen g)
StateGen g -> (Word16, StateGen g)
StateGen g -> (Word32, StateGen g)
StateGen g -> (Word64, StateGen g)
StateGen g -> (StateGen g, StateGen g)
forall g.
RandomGen g =>
Int -> StateGen g -> (ShortByteString, StateGen g)
forall g.
RandomGen g =>
Word32 -> StateGen g -> (Word32, StateGen g)
forall g.
RandomGen g =>
Word64 -> StateGen g -> (Word64, StateGen g)
forall g. RandomGen g => StateGen g -> (Int, Int)
forall g. RandomGen g => StateGen g -> (Int, StateGen g)
forall g. RandomGen g => StateGen g -> (Word8, StateGen g)
forall g. RandomGen g => StateGen g -> (Word16, StateGen g)
forall g. RandomGen g => StateGen g -> (Word32, StateGen g)
forall g. RandomGen g => StateGen g -> (Word64, StateGen g)
forall g. RandomGen g => StateGen g -> (StateGen g, StateGen g)
forall g.
(g -> (Int, g))
-> (g -> (Word8, g))
-> (g -> (Word16, g))
-> (g -> (Word32, g))
-> (g -> (Word64, g))
-> (Word32 -> g -> (Word32, g))
-> (Word64 -> g -> (Word64, g))
-> (Int -> g -> (ShortByteString, g))
-> (g -> (Int, Int))
-> (g -> (g, g))
-> RandomGen g
split :: StateGen g -> (StateGen g, StateGen g)
$csplit :: forall g. RandomGen g => StateGen g -> (StateGen g, StateGen g)
genRange :: StateGen g -> (Int, Int)
$cgenRange :: forall g. RandomGen g => StateGen g -> (Int, Int)
genShortByteString :: Int -> StateGen g -> (ShortByteString, StateGen g)
$cgenShortByteString :: forall g.
RandomGen g =>
Int -> StateGen g -> (ShortByteString, StateGen g)
genWord64R :: Word64 -> StateGen g -> (Word64, StateGen g)
$cgenWord64R :: forall g.
RandomGen g =>
Word64 -> StateGen g -> (Word64, StateGen g)
genWord32R :: Word32 -> StateGen g -> (Word32, StateGen g)
$cgenWord32R :: forall g.
RandomGen g =>
Word32 -> StateGen g -> (Word32, StateGen g)
genWord64 :: StateGen g -> (Word64, StateGen g)
$cgenWord64 :: forall g. RandomGen g => StateGen g -> (Word64, StateGen g)
genWord32 :: StateGen g -> (Word32, StateGen g)
$cgenWord32 :: forall g. RandomGen g => StateGen g -> (Word32, StateGen g)
genWord16 :: StateGen g -> (Word16, StateGen g)
$cgenWord16 :: forall g. RandomGen g => StateGen g -> (Word16, StateGen g)
genWord8 :: StateGen g -> (Word8, StateGen g)
$cgenWord8 :: forall g. RandomGen g => StateGen g -> (Word8, StateGen g)
next :: StateGen g -> (Int, StateGen g)
$cnext :: forall g. RandomGen g => StateGen g -> (Int, StateGen g)
RandomGen, Ptr (StateGen g) -> IO (StateGen g)
Ptr (StateGen g) -> Int -> IO (StateGen g)
Ptr (StateGen g) -> Int -> StateGen g -> IO ()
Ptr (StateGen g) -> StateGen g -> IO ()
StateGen g -> Int
forall b. Ptr b -> Int -> IO (StateGen g)
forall b. Ptr b -> Int -> StateGen g -> IO ()
forall g. Storable g => Ptr (StateGen g) -> IO (StateGen g)
forall g. Storable g => Ptr (StateGen g) -> Int -> IO (StateGen g)
forall g.
Storable g =>
Ptr (StateGen g) -> Int -> StateGen g -> IO ()
forall g. Storable g => Ptr (StateGen g) -> StateGen g -> IO ()
forall g. Storable g => StateGen g -> Int
forall g b. Storable g => Ptr b -> Int -> IO (StateGen g)
forall g b. Storable g => Ptr b -> Int -> StateGen g -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr (StateGen g) -> StateGen g -> IO ()
$cpoke :: forall g. Storable g => Ptr (StateGen g) -> StateGen g -> IO ()
peek :: Ptr (StateGen g) -> IO (StateGen g)
$cpeek :: forall g. Storable g => Ptr (StateGen g) -> IO (StateGen g)
pokeByteOff :: forall b. Ptr b -> Int -> StateGen g -> IO ()
$cpokeByteOff :: forall g b. Storable g => Ptr b -> Int -> StateGen g -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO (StateGen g)
$cpeekByteOff :: forall g b. Storable g => Ptr b -> Int -> IO (StateGen g)
pokeElemOff :: Ptr (StateGen g) -> Int -> StateGen g -> IO ()
$cpokeElemOff :: forall g.
Storable g =>
Ptr (StateGen g) -> Int -> StateGen g -> IO ()
peekElemOff :: Ptr (StateGen g) -> Int -> IO (StateGen g)
$cpeekElemOff :: forall g. Storable g => Ptr (StateGen g) -> Int -> IO (StateGen g)
alignment :: StateGen g -> Int
$calignment :: forall g. Storable g => StateGen g -> Int
sizeOf :: StateGen g -> Int
$csizeOf :: forall g. Storable g => StateGen g -> Int
Storable, StateGen g -> ()
forall g. NFData g => StateGen g -> ()
forall a. (a -> ()) -> NFData a
rnf :: StateGen g -> ()
$crnf :: forall g. NFData g => StateGen g -> ()
NFData)

instance (RandomGen g, MonadState g m) => StatefulGen (StateGenM g) m where
  uniformWord32R :: Word32 -> StateGenM g -> m Word32
uniformWord32R Word32
r StateGenM g
_ = forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (forall g. RandomGen g => Word32 -> g -> (Word32, g)
genWord32R Word32
r)
  {-# INLINE uniformWord32R #-}
  uniformWord64R :: Word64 -> StateGenM g -> m Word64
uniformWord64R Word64
r StateGenM g
_ = forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (forall g. RandomGen g => Word64 -> g -> (Word64, g)
genWord64R Word64
r)
  {-# INLINE uniformWord64R #-}
  uniformWord8 :: StateGenM g -> m Word8
uniformWord8 StateGenM g
_ = forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state forall g. RandomGen g => g -> (Word8, g)
genWord8
  {-# INLINE uniformWord8 #-}
  uniformWord16 :: StateGenM g -> m Word16
uniformWord16 StateGenM g
_ = forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state forall g. RandomGen g => g -> (Word16, g)
genWord16
  {-# INLINE uniformWord16 #-}
  uniformWord32 :: StateGenM g -> m Word32
uniformWord32 StateGenM g
_ = forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state forall g. RandomGen g => g -> (Word32, g)
genWord32
  {-# INLINE uniformWord32 #-}
  uniformWord64 :: StateGenM g -> m Word64
uniformWord64 StateGenM g
_ = forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state forall g. RandomGen g => g -> (Word64, g)
genWord64
  {-# INLINE uniformWord64 #-}
  uniformShortByteString :: Int -> StateGenM g -> m ShortByteString
uniformShortByteString Int
n StateGenM g
_ = forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (forall g. RandomGen g => Int -> g -> (ShortByteString, g)
genShortByteString Int
n)
  {-# INLINE uniformShortByteString #-}

instance (RandomGen g, MonadState g m) => FrozenGen (StateGen g) m where
  type MutableGen (StateGen g) m = StateGenM g
  freezeGen :: MutableGen (StateGen g) m -> m (StateGen g)
freezeGen MutableGen (StateGen g) m
_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall g. g -> StateGen g
StateGen forall s (m :: * -> *). MonadState s m => m s
get
  thawGen :: StateGen g -> m (MutableGen (StateGen g) m)
thawGen (StateGen g
g) = forall g. StateGenM g
StateGenM forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *). MonadState s m => s -> m ()
put g
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 :: forall g (m :: * -> *). (MonadState g m, RandomGen g) => m g
splitGen = forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state forall g. RandomGen g => g -> (g, g)
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 :: forall g a.
RandomGen g =>
g -> (StateGenM g -> State g a) -> (a, g)
runStateGen g
g StateGenM g -> State g a
f = forall s a. State s a -> s -> (a, s)
runState (StateGenM g -> State g a
f forall g. StateGenM g
StateGenM) g
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_ :: forall g a. RandomGen g => g -> (StateGenM g -> State g a) -> a
runStateGen_ g
g = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g a.
RandomGen g =>
g -> (StateGenM g -> State g a) -> (a, g)
runStateGen g
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 :: forall g (m :: * -> *) a.
RandomGen g =>
g -> (StateGenM g -> StateT g m a) -> m (a, g)
runStateGenT g
g StateGenM g -> StateT g m a
f = forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (StateGenM g -> StateT g m a
f forall g. StateGenM g
StateGenM) g
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_ :: forall g (f :: * -> *) a.
(RandomGen g, Functor f) =>
g -> (StateGenM g -> StateT g f a) -> f a
runStateGenT_ g
g = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (m :: * -> *) a.
RandomGen g =>
g -> (StateGenM g -> StateT g m a) -> m (a, g)
runStateGenT g
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 :: forall g a.
RandomGen g =>
g -> (forall s. StateGenM g -> StateT g (ST s) a) -> (a, g)
runStateGenST g
g forall s. StateGenM g -> StateT g (ST s) a
action = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ forall g (m :: * -> *) a.
RandomGen g =>
g -> (StateGenM g -> StateT g m a) -> m (a, g)
runStateGenT g
g forall s. StateGenM g -> StateT g (ST s) a
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_ :: forall g a.
RandomGen g =>
g -> (forall s. StateGenM g -> StateT g (ST s) a) -> a
runStateGenST_ g
g forall s. StateGenM g -> StateT g (ST s) a
action = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ forall g (f :: * -> *) a.
(RandomGen g, Functor f) =>
g -> (StateGenM g -> StateT g f a) -> f a
runStateGenT_ g
g forall s. StateGenM g -> StateT g (ST s) a
action
{-# INLINE runStateGenST_ #-}


-- | The standard pseudo-random number generator.
newtype StdGen = StdGen { StdGen -> SMGen
unStdGen :: SM.SMGen }
  deriving (Int -> StdGen -> ShowS
[StdGen] -> ShowS
StdGen -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StdGen] -> ShowS
$cshowList :: [StdGen] -> ShowS
show :: StdGen -> String
$cshow :: StdGen -> String
showsPrec :: Int -> StdGen -> ShowS
$cshowsPrec :: Int -> StdGen -> ShowS
Show, Int -> StdGen -> (ShortByteString, StdGen)
Word32 -> StdGen -> (Word32, StdGen)
Word64 -> StdGen -> (Word64, StdGen)
StdGen -> (Int, Int)
StdGen -> (Int, StdGen)
StdGen -> (Word8, StdGen)
StdGen -> (Word16, StdGen)
StdGen -> (Word32, StdGen)
StdGen -> (Word64, StdGen)
StdGen -> (StdGen, StdGen)
forall g.
(g -> (Int, g))
-> (g -> (Word8, g))
-> (g -> (Word16, g))
-> (g -> (Word32, g))
-> (g -> (Word64, g))
-> (Word32 -> g -> (Word32, g))
-> (Word64 -> g -> (Word64, g))
-> (Int -> g -> (ShortByteString, g))
-> (g -> (Int, Int))
-> (g -> (g, g))
-> RandomGen g
split :: StdGen -> (StdGen, StdGen)
$csplit :: StdGen -> (StdGen, StdGen)
genRange :: StdGen -> (Int, Int)
$cgenRange :: StdGen -> (Int, Int)
genShortByteString :: Int -> StdGen -> (ShortByteString, StdGen)
$cgenShortByteString :: Int -> StdGen -> (ShortByteString, StdGen)
genWord64R :: Word64 -> StdGen -> (Word64, StdGen)
$cgenWord64R :: Word64 -> StdGen -> (Word64, StdGen)
genWord32R :: Word32 -> StdGen -> (Word32, StdGen)
$cgenWord32R :: Word32 -> StdGen -> (Word32, StdGen)
genWord64 :: StdGen -> (Word64, StdGen)
$cgenWord64 :: StdGen -> (Word64, StdGen)
genWord32 :: StdGen -> (Word32, StdGen)
$cgenWord32 :: StdGen -> (Word32, StdGen)
genWord16 :: StdGen -> (Word16, StdGen)
$cgenWord16 :: StdGen -> (Word16, StdGen)
genWord8 :: StdGen -> (Word8, StdGen)
$cgenWord8 :: StdGen -> (Word8, StdGen)
next :: StdGen -> (Int, StdGen)
$cnext :: StdGen -> (Int, StdGen)
RandomGen, StdGen -> ()
forall a. (a -> ()) -> NFData a
rnf :: StdGen -> ()
$crnf :: StdGen -> ()
NFData)

instance Eq StdGen where
  StdGen SMGen
x1 == :: StdGen -> StdGen -> Bool
== StdGen SMGen
x2 = SMGen -> (Word64, Word64)
SM.unseedSMGen SMGen
x1 forall a. Eq a => a -> a -> Bool
== SMGen -> (Word64, Word64)
SM.unseedSMGen SMGen
x2

instance RandomGen SM.SMGen where
  next :: SMGen -> (Int, SMGen)
next = SMGen -> (Int, SMGen)
SM.nextInt
  {-# INLINE next #-}
  genWord32 :: SMGen -> (Word32, SMGen)
genWord32 = SMGen -> (Word32, SMGen)
SM.nextWord32
  {-# INLINE genWord32 #-}
  genWord64 :: SMGen -> (Word64, SMGen)
genWord64 = SMGen -> (Word64, SMGen)
SM.nextWord64
  {-# INLINE genWord64 #-}
  split :: SMGen -> (SMGen, SMGen)
split = SMGen -> (SMGen, SMGen)
SM.splitSMGen
  {-# INLINE split #-}

instance RandomGen SM32.SMGen where
  next :: SMGen -> (Int, SMGen)
next = SMGen -> (Int, SMGen)
SM32.nextInt
  {-# INLINE next #-}
  genWord32 :: SMGen -> (Word32, SMGen)
genWord32 = SMGen -> (Word32, SMGen)
SM32.nextWord32
  {-# INLINE genWord32 #-}
  genWord64 :: SMGen -> (Word64, SMGen)
genWord64 = SMGen -> (Word64, SMGen)
SM32.nextWord64
  {-# INLINE genWord64 #-}
  split :: SMGen -> (SMGen, SMGen)
split = SMGen -> (SMGen, SMGen)
SM32.splitSMGen
  {-# INLINE split #-}

-- | Constructs a 'StdGen' deterministically.
mkStdGen :: Int -> StdGen
mkStdGen :: Int -> StdGen
mkStdGen = SMGen -> StdGen
StdGen forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> SMGen
SM.mkSMGen forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Global mutable veriable with `StdGen`
theStdGen :: IORef StdGen
theStdGen :: IORef StdGen
theStdGen = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ IO SMGen
SM.initSMGen forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> IO (IORef a)
newIORef forall b c a. (b -> c) -> (a -> b) -> a -> c
. SMGen -> StdGen
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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a x. Generic a => Rep a x -> a
to forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
`runContT` forall (f :: * -> *) a. Applicative f => a -> f a
pure) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) g (m :: * -> *) r a.
(GUniform f, StatefulGen g m) =>
g -> ContT r m (f a)
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 :: forall g (m :: * -> *) r a.
StatefulGen g m =>
g -> ContT r m (M1 i c f a)
guniformM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) g (m :: * -> *) r a.
(GUniform f, StatefulGen g m) =>
g -> ContT r m (f a)
guniformM
  {-# INLINE guniformM #-}

instance Uniform a => GUniform (K1 i a) where
  guniformM :: forall g (m :: * -> *) r a.
StatefulGen g m =>
g -> ContT r m (K1 i a a)
guniformM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k i c (p :: k). c -> K1 i c p
K1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
  {-# INLINE guniformM #-}

instance GUniform U1 where
  guniformM :: forall g (m :: * -> *) r a.
StatefulGen g m =>
g -> ContT r m (U1 a)
guniformM = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall k (p :: k). U1 p
U1
  {-# INLINE guniformM #-}

instance (GUniform f, GUniform g) => GUniform (f :*: g) where
  guniformM :: forall g (m :: * -> *) r a.
StatefulGen g m =>
g -> ContT r m ((:*:) f g a)
guniformM g
g = forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) g (m :: * -> *) r a.
(GUniform f, StatefulGen g m) =>
g -> ContT r m (f a)
guniformM g
g forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) g (m :: * -> *) r a.
(GUniform f, StatefulGen g m) =>
g -> ContT r m (f a)
guniformM g
g
  {-# INLINE guniformM #-}

instance (GFinite f, GFinite g) => GUniform (f :+: g) where
  guniformM :: forall g (m :: * -> *) r a.
StatefulGen g m =>
g -> ContT r m ((:+:) f g a)
guniformM = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (m :: * -> *) (f :: * -> *) a.
(StatefulGen g m, GFinite f) =>
g -> m (f a)
finiteUniformM
  {-# INLINE guniformM #-}

finiteUniformM :: forall g m f a. (StatefulGen g m, GFinite f) => g -> m (f a)
finiteUniformM :: forall g (m :: * -> *) (f :: * -> *) a.
(StatefulGen g m, GFinite f) =>
g -> m (f a)
finiteUniformM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. GFinite f => Integer -> f a
toGFinite forall b c a. (b -> c) -> (a -> b) -> a -> c
. case forall (f :: * -> *). GFinite f => Proxy# f -> Cardinality
gcardinality (forall {k} (a :: k). Proxy# a
proxy# :: Proxy# f) of
  Shift Int
n
    | Int
n forall a. Ord a => a -> a -> Bool
<= Int
64 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Integral a => a -> Integer
toInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *).
(Ord a, FiniteBits a, Num a, StatefulGen g m) =>
(g -> m a) -> a -> g -> m a
unsignedBitmaskWithRejectionM forall g (m :: * -> *). StatefulGen g m => g -> m Word64
uniformWord64 (forall a. Bits a => Int -> a
bit Int
n forall a. Num a => a -> a -> a
- Word64
1)
    | Bool
otherwise -> forall a g (m :: * -> *).
(Bits a, Integral a, StatefulGen g m) =>
Int -> g -> m a
boundedByPowerOf2ExclusiveIntegralM Int
n
  Card Integer
n
    | Integer
n forall a. Ord a => a -> a -> Bool
<= forall a. Bits a => Int -> a
bit Int
64 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Integral a => a -> Integer
toInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *).
(Ord a, FiniteBits a, Num a, StatefulGen g m) =>
(g -> m a) -> a -> g -> m a
unsignedBitmaskWithRejectionM forall g (m :: * -> *). StatefulGen g m => g -> m Word64
uniformWord64 (forall a. Num a => Integer -> a
fromInteger Integer
n forall a. Num a => a -> a -> a
- Word64
1)
    | Bool
otherwise -> forall a g (m :: * -> *).
(Bits a, Integral a, StatefulGen g m) =>
a -> g -> m a
boundedExclusiveIntegralM Integer
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 :: forall g (m :: * -> *) a.
(StatefulGen g m, Generic a, GFinite (Rep a)) =>
g -> m a
uniformViaFiniteM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a x. Generic a => Rep a x -> a
to forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (m :: * -> *) (f :: * -> *) a.
(StatefulGen g m, GFinite f) =>
g -> m (f a)
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 :: forall g (m :: * -> *).
StatefulGen g m =>
(Integer, Integer) -> g -> m Integer
uniformRM = forall a g (m :: * -> *).
(Bits a, Integral a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformIntegralM
  {-# INLINE uniformRM #-}

instance UniformRange Natural where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(Natural, Natural) -> g -> m Natural
uniformRM = forall a g (m :: * -> *).
(Bits a, Integral a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformIntegralM
  {-# INLINE uniformRM #-}

instance Uniform Int8 where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m Int8
uniformM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word8 -> Int8) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (m :: * -> *). StatefulGen g m => g -> m Word8
uniformWord8
  {-# INLINE uniformM #-}
instance UniformRange Int8 where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(Int8, Int8) -> g -> m Int8
uniformRM = forall a b g (m :: * -> *).
(Num a, Num b, Ord b, Ord a, FiniteBits a, StatefulGen g m,
 Uniform a) =>
(b -> a) -> (a -> b) -> (b, b) -> g -> m b
signedBitmaskWithRejectionRM (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int8 -> Word8) forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE uniformRM #-}

instance Uniform Int16 where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m Int16
uniformM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word16 -> Int16) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (m :: * -> *). StatefulGen g m => g -> m Word16
uniformWord16
  {-# INLINE uniformM #-}
instance UniformRange Int16 where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(Int16, Int16) -> g -> m Int16
uniformRM = forall a b g (m :: * -> *).
(Num a, Num b, Ord b, Ord a, FiniteBits a, StatefulGen g m,
 Uniform a) =>
(b -> a) -> (a -> b) -> (b, b) -> g -> m b
signedBitmaskWithRejectionRM (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int16 -> Word16) forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE uniformRM #-}

instance Uniform Int32 where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m Int32
uniformM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word32 -> Int32) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (m :: * -> *). StatefulGen g m => g -> m Word32
uniformWord32
  {-# INLINE uniformM #-}
instance UniformRange Int32 where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(Int32, Int32) -> g -> m Int32
uniformRM = forall a b g (m :: * -> *).
(Num a, Num b, Ord b, Ord a, FiniteBits a, StatefulGen g m,
 Uniform a) =>
(b -> a) -> (a -> b) -> (b, b) -> g -> m b
signedBitmaskWithRejectionRM (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int32 -> Word32) forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE uniformRM #-}

instance Uniform Int64 where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m Int64
uniformM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word64 -> Int64) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (m :: * -> *). StatefulGen g m => g -> m Word64
uniformWord64
  {-# INLINE uniformM #-}
instance UniformRange Int64 where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(Int64, Int64) -> g -> m Int64
uniformRM = forall a b g (m :: * -> *).
(Num a, Num b, Ord b, Ord a, FiniteBits a, StatefulGen g m,
 Uniform a) =>
(b -> a) -> (a -> b) -> (b, b) -> g -> m b
signedBitmaskWithRejectionRM (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int64 -> Word64) forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE uniformRM #-}

wordSizeInBits :: Int
wordSizeInBits :: Int
wordSizeInBits = forall b. FiniteBits b => b -> Int
finiteBitSize (Word
0 :: Word)

instance Uniform Int where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m Int
uniformM
    | Int
wordSizeInBits forall a. Eq a => a -> a -> Bool
== Int
64 =
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word64 -> Int) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (m :: * -> *). StatefulGen g m => g -> m Word64
uniformWord64
    | Bool
otherwise =
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word32 -> Int) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (m :: * -> *). StatefulGen g m => g -> m Word32
uniformWord32
  {-# INLINE uniformM #-}

instance UniformRange Int where
  uniformRM :: forall g (m :: * -> *). StatefulGen g m => (Int, Int) -> g -> m Int
uniformRM = forall a b g (m :: * -> *).
(Num a, Num b, Ord b, Ord a, FiniteBits a, StatefulGen g m,
 Uniform a) =>
(b -> a) -> (a -> b) -> (b, b) -> g -> m b
signedBitmaskWithRejectionRM (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Word) forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE uniformRM #-}

instance Uniform Word where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m Word
uniformM
    | Int
wordSizeInBits forall a. Eq a => a -> a -> Bool
== Int
64 =
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word64 -> Word) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (m :: * -> *). StatefulGen g m => g -> m Word64
uniformWord64
    | Bool
otherwise =
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word32 -> Word) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (m :: * -> *). StatefulGen g m => g -> m Word32
uniformWord32
  {-# INLINE uniformM #-}

instance UniformRange Word where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(Word, Word) -> g -> m Word
uniformRM = forall a g (m :: * -> *).
(FiniteBits a, Num a, Ord a, Uniform a, StatefulGen g m) =>
(a, a) -> g -> m a
unsignedBitmaskWithRejectionRM
  {-# INLINE uniformRM #-}

instance Uniform Word8 where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m Word8
uniformM = forall g (m :: * -> *). StatefulGen g m => g -> m Word8
uniformWord8
  {-# INLINE uniformM #-}
instance UniformRange Word8 where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(Word8, Word8) -> g -> m Word8
uniformRM = forall a g (m :: * -> *).
(Integral a, StatefulGen g m) =>
(a, a) -> g -> m a
unbiasedWordMult32RM
  {-# INLINE uniformRM #-}

instance Uniform Word16 where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m Word16
uniformM = forall g (m :: * -> *). StatefulGen g m => g -> m Word16
uniformWord16
  {-# INLINE uniformM #-}
instance UniformRange Word16 where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(Word16, Word16) -> g -> m Word16
uniformRM = forall a g (m :: * -> *).
(Integral a, StatefulGen g m) =>
(a, a) -> g -> m a
unbiasedWordMult32RM
  {-# INLINE uniformRM #-}

instance Uniform Word32 where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m Word32
uniformM  = forall g (m :: * -> *). StatefulGen g m => g -> m Word32
uniformWord32
  {-# INLINE uniformM #-}
instance UniformRange Word32 where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(Word32, Word32) -> g -> m Word32
uniformRM = forall a g (m :: * -> *).
(Integral a, StatefulGen g m) =>
(a, a) -> g -> m a
unbiasedWordMult32RM
  {-# INLINE uniformRM #-}

instance Uniform Word64 where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m Word64
uniformM  = forall g (m :: * -> *). StatefulGen g m => g -> m Word64
uniformWord64
  {-# INLINE uniformM #-}
instance UniformRange Word64 where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(Word64, Word64) -> g -> m Word64
uniformRM = forall a g (m :: * -> *).
(FiniteBits a, Num a, Ord a, Uniform a, StatefulGen g m) =>
(a, a) -> g -> m a
unsignedBitmaskWithRejectionRM
  {-# INLINE uniformRM #-}

#if __GLASGOW_HASKELL__ >= 802
instance Uniform CBool where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m CBool
uniformM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> CBool
CBool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
  {-# INLINE uniformM #-}
instance UniformRange CBool where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(CBool, CBool) -> g -> m CBool
uniformRM (CBool Word8
b, CBool Word8
t) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> CBool
CBool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Word8
b, Word8
t)
  {-# INLINE uniformRM #-}
#endif

instance Uniform CChar where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m CChar
uniformM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int8 -> CChar
CChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
  {-# INLINE uniformM #-}
instance UniformRange CChar where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(CChar, CChar) -> g -> m CChar
uniformRM (CChar Int8
b, CChar Int8
t) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int8 -> CChar
CChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Int8
b, Int8
t)
  {-# INLINE uniformRM #-}

instance Uniform CSChar where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m CSChar
uniformM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int8 -> CSChar
CSChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
  {-# INLINE uniformM #-}
instance UniformRange CSChar where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(CSChar, CSChar) -> g -> m CSChar
uniformRM (CSChar Int8
b, CSChar Int8
t) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int8 -> CSChar
CSChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Int8
b, Int8
t)
  {-# INLINE uniformRM #-}

instance Uniform CUChar where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m CUChar
uniformM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> CUChar
CUChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
  {-# INLINE uniformM #-}
instance UniformRange CUChar where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(CUChar, CUChar) -> g -> m CUChar
uniformRM (CUChar Word8
b, CUChar Word8
t) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> CUChar
CUChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Word8
b, Word8
t)
  {-# INLINE uniformRM #-}

instance Uniform CShort where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m CShort
uniformM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int16 -> CShort
CShort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
  {-# INLINE uniformM #-}
instance UniformRange CShort where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(CShort, CShort) -> g -> m CShort
uniformRM (CShort Int16
b, CShort Int16
t) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int16 -> CShort
CShort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Int16
b, Int16
t)
  {-# INLINE uniformRM #-}

instance Uniform CUShort where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m CUShort
uniformM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word16 -> CUShort
CUShort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
  {-# INLINE uniformM #-}
instance UniformRange CUShort where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(CUShort, CUShort) -> g -> m CUShort
uniformRM (CUShort Word16
b, CUShort Word16
t) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word16 -> CUShort
CUShort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Word16
b, Word16
t)
  {-# INLINE uniformRM #-}

instance Uniform CInt where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m CInt
uniformM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> CInt
CInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
  {-# INLINE uniformM #-}
instance UniformRange CInt where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(CInt, CInt) -> g -> m CInt
uniformRM (CInt Int32
b, CInt Int32
t) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> CInt
CInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Int32
b, Int32
t)
  {-# INLINE uniformRM #-}

instance Uniform CUInt where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m CUInt
uniformM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> CUInt
CUInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
  {-# INLINE uniformM #-}
instance UniformRange CUInt where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(CUInt, CUInt) -> g -> m CUInt
uniformRM (CUInt Word32
b, CUInt Word32
t) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> CUInt
CUInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Word32
b, Word32
t)
  {-# INLINE uniformRM #-}

instance Uniform CLong where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m CLong
uniformM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> CLong
CLong forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
  {-# INLINE uniformM #-}
instance UniformRange CLong where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(CLong, CLong) -> g -> m CLong
uniformRM (CLong Int64
b, CLong Int64
t) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> CLong
CLong forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Int64
b, Int64
t)
  {-# INLINE uniformRM #-}

instance Uniform CULong where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m CULong
uniformM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> CULong
CULong forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
  {-# INLINE uniformM #-}
instance UniformRange CULong where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(CULong, CULong) -> g -> m CULong
uniformRM (CULong Word64
b, CULong Word64
t) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> CULong
CULong forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Word64
b, Word64
t)
  {-# INLINE uniformRM #-}

instance Uniform CPtrdiff where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m CPtrdiff
uniformM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> CPtrdiff
CPtrdiff forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
  {-# INLINE uniformM #-}
instance UniformRange CPtrdiff where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(CPtrdiff, CPtrdiff) -> g -> m CPtrdiff
uniformRM (CPtrdiff Int64
b, CPtrdiff Int64
t) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> CPtrdiff
CPtrdiff forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Int64
b, Int64
t)
  {-# INLINE uniformRM #-}

instance Uniform CSize where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m CSize
uniformM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> CSize
CSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
  {-# INLINE uniformM #-}
instance UniformRange CSize where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(CSize, CSize) -> g -> m CSize
uniformRM (CSize Word64
b, CSize Word64
t) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> CSize
CSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Word64
b, Word64
t)
  {-# INLINE uniformRM #-}

instance Uniform CWchar where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m CWchar
uniformM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> CWchar
CWchar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
  {-# INLINE uniformM #-}
instance UniformRange CWchar where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(CWchar, CWchar) -> g -> m CWchar
uniformRM (CWchar Int32
b, CWchar Int32
t) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> CWchar
CWchar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Int32
b, Int32
t)
  {-# INLINE uniformRM #-}

instance Uniform CSigAtomic where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m CSigAtomic
uniformM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> CSigAtomic
CSigAtomic forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
  {-# INLINE uniformM #-}
instance UniformRange CSigAtomic where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(CSigAtomic, CSigAtomic) -> g -> m CSigAtomic
uniformRM (CSigAtomic Int32
b, CSigAtomic Int32
t) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> CSigAtomic
CSigAtomic forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Int32
b, Int32
t)
  {-# INLINE uniformRM #-}

instance Uniform CLLong where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m CLLong
uniformM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> CLLong
CLLong forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
  {-# INLINE uniformM #-}
instance UniformRange CLLong where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(CLLong, CLLong) -> g -> m CLLong
uniformRM (CLLong Int64
b, CLLong Int64
t) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> CLLong
CLLong forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Int64
b, Int64
t)
  {-# INLINE uniformRM #-}

instance Uniform CULLong where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m CULLong
uniformM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> CULLong
CULLong forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
  {-# INLINE uniformM #-}
instance UniformRange CULLong where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(CULLong, CULLong) -> g -> m CULLong
uniformRM (CULLong Word64
b, CULLong Word64
t) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> CULLong
CULLong forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Word64
b, Word64
t)
  {-# INLINE uniformRM #-}

instance Uniform CIntPtr where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m CIntPtr
uniformM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> CIntPtr
CIntPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
  {-# INLINE uniformM #-}
instance UniformRange CIntPtr where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(CIntPtr, CIntPtr) -> g -> m CIntPtr
uniformRM (CIntPtr Int64
b, CIntPtr Int64
t) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> CIntPtr
CIntPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Int64
b, Int64
t)
  {-# INLINE uniformRM #-}

instance Uniform CUIntPtr where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m CUIntPtr
uniformM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> CUIntPtr
CUIntPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
  {-# INLINE uniformM #-}
instance UniformRange CUIntPtr where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(CUIntPtr, CUIntPtr) -> g -> m CUIntPtr
uniformRM (CUIntPtr Word64
b, CUIntPtr Word64
t) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> CUIntPtr
CUIntPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Word64
b, Word64
t)
  {-# INLINE uniformRM #-}

instance Uniform CIntMax where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m CIntMax
uniformM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> CIntMax
CIntMax forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
  {-# INLINE uniformM #-}
instance UniformRange CIntMax where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(CIntMax, CIntMax) -> g -> m CIntMax
uniformRM (CIntMax Int64
b, CIntMax Int64
t) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> CIntMax
CIntMax forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Int64
b, Int64
t)
  {-# INLINE uniformRM #-}

instance Uniform CUIntMax where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m CUIntMax
uniformM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> CUIntMax
CUIntMax forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
  {-# INLINE uniformM #-}
instance UniformRange CUIntMax where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(CUIntMax, CUIntMax) -> g -> m CUIntMax
uniformRM (CUIntMax Word64
b, CUIntMax Word64
t) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> CUIntMax
CUIntMax forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Word64
b, Word64
t)
  {-# INLINE uniformRM #-}

-- | See [Floating point number caveats](System-Random-Stateful.html#fpcaveats).
instance UniformRange CFloat where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(CFloat, CFloat) -> g -> m CFloat
uniformRM (CFloat Float
l, CFloat Float
h) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> CFloat
CFloat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Float
l, Float
h)
  {-# INLINE uniformRM #-}

-- | See [Floating point number caveats](System-Random-Stateful.html#fpcaveats).
instance UniformRange CDouble where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(CDouble, CDouble) -> g -> m CDouble
uniformRM (CDouble Double
l, CDouble Double
h) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> CDouble
CDouble forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Double
l, Double
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 :: Word32 -> Char
word32ToChar (W32# Word32#
w#) = Char# -> Char
C# (Int# -> Char#
chr# (Word# -> Int#
word2Int# (Word32# -> Word#
word32ToWord# Word32#
w#)))
#endif
{-# INLINE word32ToChar #-}

charToWord32 :: Char -> Word32
#if __GLASGOW_HASKELL__ < 902
charToWord32 (C# c#) = W32# (int2Word# (ord# c#))
#else
charToWord32 :: Char -> Word32
charToWord32 (C# Char#
c#) = Word32# -> Word32
W32# (Word# -> Word32#
wordToWord32# (Int# -> Word#
int2Word# (Char# -> Int#
ord# Char#
c#)))
#endif
{-# INLINE charToWord32 #-}

instance Uniform Char where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m Char
uniformM g
g = Word32 -> Char
word32ToChar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall g (m :: * -> *). StatefulGen g m => Word32 -> g -> m Word32
unbiasedWordMult32 (Char -> Word32
charToWord32 forall a. Bounded a => a
maxBound) g
g
  {-# INLINE uniformM #-}
instance UniformRange Char where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(Char, Char) -> g -> m Char
uniformRM (Char
l, Char
h) g
g =
    Word32 -> Char
word32ToChar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a g (m :: * -> *).
(Integral a, StatefulGen g m) =>
(a, a) -> g -> m a
unbiasedWordMult32RM (Char -> Word32
charToWord32 Char
l, Char -> Word32
charToWord32 Char
h) g
g
  {-# INLINE uniformRM #-}

instance Uniform () where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m ()
uniformM = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  {-# INLINE uniformM #-}
instance UniformRange () where
  uniformRM :: forall g (m :: * -> *). StatefulGen g m => ((), ()) -> g -> m ()
uniformRM = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  {-# INLINE uniformRM #-}

instance Uniform Bool where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m Bool
uniformM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. (Bits a, Num a) => a -> Bool
wordToBool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (m :: * -> *). StatefulGen g m => g -> m Word8
uniformWord8
    where wordToBool :: a -> Bool
wordToBool a
w = (a
w forall a. Bits a => a -> a -> a
.&. a
1) forall a. Eq a => a -> a -> Bool
/= a
0
          {-# INLINE wordToBool #-}
  {-# INLINE uniformM #-}
instance UniformRange Bool where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(Bool, Bool) -> g -> m Bool
uniformRM (Bool
False, Bool
False) g
_g = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  uniformRM (Bool
True, Bool
True)   g
_g = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  uniformRM (Bool, Bool)
_               g
g = forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g
  {-# INLINE uniformRM #-}

-- | See [Floating point number caveats](System-Random-Stateful.html#fpcaveats).
instance UniformRange Double where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(Double, Double) -> g -> m Double
uniformRM (Double
l, Double
h) g
g
    | Double
l forall a. Eq a => a -> a -> Bool
== Double
h = forall (m :: * -> *) a. Monad m => a -> m a
return Double
l
    | forall a. RealFloat a => a -> Bool
isInfinite Double
l Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isInfinite Double
h =
      -- Optimisation exploiting absorption:
      --   (-Infinity) + (anything but +Infinity) = -Infinity
      --   (anything but -Infinity) + (+Infinity) = +Infinity
      --                (-Infinity) + (+Infinity) = NaN
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Double
h forall a. Num a => a -> a -> a
+ Double
l
    | Bool
otherwise = do
      Double
x <- forall g (m :: * -> *). StatefulGen g m => g -> m Double
uniformDouble01M g
g
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Double
x forall a. Num a => a -> a -> a
* Double
l forall a. Num a => a -> a -> a
+ (Double
1 forall a. Num a => a -> a -> a
-Double
x) forall a. Num a => a -> a -> a
* Double
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 :: forall g (m :: * -> *). StatefulGen g m => g -> m Double
uniformDouble01M g
g = do
  Word64
w64 <- forall g (m :: * -> *). StatefulGen g m => g -> m Word64
uniformWord64 g
g
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w64 forall a. Fractional a => a -> a -> a
/ Double
m
  where
    m :: Double
m = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
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 :: forall g (m :: * -> *). StatefulGen g m => g -> m Double
uniformDoublePositive01M g
g = (forall a. Num a => a -> a -> a
+ Double
d) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall g (m :: * -> *). StatefulGen g m => g -> m Double
uniformDouble01M g
g
  where
    -- We add small constant to shift generated value from zero. It's
    -- selected as 1/2 of smallest possible nonzero value
    d :: Double
d = Double
2.710505431213761e-20 -- 2**(-65)
{-# INLINE uniformDoublePositive01M #-}

-- | See [Floating point number caveats](System-Random-Stateful.html#fpcaveats).
instance UniformRange Float where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(Float, Float) -> g -> m Float
uniformRM (Float
l, Float
h) g
g
    | Float
l forall a. Eq a => a -> a -> Bool
== Float
h = forall (m :: * -> *) a. Monad m => a -> m a
return Float
l
    | forall a. RealFloat a => a -> Bool
isInfinite Float
l Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isInfinite Float
h =
      -- Optimisation exploiting absorption:
      --   (-Infinity) + (anything but +Infinity) = -Infinity
      --   (anything but -Infinity) + (+Infinity) = +Infinity
      --                (-Infinity) + (+Infinity) = NaN
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Float
h forall a. Num a => a -> a -> a
+ Float
l
    | Bool
otherwise = do
      Float
x <- forall g (m :: * -> *). StatefulGen g m => g -> m Float
uniformFloat01M g
g
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Float
x forall a. Num a => a -> a -> a
* Float
l forall a. Num a => a -> a -> a
+ (Float
1 forall a. Num a => a -> a -> a
- Float
x) forall a. Num a => a -> a -> a
* Float
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 :: forall g (m :: * -> *). StatefulGen g m => g -> m Float
uniformFloat01M g
g = do
  Word32
w32 <- forall g (m :: * -> *). StatefulGen g m => g -> m Word32
uniformWord32 g
g
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w32 forall a. Fractional a => a -> a -> a
/ Float
m
  where
    m :: Float
m = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
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 :: forall g (m :: * -> *). StatefulGen g m => g -> m Float
uniformFloatPositive01M g
g = (forall a. Num a => a -> a -> a
+ Float
d) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall g (m :: * -> *). StatefulGen g m => g -> m Float
uniformFloat01M g
g
  where
    -- See uniformDoublePositive01M
    d :: Float
d = Float
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 :: forall a g (m :: * -> *).
(Enum a, Bounded a, StatefulGen g m) =>
g -> m a
uniformEnumM g
g = forall a. Enum a => Int -> a
toEnum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
minBound :: a), forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
maxBound :: a)) g
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 :: forall a g (m :: * -> *).
(Enum a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformEnumRM (a
l, a
h) g
g = forall a. Enum a => Int -> a
toEnum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (forall a. Enum a => a -> Int
fromEnum a
l, forall a. Enum a => a -> Int
fromEnum a
h) g
g
{-# INLINE uniformEnumRM #-}

-- The two integer functions below take an [inclusive,inclusive] range.
randomIvalIntegral :: (RandomGen g, Integral a) => (a, a) -> g -> (a, g)
randomIvalIntegral :: forall g a. (RandomGen g, Integral a) => (a, a) -> g -> (a, g)
randomIvalIntegral (a
l, a
h) = forall g a.
(RandomGen g, Num a) =>
(Integer, Integer) -> g -> (a, g)
randomIvalInteger (forall a. Integral a => a -> Integer
toInteger a
l, forall a. Integral a => a -> Integer
toInteger a
h)

{-# SPECIALIZE randomIvalInteger :: (Num a) =>
    (Integer, Integer) -> StdGen -> (a, StdGen) #-}

randomIvalInteger :: (RandomGen g, Num a) => (Integer, Integer) -> g -> (a, g)
randomIvalInteger :: forall g a.
(RandomGen g, Num a) =>
(Integer, Integer) -> g -> (a, g)
randomIvalInteger (Integer
l, Integer
h) g
rng
 | Integer
l forall a. Ord a => a -> a -> Bool
> Integer
h     = forall g a.
(RandomGen g, Num a) =>
(Integer, Integer) -> g -> (a, g)
randomIvalInteger (Integer
h,Integer
l) g
rng
 | Bool
otherwise = case Integer -> Integer -> g -> (Integer, g)
f Integer
1 Integer
0 g
rng of (Integer
v, g
rng') -> (forall a. Num a => Integer -> a
fromInteger (Integer
l forall a. Num a => a -> a -> a
+ Integer
v forall a. Integral a => a -> a -> a
`mod` Integer
k), g
rng')
     where
       (Int
genlo, Int
genhi) = forall g. RandomGen g => g -> (Int, Int)
genRange g
rng
       b :: Integer
b = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
genhi forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
genlo forall a. Num a => a -> a -> a
+ Integer
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 :: Integer
q = Integer
1000 :: Integer
       k :: Integer
k = Integer
h forall a. Num a => a -> a -> a
- Integer
l forall a. Num a => a -> a -> a
+ Integer
1
       magtgt :: Integer
magtgt = Integer
k forall a. Num a => a -> a -> a
* Integer
q

       -- generate pseudo-random values until we exceed the target magnitude
       f :: Integer -> Integer -> g -> (Integer, g)
f Integer
mag Integer
v g
g | Integer
mag forall a. Ord a => a -> a -> Bool
>= Integer
magtgt = (Integer
v, g
g)
                 | Bool
otherwise = Integer
v' seq :: forall a b. a -> b -> b
`seq`Integer -> Integer -> g -> (Integer, g)
f (Integer
magforall a. Num a => a -> a -> a
*Integer
b) Integer
v' g
g' where
                        (Int
x,g
g') = forall g. RandomGen g => g -> (Int, g)
next g
g
                        v' :: Integer
v' = Integer
v forall a. Num a => a -> a -> a
* Integer
b forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
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 :: forall a g (m :: * -> *).
(Bits a, Integral a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformIntegralM (a
l, a
h) g
gen = case a
l forall a. Ord a => a -> a -> Ordering
`compare` a
h of
  Ordering
LT -> do
    let limit :: a
limit = a
h forall a. Num a => a -> a -> a
- a
l
    a
bounded <- case forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized a
limit :: Maybe Word64 of
      Just Word64
limitAsWord64 ->
        -- Optimisation: if 'limit' fits into 'Word64', generate a bounded
        -- 'Word64' and then convert to 'Integer'
        forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a g (m :: * -> *).
(Ord a, FiniteBits a, Num a, StatefulGen g m) =>
(g -> m a) -> a -> g -> m a
unsignedBitmaskWithRejectionM forall g (m :: * -> *). StatefulGen g m => g -> m Word64
uniformWord64 Word64
limitAsWord64 g
gen
      Maybe Word64
Nothing -> forall a g (m :: * -> *).
(Bits a, Integral a, StatefulGen g m) =>
a -> g -> m a
boundedExclusiveIntegralM (a
limit forall a. Num a => a -> a -> a
+ a
1) g
gen
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ a
l forall a. Num a => a -> a -> a
+ a
bounded
  Ordering
GT -> forall a g (m :: * -> *).
(Bits a, Integral a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformIntegralM (a
h, a
l) g
gen
  Ordering
EQ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
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 :: forall a g (m :: * -> *).
(Bits a, Integral a, StatefulGen g m) =>
a -> g -> m a
boundedExclusiveIntegralM a
s g
gen = (Bits a, Integral a, StatefulGen g m) => m a
go
  where
    n :: Int
n = forall a. (Bits a, Num a) => a -> Int
integralWordSize a
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 :: Int
k = Int
wordSizeInBits forall a. Num a => a -> a -> a
* Int
n
    twoToK :: a
twoToK = (a
1 :: a) forall a. Bits a => a -> Int -> a
`shiftL` Int
k
    modTwoToKMask :: a
modTwoToKMask = a
twoToK forall a. Num a => a -> a -> a
- a
1

    t :: a
t = (a
twoToK forall a. Num a => a -> a -> a
- a
s) forall a. Integral a => a -> a -> a
`rem` a
s -- `rem`, instead of `mod` because `twoToK >= s` is guaranteed
    go :: (Bits a, Integral a, StatefulGen g m) => m a
    go :: (Bits a, Integral a, StatefulGen g m) => m a
go = do
      a
x <- forall a g (m :: * -> *).
(Bits a, Integral a, StatefulGen g m) =>
Int -> g -> m a
uniformIntegralWords Int
n g
gen
      let m :: a
m = a
x forall a. Num a => a -> a -> a
* a
s
      -- m .&. modTwoToKMask == m `mod` twoToK
      let l :: a
l = a
m forall a. Bits a => a -> a -> a
.&. a
modTwoToKMask
      if a
l forall a. Ord a => a -> a -> Bool
< a
t
        then (Bits a, Integral a, StatefulGen g m) => m a
go
        -- m `shiftR` k == m `quot` twoToK
        else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ a
m forall a. Bits a => a -> Int -> a
`shiftR` Int
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 :: forall a g (m :: * -> *).
(Bits a, Integral a, StatefulGen g m) =>
Int -> g -> m a
boundedByPowerOf2ExclusiveIntegralM Int
s g
gen = do
  let n :: Int
n = (Int
s forall a. Num a => a -> a -> a
+ Int
wordSizeInBits forall a. Num a => a -> a -> a
- Int
1) forall a. Integral a => a -> a -> a
`quot` Int
wordSizeInBits
  a
x <- forall a g (m :: * -> *).
(Bits a, Integral a, StatefulGen g m) =>
Int -> g -> m a
uniformIntegralWords Int
n g
gen
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ a
x forall a. Bits a => a -> a -> a
.&. (forall a. Bits a => Int -> a
bit Int
s forall a. Num a => a -> a -> a
- a
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 :: forall a. (Bits a, Num a) => a -> Int
integralWordSize = forall {t} {t}. (Num t, Num t, Bits t) => t -> t -> t
go Int
0
  where
    go :: t -> t -> t
go !t
acc t
i
      | t
i forall a. Eq a => a -> a -> Bool
== t
0 = t
acc
      | Bool
otherwise = t -> t -> t
go (t
acc forall a. Num a => a -> a -> a
+ t
1) (t
i forall a. Bits a => a -> Int -> a
`shiftR` Int
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 :: forall a g (m :: * -> *).
(Bits a, Integral a, StatefulGen g m) =>
Int -> g -> m a
uniformIntegralWords Int
n g
gen = a -> Int -> m a
go a
0 Int
n
  where
    go :: a -> Int -> m a
go !a
acc Int
i
      | Int
i forall a. Eq a => a -> a -> Bool
== Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return a
acc
      | Bool
otherwise = do
        (Word
w :: Word) <- forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
gen
        a -> Int -> m a
go ((a
acc forall a. Bits a => a -> Int -> a
`shiftL` Int
wordSizeInBits) forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
w) (Int
i forall a. Num a => a -> a -> a
- Int
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 :: forall a g (m :: * -> *).
(Integral a, StatefulGen g m) =>
(a, a) -> g -> m a
unbiasedWordMult32RM (a
b, a
t) g
g
  | a
b forall a. Ord a => a -> a -> Bool
<= a
t    = (forall a. Num a => a -> a -> a
+a
b) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall g (m :: * -> *). StatefulGen g m => Word32 -> g -> m Word32
unbiasedWordMult32 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
t forall a. Num a => a -> a -> a
- a
b)) g
g
  | Bool
otherwise = (forall a. Num a => a -> a -> a
+a
t) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall g (m :: * -> *). StatefulGen g m => Word32 -> g -> m Word32
unbiasedWordMult32 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
b forall a. Num a => a -> a -> a
- a
t)) g
g
{-# INLINE unbiasedWordMult32RM #-}

-- | Uniformly generate Word32 in @[0, s]@.
unbiasedWordMult32 :: forall g m. StatefulGen g m => Word32 -> g -> m Word32
unbiasedWordMult32 :: forall g (m :: * -> *). StatefulGen g m => Word32 -> g -> m Word32
unbiasedWordMult32 Word32
s g
g
  | Word32
s forall a. Eq a => a -> a -> Bool
== forall a. Bounded a => a
maxBound = forall g (m :: * -> *). StatefulGen g m => g -> m Word32
uniformWord32 g
g
  | Bool
otherwise = forall g (m :: * -> *). StatefulGen g m => Word32 -> g -> m Word32
unbiasedWordMult32Exclusive (Word32
sforall a. Num a => a -> a -> a
+Word32
1) g
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 :: forall g (m :: * -> *). StatefulGen g m => Word32 -> g -> m Word32
unbiasedWordMult32Exclusive Word32
r g
g = StatefulGen g m => m Word32
go
  where
    t :: Word32
    t :: Word32
t = (-Word32
r) forall a. Integral a => a -> a -> a
`mod` Word32
r -- Calculates 2^32 `mod` r!!!
    go :: StatefulGen g m => m Word32
    go :: StatefulGen g m => m Word32
go = do
      Word32
x <- forall g (m :: * -> *). StatefulGen g m => g -> m Word32
uniformWord32 g
g
      let m :: Word64
          m :: Word64
m = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
r
          l :: Word32
          l :: Word32
l = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
m
      if Word32
l forall a. Ord a => a -> a -> Bool
>= Word32
t then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
m forall a. Bits a => a -> Int -> a
`shiftR` Int
32) else StatefulGen g m => m Word32
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 :: forall a g (m :: * -> *).
(FiniteBits a, Num a, Ord a, Uniform a, StatefulGen g m) =>
(a, a) -> g -> m a
unsignedBitmaskWithRejectionRM (a
bottom, a
top) g
gen
  | a
bottom forall a. Eq a => a -> a -> Bool
== a
top = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
top
  | Bool
otherwise = (a
b forall a. Num a => a -> a -> a
+) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a g (m :: * -> *).
(Ord a, FiniteBits a, Num a, StatefulGen g m) =>
(g -> m a) -> a -> g -> m a
unsignedBitmaskWithRejectionM forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM a
r g
gen
  where
    (a
b, a
r) = if a
bottom forall a. Ord a => a -> a -> Bool
> a
top then (a
top, a
bottom forall a. Num a => a -> a -> a
- a
top) else (a
bottom, a
top forall a. Num a => a -> a -> a
- a
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 :: forall a b g (m :: * -> *).
(Num a, Num b, Ord b, Ord a, FiniteBits a, StatefulGen g m,
 Uniform a) =>
(b -> a) -> (a -> b) -> (b, b) -> g -> m b
signedBitmaskWithRejectionRM b -> a
toUnsigned a -> b
fromUnsigned (b
bottom, b
top) g
gen
  | b
bottom forall a. Eq a => a -> a -> Bool
== b
top = forall (f :: * -> *) a. Applicative f => a -> f a
pure b
top
  | Bool
otherwise =
    (b
b forall a. Num a => a -> a -> a
+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
fromUnsigned forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a g (m :: * -> *).
(Ord a, FiniteBits a, Num a, StatefulGen g m) =>
(g -> m a) -> a -> g -> m a
unsignedBitmaskWithRejectionM forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM a
r g
gen
    -- This works in all cases, see Appendix 1 at the end of the file.
  where
    (b
b, a
r) =
      if b
bottom forall a. Ord a => a -> a -> Bool
> b
top
        then (b
top, b -> a
toUnsigned b
bottom forall a. Num a => a -> a -> a
- b -> a
toUnsigned b
top)
        else (b
bottom, b -> a
toUnsigned b
top forall a. Num a => a -> a -> a
- b -> a
toUnsigned b
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 :: forall a g (m :: * -> *).
(Ord a, FiniteBits a, Num a, StatefulGen g m) =>
(g -> m a) -> a -> g -> m a
unsignedBitmaskWithRejectionM g -> m a
genUniformM a
range g
gen = m a
go
  where
    mask :: a
    mask :: a
mask = forall a. Bits a => a -> a
complement forall a. Bits a => a
zeroBits forall a. Bits a => a -> Int -> a
`shiftR` forall b. FiniteBits b => b -> Int
countLeadingZeros (a
range forall a. Bits a => a -> a -> a
.|. a
1)
    go :: m a
go = do
      a
x <- g -> m a
genUniformM g
gen
      let x' :: a
x' = a
x forall a. Bits a => a -> a -> a
.&. a
mask
      if a
x' forall a. Ord a => a -> a -> Bool
> a
range
        then m a
go
        else forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x'
{-# INLINE unsignedBitmaskWithRejectionM #-}

-------------------------------------------------------------------------------
-- 'Uniform' instances for tuples
-------------------------------------------------------------------------------

instance (Uniform a, Uniform b) => Uniform (a, b) where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m (a, b)
uniformM g
g = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g
  {-# INLINE uniformM #-}

instance (Uniform a, Uniform b, Uniform c) => Uniform (a, b, c) where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m (a, b, c)
uniformM g
g = (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g
  {-# INLINE uniformM #-}

instance (Uniform a, Uniform b, Uniform c, Uniform d) => Uniform (a, b, c, d) where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m (a, b, c, d)
uniformM g
g = (,,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g
  {-# INLINE uniformM #-}

instance (Uniform a, Uniform b, Uniform c, Uniform d, Uniform e) => Uniform (a, b, c, d, e) where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m (a, b, c, d, e)
uniformM g
g = (,,,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
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 :: forall g (m :: * -> *).
StatefulGen g m =>
g -> m (a, b, c, d, e, f)
uniformM g
g = (,,,,,)
               forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
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 :: forall g (m :: * -> *).
StatefulGen g m =>
g -> m (a, b, c, d, e, f, g)
uniformM g
g = (,,,,,,)
               forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
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