{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GHCForeignImportPrim #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UnliftedFFITypes #-}
#if __GLASGOW_HASKELL__ >= 800
{-# LANGUAGE TypeFamilyDependencies #-}
#else
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE KindSignatures #-}
#endif
{-# OPTIONS_HADDOCK hide, not-home #-}

-- |
-- Module      :  System.Random.Internal
-- Copyright   :  (c) The University of Glasgow 2001
-- License     :  BSD-style (see the file LICENSE in the 'random' repository)
-- Maintainer  :  libraries@haskell.org
-- Stability   :  stable
--
-- This library deals with the common task of pseudo-random number generation.
module System.Random.Internal
  (-- * Pure and monadic pseudo-random number generator interfaces
    RandomGen(..)
  , StatefulGen(..)
  , FrozenGen(..)

  -- ** Standard pseudo-random number generator
  , StdGen(..)
  , mkStdGen

  -- * Monadic adapters for pure pseudo-random number generators
  -- ** Pure adapter
  , StateGen(..)
  , StateGenM(..)
  , splitGen
  , runStateGen
  , runStateGen_
  , runStateGenT
  , runStateGenT_
  , runStateGenST

  -- * Pseudo-random values of various types
  , Uniform(..)
  , UniformRange(..)
  , uniformByteStringM
  , uniformDouble01M
  , uniformDoublePositive01M
  , uniformFloat01M
  , uniformFloatPositive01M

  -- * Generators for sequences of pseudo-random bytes
  , genShortByteStringIO
  , genShortByteStringST
  ) where

import Control.Arrow
import Control.DeepSeq (NFData)
import Control.Monad.IO.Class
import Control.Monad.ST
import Control.Monad.ST.Unsafe
import Control.Monad.State.Strict
import Data.Bits
import Data.ByteString.Builder.Prim (word64LE)
import Data.ByteString.Builder.Prim.Internal (runF)
import Data.ByteString.Short.Internal (ShortByteString(SBS), fromShort)
import Data.Int
import Data.Word
import Foreign.C.Types
import Foreign.Ptr (plusPtr)
import Foreign.Storable (Storable(pokeByteOff))
import GHC.Exts
import GHC.IO (IO(..))
import GHC.Word
import Numeric.Natural (Natural)
import System.IO.Unsafe (unsafePerformIO)
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

-- | 'RandomGen' is an interface to pure pseudo-random number generators.
--
-- 'StdGen' is the standard 'RandomGen' instance provided by this library.
{-# 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.
  next :: g -> (Int, g)
  next g
g = g -> (StateGenM g -> State g Int) -> (Int, g)
forall g a.
RandomGen g =>
g -> (StateGenM g -> State g a) -> (a, g)
runStateGen g
g ((Int, Int) -> StateGenM g -> State g Int
forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (g -> (Int, Int)
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 = (Word32 -> Word8) -> (Word32, g) -> (Word8, g)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32, g) -> (Word8, g))
-> (g -> (Word32, g)) -> g -> (Word8, g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> (Word32, g)
forall g. RandomGen g => g -> (Word32, g)
genWord32

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

  -- | Returns a 'Word32' that is uniformly distributed over the entire 'Word32'
  -- range.
  --
  -- @since 1.2.0
  genWord32 :: g -> (Word32, g)
  genWord32 = (Word32, Word32) -> g -> (Word32, g)
forall g a. (RandomGen g, Integral a) => (a, a) -> g -> (a, g)
randomIvalIntegral (Word32
forall a. Bounded a => a
minBound, Word32
forall a. Bounded a => a
maxBound)
  -- Once `next` is removed, this implementation should be used instead:
  -- first fromIntegral . genWord64

  -- | Returns a 'Word64' that is uniformly distributed over the entire 'Word64'
  -- range.
  --
  -- @since 1.2.0
  genWord64 :: g -> (Word64, g)
  genWord64 g
g =
    case g -> (Word32, g)
forall g. RandomGen g => g -> (Word32, g)
genWord32 g
g of
      (Word32
l32, g
g') ->
        case g -> (Word32, g)
forall g. RandomGen g => g -> (Word32, g)
genWord32 g
g' of
          (Word32
h32, g
g'') ->
            ((Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
h32 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
l32, g
g'')

  -- | @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 = g -> (StateGenM g -> State g Word32) -> (Word32, g)
forall g a.
RandomGen g =>
g -> (StateGenM g -> State g a) -> (a, g)
runStateGen g
g (Word32 -> StateGenM g -> State g Word32
forall g (m :: * -> *). StatefulGen g m => Word32 -> g -> m Word32
unbiasedWordMult32 Word32
m)

  -- | @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 = g -> (StateGenM g -> State g Word64) -> (Word64, g)
forall g a.
RandomGen g =>
g -> (StateGenM g -> State g a) -> (a, g)
runStateGen g
g ((StateGenM g -> State g Word64)
-> Word64 -> StateGenM g -> State g Word64
forall a g (m :: * -> *).
(Ord a, FiniteBits a, Num a, StatefulGen g m) =>
(g -> m a) -> a -> g -> m a
unsignedBitmaskWithRejectionM StateGenM g -> State g Word64
forall g (m :: * -> *). StatefulGen g m => g -> m Word64
uniformWord64 Word64
m)

  -- | @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 =
    IO (ShortByteString, g) -> (ShortByteString, g)
forall a. IO a -> a
unsafePerformIO (IO (ShortByteString, g) -> (ShortByteString, g))
-> IO (ShortByteString, g) -> (ShortByteString, g)
forall a b. (a -> b) -> a -> b
$ g
-> (StateGenM g -> StateT g IO ShortByteString)
-> IO (ShortByteString, g)
forall g (m :: * -> *) a.
RandomGen g =>
g -> (StateGenM g -> StateT g m a) -> m (a, g)
runStateGenT g
g (Int -> StateT g IO Word64 -> StateT g IO ShortByteString
forall (m :: * -> *).
MonadIO m =>
Int -> m Word64 -> m ShortByteString
genShortByteStringIO Int
n (StateT g IO Word64 -> StateT g IO ShortByteString)
-> (StateGenM g -> StateT g IO Word64)
-> StateGenM g
-> StateT g IO ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateGenM g -> StateT g IO Word64
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'.
  genRange :: g -> (Int, Int)
  genRange g
_ = (Int
forall a. Bounded a => a
minBound, Int
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.
  split :: g -> (g, g)


-- | 'StatefulGen' is an interface to monadic pseudo-random number generators.
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 = (g -> m Word32) -> Word32 -> g -> m Word32
forall a g (m :: * -> *).
(Ord a, FiniteBits a, Num a, StatefulGen g m) =>
(g -> m a) -> a -> g -> m a
unsignedBitmaskWithRejectionM g -> m Word32
forall g (m :: * -> *). StatefulGen g m => g -> m Word32
uniformWord32

  -- | @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 = (g -> m Word64) -> Word64 -> g -> m Word64
forall a g (m :: * -> *).
(Ord a, FiniteBits a, Num a, StatefulGen g m) =>
(g -> m a) -> a -> g -> m a
unsignedBitmaskWithRejectionM g -> m Word64
forall g (m :: * -> *). StatefulGen g m => g -> m Word64
uniformWord64

  -- | 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 = (Word32 -> Word8) -> m Word32 -> m Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (m Word32 -> m Word8) -> (g -> m Word32) -> g -> m Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> m Word32
forall g (m :: * -> *). StatefulGen g m => g -> m Word32
uniformWord32

  -- | 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 = (Word32 -> Word16) -> m Word32 -> m Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (m Word32 -> m Word16) -> (g -> m Word32) -> g -> m Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> m Word32
forall g (m :: * -> *). StatefulGen g m => g -> m Word32
uniformWord32

  -- | 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 = (Word64 -> Word32) -> m Word64 -> m Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (m Word64 -> m Word32) -> (g -> m Word64) -> g -> m Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> m Word64
forall g (m :: * -> *). StatefulGen g m => g -> m Word64
uniformWord64

  -- | 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 <- g -> m Word32
forall g (m :: * -> *). StatefulGen g m => g -> m Word32
uniformWord32 g
g
    Word32
h32 <- g -> m Word32
forall g (m :: * -> *). StatefulGen g m => g -> m Word32
uniformWord32 g
g
    Word64 -> m Word64
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
h32) Int
32 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
l32)

  -- | @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 = Int -> m Word64 -> m ShortByteString
forall (m :: * -> *).
MonadIO m =>
Int -> m Word64 -> m ShortByteString
genShortByteStringIO Int
n (m Word64 -> m ShortByteString)
-> (g -> m Word64) -> g -> m ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> m Word64
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 s = MBA (MutableByteArray# s)


-- | 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 :: Int -> m Word64 -> m ShortByteString
genShortByteStringIO Int
n0 m Word64
gen64 = do
  let !n :: Int
n@(I# Int#
n#) = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n0
      !n64 :: Int
n64 = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
8
      !nrem64 :: Int
nrem64 = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
8
  MBA MutableByteArray# RealWorld
mba# <-
    IO (MBA RealWorld) -> m (MBA RealWorld)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MBA RealWorld) -> m (MBA RealWorld))
-> IO (MBA RealWorld) -> m (MBA RealWorld)
forall a b. (a -> b) -> a -> b
$
    (State# RealWorld -> (# State# RealWorld, MBA RealWorld #))
-> IO (MBA RealWorld)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, MBA RealWorld #))
 -> IO (MBA RealWorld))
-> (State# RealWorld -> (# State# RealWorld, MBA RealWorld #))
-> IO (MBA RealWorld)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# ->
      case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newPinnedByteArray# Int#
n# State# RealWorld
s# of
        (# State# RealWorld
s'#, MutableByteArray# RealWorld
mba# #) -> (# State# RealWorld
s'#, MutableByteArray# RealWorld -> MBA RealWorld
forall s. MutableByteArray# s -> MBA s
MBA MutableByteArray# RealWorld
mba# #)
  let go :: Int -> Ptr Word8 -> m (Ptr Word8)
go Int
i Ptr Word8
ptr
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n64 = do
          Word64
w64 <- m Word64
gen64
          -- Writing 8 bytes at a time in a Little-endian order gives us
          -- platform portability
          IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FixedPrim Word64 -> Word64 -> Ptr Word8 -> IO ()
forall a. FixedPrim a -> a -> Ptr Word8 -> IO ()
runF FixedPrim Word64
word64LE Word64
w64 Ptr Word8
ptr
          Int -> Ptr Word8 -> m (Ptr Word8)
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8)
        | Bool
otherwise = Ptr Word8 -> m (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Word8
ptr
  Ptr Word8
ptr <- Int -> Ptr Word8 -> m (Ptr Word8)
go Int
0 (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr (ByteArray# -> Addr#
byteArrayContents# (MutableByteArray# RealWorld -> ByteArray#
unsafeCoerce# MutableByteArray# RealWorld
mba#)))
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nrem64 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Word64
w64 <- m Word64
gen64
    -- In order to not mess up the byte order we write generated Word64 into a
    -- temporary pointer and then copy only the missing bytes over to the array.
    -- 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.
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      let goRem64 :: Word64 -> Int -> IO ()
goRem64 Word64
z Int
i =
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
nrem64) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
              Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ptr Int
i (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
z :: Word8)
              Word64 -> Int -> IO ()
goRem64 (Word64
z Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
8) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      Word64 -> Int -> IO ()
goRem64 Word64
w64 Int
0
  IO ShortByteString -> m ShortByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShortByteString -> m ShortByteString)
-> IO ShortByteString -> m ShortByteString
forall a b. (a -> b) -> a -> b
$
    (State# RealWorld -> (# State# RealWorld, ShortByteString #))
-> IO ShortByteString
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, ShortByteString #))
 -> IO ShortByteString)
-> (State# RealWorld -> (# State# RealWorld, ShortByteString #))
-> IO ShortByteString
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# ->
      case MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
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 #-}

-- | Same as 'genShortByteStringIO', but runs in 'ST'.
--
-- @since 1.2.0
genShortByteStringST :: Int -> ST s Word64 -> ST s ShortByteString
genShortByteStringST :: Int -> ST s Word64 -> ST s ShortByteString
genShortByteStringST Int
n ST s Word64
action =
  IO ShortByteString -> ST s ShortByteString
forall a s. IO a -> ST s a
unsafeIOToST (Int -> IO Word64 -> IO ShortByteString
forall (m :: * -> *).
MonadIO m =>
Int -> m Word64 -> m ShortByteString
genShortByteStringIO Int
n (ST s Word64 -> IO Word64
forall s a. ST s a -> IO a
unsafeSTToIO ST s Word64
action))


-- | Generates a pseudo-random 'ByteString' of the specified size.
--
-- @since 1.2.0
{-# INLINE uniformByteStringM #-}
uniformByteStringM :: StatefulGen g m => Int -> g -> m ByteString
uniformByteStringM :: Int -> g -> m ByteString
uniformByteStringM Int
n g
g = do
  ShortByteString
ba <- Int -> g -> m ShortByteString
forall g (m :: * -> *).
StatefulGen g m =>
Int -> g -> m ShortByteString
uniformShortByteString Int
n g
g
  ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString) -> ByteString -> m ByteString
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

pinnedByteArrayToByteString :: ByteArray# -> ByteString
pinnedByteArrayToByteString :: ByteArray# -> ByteString
pinnedByteArrayToByteString ByteArray#
ba# =
  ForeignPtr Word8 -> Int -> Int -> ByteString
PS (ByteArray# -> ForeignPtr Word8
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 :: ByteArray# -> ForeignPtr a
pinnedByteArrayToForeignPtr ByteArray#
ba# =
  Addr# -> ForeignPtrContents -> ForeignPtr a
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr (ByteArray# -> Addr#
byteArrayContents# ByteArray#
ba#) (MutableByteArray# RealWorld -> ForeignPtrContents
PlainPtr (ByteArray# -> MutableByteArray# RealWorld
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 { StateGen g -> g
unStateGen :: g }
  deriving (StateGen g -> StateGen g -> Bool
(StateGen g -> StateGen g -> Bool)
-> (StateGen g -> StateGen g -> Bool) -> Eq (StateGen g)
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, Eq (StateGen g)
Eq (StateGen g)
-> (StateGen g -> StateGen g -> Ordering)
-> (StateGen g -> StateGen g -> Bool)
-> (StateGen g -> StateGen g -> Bool)
-> (StateGen g -> StateGen g -> Bool)
-> (StateGen g -> StateGen g -> Bool)
-> (StateGen g -> StateGen g -> StateGen g)
-> (StateGen g -> StateGen g -> StateGen g)
-> Ord (StateGen g)
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
$cp1Ord :: forall g. Ord g => Eq (StateGen g)
Ord, Int -> StateGen g -> ShowS
[StateGen g] -> ShowS
StateGen g -> String
(Int -> StateGen g -> ShowS)
-> (StateGen g -> String)
-> ([StateGen g] -> ShowS)
-> Show (StateGen g)
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)
(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))
-> (Word32 -> StateGen g -> (Word32, StateGen g))
-> (Word64 -> StateGen g -> (Word64, StateGen g))
-> (Int -> StateGen g -> (ShortByteString, StateGen g))
-> (StateGen g -> (Int, Int))
-> (StateGen g -> (StateGen g, StateGen g))
-> RandomGen (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 b -> Int -> IO (StateGen g)
Ptr b -> Int -> StateGen g -> IO ()
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
(StateGen g -> Int)
-> (StateGen g -> Int)
-> (Ptr (StateGen g) -> Int -> IO (StateGen g))
-> (Ptr (StateGen g) -> Int -> StateGen g -> IO ())
-> (forall b. Ptr b -> Int -> IO (StateGen g))
-> (forall b. Ptr b -> Int -> StateGen g -> IO ())
-> (Ptr (StateGen g) -> IO (StateGen g))
-> (Ptr (StateGen g) -> StateGen g -> IO ())
-> Storable (StateGen g)
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 :: Ptr b -> Int -> StateGen g -> IO ()
$cpokeByteOff :: forall g b. Storable g => Ptr b -> Int -> StateGen g -> IO ()
peekByteOff :: 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 -> ()
(StateGen g -> ()) -> NFData (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
_ = (g -> (Word32, g)) -> m Word32
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (Word32 -> g -> (Word32, g)
forall g. RandomGen g => Word32 -> g -> (Word32, g)
genWord32R Word32
r)
  uniformWord64R :: Word64 -> StateGenM g -> m Word64
uniformWord64R Word64
r StateGenM g
_ = (g -> (Word64, g)) -> m Word64
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (Word64 -> g -> (Word64, g)
forall g. RandomGen g => Word64 -> g -> (Word64, g)
genWord64R Word64
r)
  uniformWord8 :: StateGenM g -> m Word8
uniformWord8 StateGenM g
_ = (g -> (Word8, g)) -> m Word8
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state g -> (Word8, g)
forall g. RandomGen g => g -> (Word8, g)
genWord8
  uniformWord16 :: StateGenM g -> m Word16
uniformWord16 StateGenM g
_ = (g -> (Word16, g)) -> m Word16
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state g -> (Word16, g)
forall g. RandomGen g => g -> (Word16, g)
genWord16
  uniformWord32 :: StateGenM g -> m Word32
uniformWord32 StateGenM g
_ = (g -> (Word32, g)) -> m Word32
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state g -> (Word32, g)
forall g. RandomGen g => g -> (Word32, g)
genWord32
  uniformWord64 :: StateGenM g -> m Word64
uniformWord64 StateGenM g
_ = (g -> (Word64, g)) -> m Word64
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state g -> (Word64, g)
forall g. RandomGen g => g -> (Word64, g)
genWord64
  uniformShortByteString :: Int -> StateGenM g -> m ShortByteString
uniformShortByteString Int
n StateGenM g
_ = (g -> (ShortByteString, g)) -> m ShortByteString
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (Int -> g -> (ShortByteString, g)
forall g. RandomGen g => Int -> g -> (ShortByteString, g)
genShortByteString Int
n)

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
_ = (g -> StateGen g) -> m g -> m (StateGen g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g -> StateGen g
forall g. g -> StateGen g
StateGen m g
forall s (m :: * -> *). MonadState s m => m s
get
  thawGen :: StateGen g -> m (MutableGen (StateGen g) m)
thawGen (StateGen g
g) = StateGenM g
forall g. StateGenM g
StateGenM StateGenM g -> m () -> m (StateGenM g)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ g -> m ()
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 :: m g
splitGen = (g -> (g, g)) -> m g
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state g -> (g, g)
forall g. RandomGen g => g -> (g, g)
split

-- | Runs a monadic generating action in the `State` monad using a pure
-- pseudo-random number generator.
--
-- ====__Examples__
--
-- >>> import System.Random.Stateful
-- >>> let pureGen = mkStdGen 137
-- >>> runStateGen pureGen randomM :: (Int, StdGen)
-- (7879794327570578227,StdGen {unStdGen = SMGen 11285859549637045894 7641485672361121627})
--
-- @since 1.2.0
runStateGen :: RandomGen g => g -> (StateGenM g -> State g a) -> (a, g)
runStateGen :: g -> (StateGenM g -> State g a) -> (a, g)
runStateGen g
g StateGenM g -> State g a
f = State g a -> g -> (a, g)
forall s a. State s a -> s -> (a, s)
runState (StateGenM g -> State g a
f StateGenM g
forall g. StateGenM g
StateGenM) g
g

-- | Runs a monadic generating action in the `State` monad using a pure
-- pseudo-random number generator. Returns only the resulting pseudo-random
-- value.
--
-- ====__Examples__
--
-- >>> import System.Random.Stateful
-- >>> let pureGen = mkStdGen 137
-- >>> runStateGen_ pureGen  randomM :: Int
-- 7879794327570578227
--
-- @since 1.2.0
runStateGen_ :: RandomGen g => g -> (StateGenM g -> State g a) -> a
runStateGen_ :: g -> (StateGenM g -> State g a) -> a
runStateGen_ g
g = (a, g) -> a
forall a b. (a, b) -> a
fst ((a, g) -> a)
-> ((StateGenM g -> State g a) -> (a, g))
-> (StateGenM g -> State g a)
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> (StateGenM g -> State g a) -> (a, g)
forall g a.
RandomGen g =>
g -> (StateGenM g -> State g a) -> (a, g)
runStateGen g
g

-- | Runs a monadic generating action in the `StateT` monad using a pure
-- pseudo-random number generator.
--
-- ====__Examples__
--
-- >>> import System.Random.Stateful
-- >>> let pureGen = mkStdGen 137
-- >>> runStateGenT pureGen randomM :: IO (Int, StdGen)
-- (7879794327570578227,StdGen {unStdGen = SMGen 11285859549637045894 7641485672361121627})
--
-- @since 1.2.0
runStateGenT :: RandomGen g => g -> (StateGenM g -> StateT g m a) -> m (a, g)
runStateGenT :: g -> (StateGenM g -> StateT g m a) -> m (a, g)
runStateGenT g
g StateGenM g -> StateT g m a
f = StateT g m a -> g -> m (a, g)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (StateGenM g -> StateT g m a
f StateGenM g
forall g. StateGenM g
StateGenM) g
g

-- | 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.0
runStateGenT_ :: (RandomGen g, Functor f) => g -> (StateGenM g -> StateT g f a) -> f a
runStateGenT_ :: g -> (StateGenM g -> StateT g f a) -> f a
runStateGenT_ g
g = ((a, g) -> a) -> f (a, g) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, g) -> a
forall a b. (a, b) -> a
fst (f (a, g) -> f a)
-> ((StateGenM g -> StateT g f a) -> f (a, g))
-> (StateGenM g -> StateT g f a)
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> (StateGenM g -> StateT g f a) -> f (a, g)
forall g (m :: * -> *) a.
RandomGen g =>
g -> (StateGenM g -> StateT g m a) -> m (a, g)
runStateGenT g
g

-- | Runs a monadic generating action in the `ST` monad using a pure
-- pseudo-random number generator.
--
-- @since 1.2.0
runStateGenST :: RandomGen g => g -> (forall s . StateGenM g -> StateT g (ST s) a) -> (a, g)
runStateGenST :: g -> (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 s. ST s (a, g)) -> (a, g)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (a, g)) -> (a, g))
-> (forall s. ST s (a, g)) -> (a, g)
forall a b. (a -> b) -> a -> b
$ g -> (StateGenM g -> StateT g (ST s) a) -> ST s (a, g)
forall g (m :: * -> *) a.
RandomGen g =>
g -> (StateGenM g -> StateT g m a) -> m (a, g)
runStateGenT g
g StateGenM g -> StateT g (ST s) a
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
(Int -> StdGen -> ShowS)
-> (StdGen -> String) -> ([StdGen] -> ShowS) -> Show StdGen
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)
(StdGen -> (Int, StdGen))
-> (StdGen -> (Word8, StdGen))
-> (StdGen -> (Word16, StdGen))
-> (StdGen -> (Word32, StdGen))
-> (StdGen -> (Word64, StdGen))
-> (Word32 -> StdGen -> (Word32, StdGen))
-> (Word64 -> StdGen -> (Word64, StdGen))
-> (Int -> StdGen -> (ShortByteString, StdGen))
-> (StdGen -> (Int, Int))
-> (StdGen -> (StdGen, StdGen))
-> RandomGen 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 -> ()
(StdGen -> ()) -> NFData 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 (Word64, Word64) -> (Word64, Word64) -> Bool
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
  genWord32 :: SMGen -> (Word32, SMGen)
genWord32 = SMGen -> (Word32, SMGen)
SM.nextWord32
  genWord64 :: SMGen -> (Word64, SMGen)
genWord64 = SMGen -> (Word64, SMGen)
SM.nextWord64
  split :: SMGen -> (SMGen, SMGen)
split = SMGen -> (SMGen, SMGen)
SM.splitSMGen

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

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

-- | 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.
  --
  -- @since 1.2.0
  uniformM :: StatefulGen g m => g -> m a

-- | 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 :: (Integer, Integer) -> g -> m Integer
uniformRM = (Integer, Integer) -> g -> m Integer
forall a g (m :: * -> *).
(Bits a, Integral a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformIntegralM

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

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

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

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

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

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

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

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

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

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

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

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

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

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

#if __GLASGOW_HASKELL__ >= 802
instance Uniform CBool where
  uniformM :: g -> m CBool
uniformM = (Word8 -> CBool) -> m Word8 -> m CBool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> CBool
CBool (m Word8 -> m CBool) -> (g -> m Word8) -> g -> m CBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> m Word8
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
instance UniformRange CBool where
  uniformRM :: (CBool, CBool) -> g -> m CBool
uniformRM (CBool Word8
b, CBool Word8
t) = (Word8 -> CBool) -> m Word8 -> m CBool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> CBool
CBool (m Word8 -> m CBool) -> (g -> m Word8) -> g -> m CBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8, Word8) -> g -> m Word8
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 :: g -> m CChar
uniformM = (Int8 -> CChar) -> m Int8 -> m CChar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int8 -> CChar
CChar (m Int8 -> m CChar) -> (g -> m Int8) -> g -> m CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> m Int8
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
instance UniformRange CChar where
  uniformRM :: (CChar, CChar) -> g -> m CChar
uniformRM (CChar Int8
b, CChar Int8
t) = (Int8 -> CChar) -> m Int8 -> m CChar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int8 -> CChar
CChar (m Int8 -> m CChar) -> (g -> m Int8) -> g -> m CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int8, Int8) -> g -> m Int8
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 :: g -> m CSChar
uniformM = (Int8 -> CSChar) -> m Int8 -> m CSChar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int8 -> CSChar
CSChar (m Int8 -> m CSChar) -> (g -> m Int8) -> g -> m CSChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> m Int8
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
instance UniformRange CSChar where
  uniformRM :: (CSChar, CSChar) -> g -> m CSChar
uniformRM (CSChar Int8
b, CSChar Int8
t) = (Int8 -> CSChar) -> m Int8 -> m CSChar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int8 -> CSChar
CSChar (m Int8 -> m CSChar) -> (g -> m Int8) -> g -> m CSChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int8, Int8) -> g -> m Int8
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 :: g -> m CUChar
uniformM = (Word8 -> CUChar) -> m Word8 -> m CUChar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> CUChar
CUChar (m Word8 -> m CUChar) -> (g -> m Word8) -> g -> m CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> m Word8
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
instance UniformRange CUChar where
  uniformRM :: (CUChar, CUChar) -> g -> m CUChar
uniformRM (CUChar Word8
b, CUChar Word8
t) = (Word8 -> CUChar) -> m Word8 -> m CUChar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> CUChar
CUChar (m Word8 -> m CUChar) -> (g -> m Word8) -> g -> m CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8, Word8) -> g -> m Word8
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 :: g -> m CShort
uniformM = (Int16 -> CShort) -> m Int16 -> m CShort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int16 -> CShort
CShort (m Int16 -> m CShort) -> (g -> m Int16) -> g -> m CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> m Int16
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
instance UniformRange CShort where
  uniformRM :: (CShort, CShort) -> g -> m CShort
uniformRM (CShort Int16
b, CShort Int16
t) = (Int16 -> CShort) -> m Int16 -> m CShort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int16 -> CShort
CShort (m Int16 -> m CShort) -> (g -> m Int16) -> g -> m CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int16, Int16) -> g -> m Int16
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 :: g -> m CUShort
uniformM = (Word16 -> CUShort) -> m Word16 -> m CUShort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word16 -> CUShort
CUShort (m Word16 -> m CUShort) -> (g -> m Word16) -> g -> m CUShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> m Word16
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
instance UniformRange CUShort where
  uniformRM :: (CUShort, CUShort) -> g -> m CUShort
uniformRM (CUShort Word16
b, CUShort Word16
t) = (Word16 -> CUShort) -> m Word16 -> m CUShort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word16 -> CUShort
CUShort (m Word16 -> m CUShort) -> (g -> m Word16) -> g -> m CUShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16, Word16) -> g -> m Word16
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 :: g -> m CInt
uniformM = (Int32 -> CInt) -> m Int32 -> m CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> CInt
CInt (m Int32 -> m CInt) -> (g -> m Int32) -> g -> m CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> m Int32
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
instance UniformRange CInt where
  uniformRM :: (CInt, CInt) -> g -> m CInt
uniformRM (CInt Int32
b, CInt Int32
t) = (Int32 -> CInt) -> m Int32 -> m CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> CInt
CInt (m Int32 -> m CInt) -> (g -> m Int32) -> g -> m CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int32, Int32) -> g -> m Int32
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 :: g -> m CUInt
uniformM = (Word32 -> CUInt) -> m Word32 -> m CUInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> CUInt
CUInt (m Word32 -> m CUInt) -> (g -> m Word32) -> g -> m CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> m Word32
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
instance UniformRange CUInt where
  uniformRM :: (CUInt, CUInt) -> g -> m CUInt
uniformRM (CUInt Word32
b, CUInt Word32
t) = (Word32 -> CUInt) -> m Word32 -> m CUInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> CUInt
CUInt (m Word32 -> m CUInt) -> (g -> m Word32) -> g -> m CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32, Word32) -> g -> m Word32
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 :: g -> m CLong
uniformM = (Int64 -> CLong) -> m Int64 -> m CLong
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> CLong
CLong (m Int64 -> m CLong) -> (g -> m Int64) -> g -> m CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> m Int64
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
instance UniformRange CLong where
  uniformRM :: (CLong, CLong) -> g -> m CLong
uniformRM (CLong Int64
b, CLong Int64
t) = (Int64 -> CLong) -> m Int64 -> m CLong
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> CLong
CLong (m Int64 -> m CLong) -> (g -> m Int64) -> g -> m CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64, Int64) -> g -> m Int64
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 :: g -> m CULong
uniformM = (Word64 -> CULong) -> m Word64 -> m CULong
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> CULong
CULong (m Word64 -> m CULong) -> (g -> m Word64) -> g -> m CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> m Word64
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
instance UniformRange CULong where
  uniformRM :: (CULong, CULong) -> g -> m CULong
uniformRM (CULong Word64
b, CULong Word64
t) = (Word64 -> CULong) -> m Word64 -> m CULong
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> CULong
CULong (m Word64 -> m CULong) -> (g -> m Word64) -> g -> m CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64, Word64) -> g -> m Word64
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 :: g -> m CPtrdiff
uniformM = (Int64 -> CPtrdiff) -> m Int64 -> m CPtrdiff
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> CPtrdiff
CPtrdiff (m Int64 -> m CPtrdiff) -> (g -> m Int64) -> g -> m CPtrdiff
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> m Int64
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
instance UniformRange CPtrdiff where
  uniformRM :: (CPtrdiff, CPtrdiff) -> g -> m CPtrdiff
uniformRM (CPtrdiff Int64
b, CPtrdiff Int64
t) = (Int64 -> CPtrdiff) -> m Int64 -> m CPtrdiff
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> CPtrdiff
CPtrdiff (m Int64 -> m CPtrdiff) -> (g -> m Int64) -> g -> m CPtrdiff
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64, Int64) -> g -> m Int64
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 :: g -> m CSize
uniformM = (Word64 -> CSize) -> m Word64 -> m CSize
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> CSize
CSize (m Word64 -> m CSize) -> (g -> m Word64) -> g -> m CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> m Word64
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
instance UniformRange CSize where
  uniformRM :: (CSize, CSize) -> g -> m CSize
uniformRM (CSize Word64
b, CSize Word64
t) = (Word64 -> CSize) -> m Word64 -> m CSize
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> CSize
CSize (m Word64 -> m CSize) -> (g -> m Word64) -> g -> m CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64, Word64) -> g -> m Word64
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 :: g -> m CWchar
uniformM = (Int32 -> CWchar) -> m Int32 -> m CWchar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> CWchar
CWchar (m Int32 -> m CWchar) -> (g -> m Int32) -> g -> m CWchar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> m Int32
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
instance UniformRange CWchar where
  uniformRM :: (CWchar, CWchar) -> g -> m CWchar
uniformRM (CWchar Int32
b, CWchar Int32
t) = (Int32 -> CWchar) -> m Int32 -> m CWchar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> CWchar
CWchar (m Int32 -> m CWchar) -> (g -> m Int32) -> g -> m CWchar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int32, Int32) -> g -> m Int32
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 :: g -> m CSigAtomic
uniformM = (Int32 -> CSigAtomic) -> m Int32 -> m CSigAtomic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> CSigAtomic
CSigAtomic (m Int32 -> m CSigAtomic) -> (g -> m Int32) -> g -> m CSigAtomic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> m Int32
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
instance UniformRange CSigAtomic where
  uniformRM :: (CSigAtomic, CSigAtomic) -> g -> m CSigAtomic
uniformRM (CSigAtomic Int32
b, CSigAtomic Int32
t) = (Int32 -> CSigAtomic) -> m Int32 -> m CSigAtomic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> CSigAtomic
CSigAtomic (m Int32 -> m CSigAtomic) -> (g -> m Int32) -> g -> m CSigAtomic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int32, Int32) -> g -> m Int32
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 :: g -> m CLLong
uniformM = (Int64 -> CLLong) -> m Int64 -> m CLLong
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> CLLong
CLLong (m Int64 -> m CLLong) -> (g -> m Int64) -> g -> m CLLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> m Int64
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
instance UniformRange CLLong where
  uniformRM :: (CLLong, CLLong) -> g -> m CLLong
uniformRM (CLLong Int64
b, CLLong Int64
t) = (Int64 -> CLLong) -> m Int64 -> m CLLong
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> CLLong
CLLong (m Int64 -> m CLLong) -> (g -> m Int64) -> g -> m CLLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64, Int64) -> g -> m Int64
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 :: g -> m CULLong
uniformM = (Word64 -> CULLong) -> m Word64 -> m CULLong
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> CULLong
CULLong (m Word64 -> m CULLong) -> (g -> m Word64) -> g -> m CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> m Word64
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
instance UniformRange CULLong where
  uniformRM :: (CULLong, CULLong) -> g -> m CULLong
uniformRM (CULLong Word64
b, CULLong Word64
t) = (Word64 -> CULLong) -> m Word64 -> m CULLong
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> CULLong
CULLong (m Word64 -> m CULLong) -> (g -> m Word64) -> g -> m CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64, Word64) -> g -> m Word64
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 :: g -> m CIntPtr
uniformM                         = (Int64 -> CIntPtr) -> m Int64 -> m CIntPtr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> CIntPtr
CIntPtr (m Int64 -> m CIntPtr) -> (g -> m Int64) -> g -> m CIntPtr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> m Int64
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
instance UniformRange CIntPtr where
  uniformRM :: (CIntPtr, CIntPtr) -> g -> m CIntPtr
uniformRM (CIntPtr Int64
b, CIntPtr Int64
t) = (Int64 -> CIntPtr) -> m Int64 -> m CIntPtr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> CIntPtr
CIntPtr (m Int64 -> m CIntPtr) -> (g -> m Int64) -> g -> m CIntPtr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64, Int64) -> g -> m Int64
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 :: g -> m CUIntPtr
uniformM = (Word64 -> CUIntPtr) -> m Word64 -> m CUIntPtr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> CUIntPtr
CUIntPtr (m Word64 -> m CUIntPtr) -> (g -> m Word64) -> g -> m CUIntPtr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> m Word64
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
instance UniformRange CUIntPtr where
  uniformRM :: (CUIntPtr, CUIntPtr) -> g -> m CUIntPtr
uniformRM (CUIntPtr Word64
b, CUIntPtr Word64
t) = (Word64 -> CUIntPtr) -> m Word64 -> m CUIntPtr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> CUIntPtr
CUIntPtr (m Word64 -> m CUIntPtr) -> (g -> m Word64) -> g -> m CUIntPtr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64, Word64) -> g -> m Word64
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 :: g -> m CIntMax
uniformM = (Int64 -> CIntMax) -> m Int64 -> m CIntMax
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> CIntMax
CIntMax (m Int64 -> m CIntMax) -> (g -> m Int64) -> g -> m CIntMax
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> m Int64
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
instance UniformRange CIntMax where
  uniformRM :: (CIntMax, CIntMax) -> g -> m CIntMax
uniformRM (CIntMax Int64
b, CIntMax Int64
t) = (Int64 -> CIntMax) -> m Int64 -> m CIntMax
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> CIntMax
CIntMax (m Int64 -> m CIntMax) -> (g -> m Int64) -> g -> m CIntMax
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64, Int64) -> g -> m Int64
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 :: g -> m CUIntMax
uniformM = (Word64 -> CUIntMax) -> m Word64 -> m CUIntMax
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> CUIntMax
CUIntMax (m Word64 -> m CUIntMax) -> (g -> m Word64) -> g -> m CUIntMax
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> m Word64
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM
instance UniformRange CUIntMax where
  uniformRM :: (CUIntMax, CUIntMax) -> g -> m CUIntMax
uniformRM (CUIntMax Word64
b, CUIntMax Word64
t) = (Word64 -> CUIntMax) -> m Word64 -> m CUIntMax
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> CUIntMax
CUIntMax (m Word64 -> m CUIntMax) -> (g -> m Word64) -> g -> m CUIntMax
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64, Word64) -> g -> m Word64
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 :: (CFloat, CFloat) -> g -> m CFloat
uniformRM (CFloat Float
l, CFloat Float
h) = (Float -> CFloat) -> m Float -> m CFloat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> CFloat
CFloat (m Float -> m CFloat) -> (g -> m Float) -> g -> m CFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float, Float) -> g -> m Float
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 :: (CDouble, CDouble) -> g -> m CDouble
uniformRM (CDouble Double
l, CDouble Double
h) = (Double -> CDouble) -> m Double -> m CDouble
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> CDouble
CDouble (m Double -> m CDouble) -> (g -> m Double) -> g -> m CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double) -> g -> m Double
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
word32ToChar :: Word32 -> Char
word32ToChar (W32# Word#
w#) = Char# -> Char
C# (Int# -> Char#
chr# (Word# -> Int#
word2Int# Word#
w#))
{-# INLINE word32ToChar #-}

charToWord32 :: Char -> Word32
charToWord32 :: Char -> Word32
charToWord32 (C# Char#
c#) = Word# -> Word32
W32# (Int# -> Word#
int2Word# (Char# -> Int#
ord# Char#
c#))
{-# INLINE charToWord32 #-}

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

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

-- | See [Floating point number caveats](System-Random-Stateful.html#fpcaveats).
instance UniformRange Double where
  uniformRM :: (Double, Double) -> g -> m Double
uniformRM (Double
l, Double
h) g
g
    | Double
l Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
h = Double -> m Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
l
    | Bool
otherwise = do
      Double
x <- g -> m Double
forall g (m :: * -> *). StatefulGen g m => g -> m Double
uniformDouble01M g
g
      Double -> m Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> m Double) -> Double -> m Double
forall a b. (a -> b) -> a -> b
$ Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
l Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
x) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
h

-- | 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 'UniformR' instance for
--   'Double'.
--
-- @since 1.2.0
uniformDouble01M :: StatefulGen g m => g -> m Double
uniformDouble01M :: g -> m Double
uniformDouble01M g
g = do
  Word64
w64 <- g -> m Word64
forall g (m :: * -> *). StatefulGen g m => g -> m Word64
uniformWord64 g
g
  Double -> m Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> m Double) -> Double -> m Double
forall a b. (a -> b) -> a -> b
$ Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w64 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
m
  where
    m :: Double
m = Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
forall a. Bounded a => a
maxBound :: Word64) :: Double

-- | 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 :: StatefulGen g m => g -> m Double
uniformDoublePositive01M :: g -> m Double
uniformDoublePositive01M g
g = (Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
d) (Double -> Double) -> m Double -> m Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g -> m Double
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)

-- | See [Floating point number caveats](System-Random-Stateful.html#fpcaveats).
instance UniformRange Float where
  uniformRM :: (Float, Float) -> g -> m Float
uniformRM (Float
l, Float
h) g
g
    | Float
l Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
h = Float -> m Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
l
    | Bool
otherwise = do
      Float
x <- g -> m Float
forall g (m :: * -> *). StatefulGen g m => g -> m Float
uniformFloat01M g
g
      Float -> m Float
forall (m :: * -> *) a. Monad m => a -> m a
return (Float -> m Float) -> Float -> m Float
forall a b. (a -> b) -> a -> b
$ Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
l Float -> Float -> Float
forall a. Num a => a -> a -> a
+ (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
h

-- | 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 'UniformR' instance for 'Float'
--
-- @since 1.2.0
uniformFloat01M :: StatefulGen g m => g -> m Float
uniformFloat01M :: g -> m Float
uniformFloat01M g
g = do
  Word32
w32 <- g -> m Word32
forall g (m :: * -> *). StatefulGen g m => g -> m Word32
uniformWord32 g
g
  Float -> m Float
forall (m :: * -> *) a. Monad m => a -> m a
return (Float -> m Float) -> Float -> m Float
forall a b. (a -> b) -> a -> b
$ Word32 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w32 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
m
  where
    m :: Float
m = Word32 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
forall a. Bounded a => a
maxBound :: Word32) :: Float

-- | 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 :: StatefulGen g m => g -> m Float
uniformFloatPositive01M :: g -> m Float
uniformFloatPositive01M g
g = (Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
d) (Float -> Float) -> m Float -> m Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g -> m Float
forall g (m :: * -> *). StatefulGen g m => g -> m Float
uniformFloat01M g
g
  where
    -- See uniformDoublePositive01M
    d :: Float
d = Float
1.1641532182693481e-10 -- 2**(-33)

-- The two integer functions below take an [inclusive,inclusive] range.
randomIvalIntegral :: (RandomGen g, Integral a) => (a, a) -> g -> (a, g)
randomIvalIntegral :: (a, a) -> g -> (a, g)
randomIvalIntegral (a
l,a
h) = (Integer, Integer) -> g -> (a, g)
forall g a.
(RandomGen g, Num a) =>
(Integer, Integer) -> g -> (a, g)
randomIvalInteger (a -> Integer
forall a. Integral a => a -> Integer
toInteger a
l, a -> Integer
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 :: (Integer, Integer) -> g -> (a, g)
randomIvalInteger (Integer
l,Integer
h) g
rng
 | Integer
l Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
h     = (Integer, Integer) -> g -> (a, g)
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') -> (Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer
l Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
v Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
k), g
rng')
     where
       (Int
genlo, Int
genhi) = g -> (Int, Int)
forall g. RandomGen g => g -> (Int, Int)
genRange g
rng
       b :: Integer
b = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
genhi Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
genlo Integer -> Integer -> Integer
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 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
l Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
       magtgt :: Integer
magtgt = Integer
k Integer -> Integer -> Integer
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 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
magtgt = (Integer
v, g
g)
                 | Bool
otherwise = Integer
v' Integer -> (Integer, g) -> (Integer, g)
`seq`Integer -> Integer -> g -> (Integer, g)
f (Integer
magInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
b) Integer
v' g
g' where
                        (Int
x,g
g') = g -> (Int, g)
forall g. RandomGen g => g -> (Int, g)
next g
g
                        v' :: Integer
v' = Integer
v Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Int -> Integer
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 :: (Bits a, Integral a, StatefulGen g m) => (a, a) -> g -> m a
uniformIntegralM :: (a, a) -> g -> m a
uniformIntegralM (a
l, a
h) g
gen = case a
l a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` a
h of
  Ordering
LT -> do
    let limit :: a
limit = a
h a -> a -> a
forall a. Num a => a -> a -> a
- a
l
    a
bounded <- case a -> Maybe Word64
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'
        Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> a) -> m Word64 -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (g -> m Word64) -> Word64 -> g -> m Word64
forall a g (m :: * -> *).
(Ord a, FiniteBits a, Num a, StatefulGen g m) =>
(g -> m a) -> a -> g -> m a
unsignedBitmaskWithRejectionM g -> m Word64
forall g (m :: * -> *). StatefulGen g m => g -> m Word64
uniformWord64 Word64
limitAsWord64 g
gen
      Maybe Word64
Nothing -> a -> g -> m a
forall a g (m :: * -> *).
(Bits a, Integral a, StatefulGen g m) =>
a -> g -> m a
boundedExclusiveIntegralM (a
limit a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) g
gen
    a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ a
l a -> a -> a
forall a. Num a => a -> a -> a
+ a
bounded
  Ordering
GT -> (a, a) -> g -> m a
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 -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
l
{-# INLINEABLE uniformIntegralM #-}

-- | 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 :: a -> g -> m a
boundedExclusiveIntegralM a
s g
gen = m a
(Bits a, Integral a, StatefulGen g m) => m a
go
  where
    n :: Int
n = a -> Int
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n
    twoToK :: a
twoToK = (a
1 :: a) a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
k
    modTwoToKMask :: a
modTwoToKMask = a
twoToK a -> a -> a
forall a. Num a => a -> a -> a
- a
1

    t :: a
t = (a
twoToK a -> a -> a
forall a. Num a => a -> a -> a
- a
s) a -> a -> a
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 :: m a
go = do
      a
x <- Int -> g -> m a
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 a -> a -> a
forall a. Num a => a -> a -> a
* a
s
      -- m .&. modTwoToKMask == m `mod` twoToK
      let l :: a
l = a
m a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
modTwoToKMask
      if a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
t
        then m a
(Bits a, Integral a, StatefulGen g m) => m a
go
        -- m `shiftR` k == m `quot` twoToK
        else a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ a
m a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
k
{-# INLINE boundedExclusiveIntegralM #-}

-- | @integralWordSize i@ returns that least @w@ such that
-- @i <= WORD_SIZE_IN_BITS^w@.
integralWordSize :: (Bits a, Num a) => a -> Int
integralWordSize :: a -> Int
integralWordSize = Int -> a -> Int
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 t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 = t
acc
      | Bool
otherwise = t -> t -> t
go (t
acc t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) (t
i t -> Int -> t
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 :: (Bits a, Integral a, StatefulGen g m) => Int -> g -> m a
uniformIntegralWords :: 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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
acc
      | Bool
otherwise = do
        (Word
w :: Word) <- g -> m Word
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
gen
        a -> Int -> m a
go ((a
acc a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
wordSizeInBits) a -> a -> a
forall a. Bits a => a -> a -> a
.|. Word -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
w) (Int
i Int -> Int -> Int
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 :: (StatefulGen g m, Integral a) => (a, a) -> g -> m a
unbiasedWordMult32RM :: (a, a) -> g -> m a
unbiasedWordMult32RM (a
b, a
t) g
g
  | a
b a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
t    = (a -> a -> a
forall a. Num a => a -> a -> a
+a
b) (a -> a) -> (Word32 -> a) -> Word32 -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> a) -> m Word32 -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word32 -> g -> m Word32
forall g (m :: * -> *). StatefulGen g m => Word32 -> g -> m Word32
unbiasedWordMult32 (a -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
t a -> a -> a
forall a. Num a => a -> a -> a
- a
b)) g
g
  | Bool
otherwise = (a -> a -> a
forall a. Num a => a -> a -> a
+a
t) (a -> a) -> (Word32 -> a) -> Word32 -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> a) -> m Word32 -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word32 -> g -> m Word32
forall g (m :: * -> *). StatefulGen g m => Word32 -> g -> m Word32
unbiasedWordMult32 (a -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
b a -> a -> a
forall a. Num a => a -> a -> a
- a
t)) g
g
{-# SPECIALIZE unbiasedWordMult32RM :: StatefulGen g m => (Word8, Word8) -> g -> m Word8 #-}

-- | Uniformly generate Word32 in @[0, s]@.
unbiasedWordMult32 :: StatefulGen g m => Word32 -> g -> m Word32
unbiasedWordMult32 :: Word32 -> g -> m Word32
unbiasedWordMult32 Word32
s g
g
  | Word32
s Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
forall a. Bounded a => a
maxBound = g -> m Word32
forall g (m :: * -> *). StatefulGen g m => g -> m Word32
uniformWord32 g
g
  | Bool
otherwise = Word32 -> g -> m Word32
forall g (m :: * -> *). StatefulGen g m => Word32 -> g -> m Word32
unbiasedWordMult32Exclusive (Word32
sWord32 -> Word32 -> Word32
forall 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 :: Word32 -> g -> m Word32
unbiasedWordMult32Exclusive Word32
r g
g = m Word32
StatefulGen g m => m Word32
go
  where
    t :: Word32
    t :: Word32
t = (-Word32
r) Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`mod` Word32
r -- Calculates 2^32 `mod` r!!!
    go :: StatefulGen g m => m Word32
    go :: m Word32
go = do
      Word32
x <- g -> m Word32
forall g (m :: * -> *). StatefulGen g m => g -> m Word32
uniformWord32 g
g
      let m :: Word64
          m :: Word64
m = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
r
          l :: Word32
          l :: Word32
l = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
m
      if Word32
l Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
t then Word32 -> m Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word32) -> Word64 -> Word32
forall a b. (a -> b) -> a -> b
$ Word64
m Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32) else m Word32
StatefulGen g m => m Word32
go

-- | This only works for unsigned integrals
unsignedBitmaskWithRejectionRM ::
     (StatefulGen g m, FiniteBits a, Num a, Ord a, Uniform a)
  => (a, a)
  -> g
  -> m a
unsignedBitmaskWithRejectionRM :: (a, a) -> g -> m a
unsignedBitmaskWithRejectionRM (a
bottom, a
top) g
gen
  | a
bottom a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
top = a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
top
  | Bool
otherwise = (a
b a -> a -> a
forall a. Num a => a -> a -> a
+) (a -> a) -> m a -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (g -> m a) -> a -> g -> m a
forall a g (m :: * -> *).
(Ord a, FiniteBits a, Num a, StatefulGen g m) =>
(g -> m a) -> a -> g -> m a
unsignedBitmaskWithRejectionM g -> m a
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 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
top then (a
top, a
bottom a -> a -> a
forall a. Num a => a -> a -> a
- a
top) else (a
bottom, a
top a -> a -> a
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 ::
     (Num a, Num b, Ord b, Ord a, FiniteBits a, StatefulGen g f, 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.
  -> f b
signedBitmaskWithRejectionRM :: (b -> a) -> (a -> b) -> (b, b) -> g -> f b
signedBitmaskWithRejectionRM b -> a
toUnsigned a -> b
fromUnsigned (b
bottom, b
top) g
gen
  | b
bottom b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
top = b -> f b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
top
  | Bool
otherwise =
    (b
b b -> b -> b
forall a. Num a => a -> a -> a
+) (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
fromUnsigned (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (g -> f a) -> a -> g -> f a
forall a g (m :: * -> *).
(Ord a, FiniteBits a, Num a, StatefulGen g m) =>
(g -> m a) -> a -> g -> m a
unsignedBitmaskWithRejectionM g -> f a
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 b -> b -> Bool
forall a. Ord a => a -> a -> Bool
> b
top
        then (b
top, b -> a
toUnsigned b
bottom a -> a -> a
forall a. Num a => a -> a -> a
- b -> a
toUnsigned b
top)
        else (b
bottom, b -> a
toUnsigned b
top a -> a -> a
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 :: (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 = a -> a
forall a. Bits a => a -> a
complement a
forall a. Bits a => a
zeroBits a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` a -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros (a
range a -> a -> a
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 a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
mask
      if a
x' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
range
        then m a
go
        else a -> m a
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 :: g -> m (a, b)
uniformM g
g = (,) (a -> b -> (a, b)) -> m a -> m (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g -> m a
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g m (b -> (a, b)) -> m b -> m (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> g -> m b
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g

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

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

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

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

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

-- 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