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

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

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

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

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

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

import Control.Arrow
import Control.DeepSeq (NFData)
import Control.Monad (when)
import Control.Monad.Cont (ContT, runContT)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.ST
import Control.Monad.ST.Unsafe
import Control.Monad.State.Strict (MonadState(..), State, StateT(..), runState)
import Control.Monad.Trans (lift)
import Data.Bits
import Data.ByteString.Short.Internal (ShortByteString(SBS), fromShort)
import Data.IORef (IORef, newIORef)
import Data.Int
import Data.Word
import Foreign.C.Types
import Foreign.Storable (Storable)
import GHC.Exts
import GHC.Generics
import GHC.IO (IO(..))
import GHC.Word
import Numeric.Natural (Natural)
import System.IO.Unsafe (unsafePerformIO)
import System.Random.GFinite (Cardinality(..), GFinite(..))
import qualified System.Random.SplitMix as SM
import qualified System.Random.SplitMix32 as SM32
#if __GLASGOW_HASKELL__ >= 800
import Data.Kind
#endif
#if __GLASGOW_HASKELL__ >= 802
import Data.ByteString.Internal (ByteString(PS))
import GHC.ForeignPtr
#else
import Data.ByteString (ByteString)
#endif

-- Needed for WORDS_BIGENDIAN
#include "MachDeps.h"


-- | 'RandomGen' is an interface to pure pseudo-random number generators.
--
-- 'StdGen' is the standard 'RandomGen' instance provided by this library.
--
-- @since 1.0.0
{-# DEPRECATED next "No longer used" #-}
{-# DEPRECATED genRange "No longer used" #-}
class RandomGen g where
  {-# MINIMAL split,(genWord32|genWord64|(next,genRange)) #-}
  -- | Returns an 'Int' that is uniformly distributed over the range returned by
  -- 'genRange' (including both end points), and a new generator. Using 'next'
  -- is inefficient as all operations go via 'Integer'. See
  -- [here](https://alexey.kuleshevi.ch/blog/2019/12/21/random-benchmarks) for
  -- more details. It is thus deprecated.
  --
  -- @since 1.0.0
  next :: g -> (Int, g)
  next g
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
  {-# INLINE genWord8 #-}

  -- | 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
  {-# INLINE genWord16 #-}

  -- | 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
  {-# INLINE genWord32 #-}

  -- | Returns a 'Word64' that is uniformly distributed over the entire 'Word64'
  -- range.
  --
  -- @since 1.2.0
  genWord64 :: g -> (Word64, g)
  genWord64 g
g =
    case 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'')
  {-# INLINE genWord64 #-}

  -- | @genWord32R upperBound g@ returns a 'Word32' that is uniformly
  -- distributed over the range @[0, upperBound]@.
  --
  -- @since 1.2.0
  genWord32R :: Word32 -> g -> (Word32, g)
  genWord32R Word32
m g
g = 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)
  {-# INLINE genWord32R #-}

  -- | @genWord64R upperBound g@ returns a 'Word64' that is uniformly
  -- distributed over the range @[0, upperBound]@.
  --
  -- @since 1.2.0
  genWord64R :: Word64 -> g -> (Word64, g)
  genWord64R Word64
m g
g = 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)
  {-# INLINE genWord64R #-}

  -- | @genShortByteString n g@ returns a 'ShortByteString' of length @n@
  -- filled with pseudo-random bytes.
  --
  -- @since 1.2.0
  genShortByteString :: Int -> g -> (ShortByteString, g)
  genShortByteString Int
n g
g =
    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'.
  --
  -- @since 1.0.0
  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.
  --
  -- @since 1.0.0
  split :: g -> (g, g)


-- | 'StatefulGen' is an interface to monadic pseudo-random number generators.
--
-- @since 1.2.0
class Monad m => StatefulGen g m where
  {-# MINIMAL (uniformWord32|uniformWord64) #-}
  -- | @uniformWord32R upperBound g@ generates a 'Word32' that is uniformly
  -- distributed over the range @[0, upperBound]@.
  --
  -- @since 1.2.0
  uniformWord32R :: Word32 -> g -> m Word32
  uniformWord32R = (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
  {-# INLINE uniformWord32R #-}

  -- | @uniformWord64R upperBound g@ generates a 'Word64' that is uniformly
  -- distributed over the range @[0, upperBound]@.
  --
  -- @since 1.2.0
  uniformWord64R :: Word64 -> g -> m Word64
  uniformWord64R = (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
  {-# INLINE uniformWord64R #-}

  -- | Generates a 'Word8' that is uniformly distributed over the entire 'Word8'
  -- range.
  --
  -- The default implementation extracts a 'Word8' from 'uniformWord32'.
  --
  -- @since 1.2.0
  uniformWord8 :: g -> m Word8
  uniformWord8 = (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
  {-# INLINE uniformWord8 #-}

  -- | Generates a 'Word16' that is uniformly distributed over the entire
  -- 'Word16' range.
  --
  -- The default implementation extracts a 'Word16' from 'uniformWord32'.
  --
  -- @since 1.2.0
  uniformWord16 :: g -> m Word16
  uniformWord16 = (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
  {-# INLINE uniformWord16 #-}

  -- | Generates a 'Word32' that is uniformly distributed over the entire
  -- 'Word32' range.
  --
  -- The default implementation extracts a 'Word32' from 'uniformWord64'.
  --
  -- @since 1.2.0
  uniformWord32 :: g -> m Word32
  uniformWord32 = (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
  {-# INLINE uniformWord32 #-}

  -- | Generates a 'Word64' that is uniformly distributed over the entire
  -- 'Word64' range.
  --
  -- The default implementation combines two 'Word32' from 'uniformWord32' into
  -- one 'Word64'.
  --
  -- @since 1.2.0
  uniformWord64 :: g -> m Word64
  uniformWord64 g
g = do
    Word32
l32 <- 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)
  {-# INLINE uniformWord64 #-}

  -- | @uniformShortByteString n g@ generates a 'ShortByteString' of length @n@
  -- filled with pseudo-random bytes.
  --
  -- @since 1.2.0
  uniformShortByteString :: Int -> g -> m ShortByteString
  default uniformShortByteString :: MonadIO m => Int -> g -> m ShortByteString
  uniformShortByteString Int
n = 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 = MBA (MutableByteArray# RealWorld)


-- | Efficiently generates a sequence of pseudo-random bytes in a platform
-- independent manner.
--
-- @since 1.2.0
genShortByteStringIO ::
     MonadIO m
  => Int -- ^ Number of bytes to generate
  -> m Word64 -- ^ IO action that can generate 8 random bytes at a time
  -> m ShortByteString
genShortByteStringIO :: 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
      !nrem :: Int
nrem = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
8
  mba :: MBA
mba@(MBA MutableByteArray# RealWorld
mba#) <-
    IO MBA -> m MBA
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MBA -> m MBA) -> IO MBA -> m MBA
forall a b. (a -> b) -> a -> b
$ (State# RealWorld -> (# State# RealWorld, MBA #)) -> IO MBA
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, MBA #)) -> IO MBA)
-> (State# RealWorld -> (# State# RealWorld, MBA #)) -> IO MBA
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 #)
newByteArray# Int#
n# State# RealWorld
s# of
        (# State# RealWorld
s'#, MutableByteArray# RealWorld
mba# #) -> (# State# RealWorld
s'#, MutableByteArray# RealWorld -> MBA
MBA MutableByteArray# RealWorld
mba# #)
  let go :: Int -> m ()
go Int
i =
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n64) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
          Word64
w64 <- m Word64
gen64
          -- Writing 8 bytes at a time in a Little-endian order gives us
          -- platform portability
          IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MBA -> Int -> Word64 -> IO ()
writeWord64LE MBA
mba Int
i Word64
w64
          Int -> m ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  Int -> m ()
go Int
0
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nrem 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 1 byte at a time in
    -- Little endian order. It is tempting to simply generate as many bytes as we
    -- still need using smaller generators (eg. uniformWord8), but that would
    -- result in inconsistent tail when total length is slightly varied.
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MBA -> Int -> Int -> Word64 -> IO ()
writeByteSliceWord64LE MBA
mba (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nrem) Int
n Word64
w64
  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 #-}

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

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

writeByteSliceWord64LE :: MBA -> Int -> Int -> Word64 -> IO ()
writeByteSliceWord64LE :: MBA -> Int -> Int -> Word64 -> IO ()
writeByteSliceWord64LE MBA
mba Int
fromByteIx Int
toByteIx = Int -> Word64 -> IO ()
go Int
fromByteIx
  where
    go :: Int -> Word64 -> IO ()
go !Int
i !Word64
z =
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
toByteIx) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        MBA -> Int -> Word8 -> IO ()
writeWord8 MBA
mba Int
i (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
z :: Word8)
        Int -> Word64 -> IO ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Word64
z Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
{-# INLINE writeByteSliceWord64LE #-}

writeWord64LE :: MBA -> Int -> Word64 -> IO ()
#ifdef WORDS_BIGENDIAN
writeWord64LE mba i w64 = do
  let !i8 = i * 8
  writeByteSliceWord64LE mba i8 (i8 + 8) w64
#else
writeWord64LE :: MBA -> Int -> Word64 -> IO ()
writeWord64LE (MBA MutableByteArray# RealWorld
mba#) (I# Int#
i#) w64 :: Word64
w64@(W64# Word#
w64#)
  | Int
wordSizeInBits Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
64 = (State# RealWorld -> State# RealWorld) -> IO ()
io_ (MutableByteArray# RealWorld
-> Int# -> Word# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord64Array# MutableByteArray# RealWorld
mba# Int#
i# Word#
w64#)
  | Bool
otherwise = do
    let !i32# :: Int#
i32# = Int#
i# Int# -> Int# -> Int#
*# Int#
2#
        !(W32# Word#
w32l#) = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w64
        !(W32# Word#
w32u#) = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w64 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32)
    (State# RealWorld -> State# RealWorld) -> IO ()
io_ (MutableByteArray# RealWorld
-> Int# -> Word# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord32Array# MutableByteArray# RealWorld
mba# Int#
i32# Word#
w32l#)
    (State# RealWorld -> State# RealWorld) -> IO ()
io_ (MutableByteArray# RealWorld
-> Int# -> Word# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord32Array# MutableByteArray# RealWorld
mba# (Int#
i32# Int# -> Int# -> Int#
+# Int#
1#) Word#
w32u#)
#endif
{-# INLINE writeWord64LE #-}


-- | 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))
{-# INLINE genShortByteStringST #-}


-- | Generates a pseudo-random 'ByteString' of the specified size.
--
-- @since 1.2.0
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
{-# INLINE uniformByteStringM #-}

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)
  {-# INLINE uniformWord32R #-}
  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)
  {-# INLINE uniformWord64R #-}
  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
  {-# INLINE uniformWord8 #-}
  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
  {-# INLINE uniformWord16 #-}
  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
  {-# INLINE uniformWord32 #-}
  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
  {-# INLINE uniformWord64 #-}
  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)
  {-# INLINE uniformShortByteString #-}

instance (RandomGen g, MonadState g m) => FrozenGen (StateGen g) m where
  type MutableGen (StateGen g) m = StateGenM g
  freezeGen :: MutableGen (StateGen g) m -> m (StateGen g)
freezeGen MutableGen (StateGen g) m
_ = (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
{-# INLINE splitGen #-}

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

-- | Runs a monadic generating action in the `State` monad using a pure
-- pseudo-random number generator. Returns only the resulting pseudo-random
-- value.
--
-- ====__Examples__
--
-- >>> import System.Random.Stateful
-- >>> let pureGen = mkStdGen 137
-- >>> runStateGen_ pureGen randomM :: Int
-- 7879794327570578227
--
-- @since 1.2.0
runStateGen_ :: RandomGen g => g -> (StateGenM g -> State g a) -> a
runStateGen_ :: g -> (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
{-# INLINE runStateGen_ #-}

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

-- | Runs a monadic generating action in the `StateT` monad using a pure
-- pseudo-random number generator. Returns only the resulting pseudo-random
-- value.
--
-- ====__Examples__
--
-- >>> import System.Random.Stateful
-- >>> let pureGen = mkStdGen 137
-- >>> runStateGenT_ pureGen randomM :: IO Int
-- 7879794327570578227
--
-- @since 1.2.1
runStateGenT_ :: (RandomGen g, Functor f) => g -> (StateGenM g -> StateT g f a) -> f a
runStateGenT_ :: g -> (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
{-# INLINE runStateGenT_ #-}

-- | Runs a monadic generating action in the `ST` monad using a pure
-- pseudo-random number generator.
--
-- @since 1.2.0
runStateGenST :: RandomGen g => g -> (forall s . StateGenM g -> StateT g (ST s) a) -> (a, g)
runStateGenST :: g -> (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 #-}

-- | Runs a monadic generating action in the `ST` monad using a pure
-- pseudo-random number generator. Same as `runStateGenST`, but discards the
-- resulting generator.
--
-- @since 1.2.1
runStateGenST_ :: RandomGen g => g -> (forall s . StateGenM g -> StateT g (ST s) a) -> a
runStateGenST_ :: g -> (forall s. StateGenM g -> StateT g (ST s) a) -> a
runStateGenST_ g
g forall s. StateGenM g -> StateT g (ST s) a
action = (forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s a) -> a) -> (forall s. ST s a) -> a
forall a b. (a -> b) -> a -> b
$ g -> (StateGenM g -> StateT g (ST s) a) -> ST s a
forall g (f :: * -> *) a.
(RandomGen g, Functor f) =>
g -> (StateGenM g -> StateT g f a) -> f a
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
  {-# INLINE next #-}
  genWord32 :: SMGen -> (Word32, SMGen)
genWord32 = SMGen -> (Word32, SMGen)
SM.nextWord32
  {-# INLINE genWord32 #-}
  genWord64 :: SMGen -> (Word64, SMGen)
genWord64 = SMGen -> (Word64, SMGen)
SM.nextWord64
  {-# INLINE genWord64 #-}
  split :: SMGen -> (SMGen, SMGen)
split = SMGen -> (SMGen, SMGen)
SM.splitSMGen
  {-# INLINE split #-}

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

-- | Constructs a 'StdGen' deterministically.
mkStdGen :: Int -> StdGen
mkStdGen :: Int -> StdGen
mkStdGen = SMGen -> StdGen
StdGen (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

-- | Global mutable veriable with `StdGen`
theStdGen :: IORef StdGen
theStdGen :: IORef StdGen
theStdGen = IO (IORef StdGen) -> IORef StdGen
forall a. IO a -> a
unsafePerformIO (IO (IORef StdGen) -> IORef StdGen)
-> IO (IORef StdGen) -> IORef StdGen
forall a b. (a -> b) -> a -> b
$ IO SMGen
SM.initSMGen IO SMGen -> (SMGen -> IO (IORef StdGen)) -> IO (IORef StdGen)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StdGen -> IO (IORef StdGen)
forall a. a -> IO (IORef a)
newIORef (StdGen -> IO (IORef StdGen))
-> (SMGen -> StdGen) -> SMGen -> IO (IORef StdGen)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SMGen -> StdGen
StdGen
{-# NOINLINE theStdGen #-}


-- | The class of types for which a uniformly distributed value can be drawn
-- from all possible values of the type.
--
-- @since 1.2.0
class Uniform a where
  -- | Generates a value uniformly distributed over all possible values of that
  -- type.
  --
  -- There is a default implementation via 'Generic':
  --
  -- >>> :set -XDeriveGeneric -XDeriveAnyClass
  -- >>> import GHC.Generics (Generic)
  -- >>> import System.Random.Stateful
  -- >>> data MyBool = MyTrue | MyFalse deriving (Show, Generic, Finite, Uniform)
  -- >>> data Action = Code MyBool | Eat (Maybe Bool) | Sleep deriving (Show, Generic, Finite, Uniform)
  -- >>> gen <- newIOGenM (mkStdGen 42)
  -- >>> uniformListM 10 gen :: IO [Action]
  -- [Code MyTrue,Code MyTrue,Eat Nothing,Code MyFalse,Eat (Just False),Eat (Just True),Eat Nothing,Eat (Just False),Sleep,Code MyFalse]
  --
  -- @since 1.2.0
  uniformM :: StatefulGen g m => g -> m a

  default uniformM :: (StatefulGen g m, Generic a, GUniform (Rep a)) => g -> m a
  uniformM = (Rep a Any -> a) -> m (Rep a Any) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (m (Rep a Any) -> m a) -> (g -> m (Rep a Any)) -> g -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContT (Rep a Any) m (Rep a Any)
-> (Rep a Any -> m (Rep a Any)) -> m (Rep a Any)
forall k (r :: k) (m :: k -> *) a. ContT r m a -> (a -> m r) -> m r
`runContT` Rep a Any -> m (Rep a Any)
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (ContT (Rep a Any) m (Rep a Any) -> m (Rep a Any))
-> (g -> ContT (Rep a Any) m (Rep a Any)) -> g -> m (Rep a Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> ContT (Rep a Any) m (Rep a Any)
forall (f :: * -> *) g (m :: * -> *) r a.
(GUniform f, StatefulGen g m) =>
g -> ContT r m (f a)
guniformM
  {-# INLINE uniformM #-}

-- | Default implementation of 'Uniform' type class for 'Generic' data.
-- It's important to use 'ContT', because without it 'fmap' and '>>=' remain
-- polymorphic too long and GHC fails to inline or specialize it, ending up
-- building full 'Rep' a structure in memory. 'ContT'
-- makes 'fmap' and '>>=' used in 'guniformM' monomorphic, so GHC is able to
-- specialize 'Generic' instance reasonably close to a handwritten one.
class GUniform f where
  guniformM :: StatefulGen g m => g -> ContT r m (f a)

instance GUniform f => GUniform (M1 i c f) where
  guniformM :: g -> ContT r m (M1 i c f a)
guniformM = (f a -> M1 i c f a) -> ContT r m (f a) -> ContT r m (M1 i c f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> M1 i c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (ContT r m (f a) -> ContT r m (M1 i c f a))
-> (g -> ContT r m (f a)) -> g -> ContT r m (M1 i c f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> ContT r m (f a)
forall (f :: * -> *) g (m :: * -> *) r a.
(GUniform f, StatefulGen g m) =>
g -> ContT r m (f a)
guniformM
  {-# INLINE guniformM #-}

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

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

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

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

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

-- | A definition of 'Uniform' for 'System.Random.Finite' types.
-- If your data has several fields of sub-'Word' cardinality,
-- this instance may be more efficient than one, derived via 'Generic' and 'GUniform'.
--
-- >>> :set -XDeriveGeneric -XDeriveAnyClass
-- >>> import GHC.Generics (Generic)
-- >>> import System.Random.Stateful
-- >>> data Triple = Triple Word8 Word8 Word8 deriving (Show, Generic, Finite)
-- >>> instance Uniform Triple where uniformM = uniformViaFiniteM
-- >>> gen <- newIOGenM (mkStdGen 42)
-- >>> uniformListM 5 gen :: IO [Triple]
-- [Triple 60 226 48,Triple 234 194 151,Triple 112 96 95,Triple 51 251 15,Triple 6 0 208]
--
uniformViaFiniteM :: (StatefulGen g m, Generic a, GFinite (Rep a)) => g -> m a
uniformViaFiniteM :: g -> m a
uniformViaFiniteM = (Rep a Any -> a) -> m (Rep a Any) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (m (Rep a Any) -> m a) -> (g -> m (Rep a Any)) -> g -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> m (Rep a Any)
forall g (m :: * -> *) (f :: * -> *) a.
(StatefulGen g m, GFinite f) =>
g -> m (f a)
finiteUniformM
{-# INLINE uniformViaFiniteM #-}

-- | The class of types for which a uniformly distributed value can be drawn
-- from a range.
--
-- @since 1.2.0
class UniformRange a where
  -- | Generates a value uniformly distributed over the provided range, which
  -- is interpreted as inclusive in the lower and upper bound.
  --
  -- *   @uniformRM (1 :: Int, 4 :: Int)@ generates values uniformly from the
  --     set \(\{1,2,3,4\}\)
  --
  -- *   @uniformRM (1 :: Float, 4 :: Float)@ generates values uniformly from
  --     the set \(\{x\;|\;1 \le x \le 4\}\)
  --
  -- The following law should hold to make the function always defined:
  --
  -- > uniformRM (a, b) = uniformRM (b, a)
  --
  -- @since 1.2.0
  uniformRM :: StatefulGen g m => (a, a) -> g -> m a

instance UniformRange Integer where
  uniformRM :: (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
  {-# INLINE uniformRM #-}

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
  {-# INLINE uniformRM #-}

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
  {-# INLINE uniformM #-}
instance UniformRange Int8 where
  uniformRM :: (Int8, Int8) -> g -> m Int8
uniformRM = (Int8 -> Word8) -> (Word8 -> Int8) -> (Int8, Int8) -> g -> m Int8
forall a b g (m :: * -> *).
(Num a, Num b, Ord b, Ord a, FiniteBits a, StatefulGen g m,
 Uniform a) =>
(b -> a) -> (a -> b) -> (b, b) -> g -> m b
signedBitmaskWithRejectionRM (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
  {-# INLINE uniformRM #-}

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
  {-# INLINE uniformM #-}
instance UniformRange Int16 where
  uniformRM :: (Int16, Int16) -> g -> m Int16
uniformRM = (Int16 -> Word16)
-> (Word16 -> Int16) -> (Int16, Int16) -> g -> m Int16
forall a b g (m :: * -> *).
(Num a, Num b, Ord b, Ord a, FiniteBits a, StatefulGen g m,
 Uniform a) =>
(b -> a) -> (a -> b) -> (b, b) -> g -> m b
signedBitmaskWithRejectionRM (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
  {-# INLINE uniformM #-}
instance UniformRange Int32 where
  uniformRM :: (Int32, Int32) -> g -> m Int32
uniformRM = (Int32 -> Word32)
-> (Word32 -> Int32) -> (Int32, Int32) -> g -> m Int32
forall a b g (m :: * -> *).
(Num a, Num b, Ord b, Ord a, FiniteBits a, StatefulGen g m,
 Uniform a) =>
(b -> a) -> (a -> b) -> (b, b) -> g -> m b
signedBitmaskWithRejectionRM (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
  {-# INLINE uniformM #-}
instance UniformRange Int64 where
  uniformRM :: (Int64, Int64) -> g -> m Int64
uniformRM = (Int64 -> Word64)
-> (Word64 -> Int64) -> (Int64, Int64) -> g -> m Int64
forall a b g (m :: * -> *).
(Num a, Num b, Ord b, Ord a, FiniteBits a, StatefulGen g m,
 Uniform a) =>
(b -> a) -> (a -> b) -> (b, b) -> g -> m b
signedBitmaskWithRejectionRM (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
  {-# INLINE uniformM #-}

instance UniformRange Int where
  uniformRM :: (Int, Int) -> g -> m Int
uniformRM = (Int -> Word) -> (Word -> Int) -> (Int, Int) -> g -> m Int
forall a b g (m :: * -> *).
(Num a, Num b, Ord b, Ord a, FiniteBits a, StatefulGen g m,
 Uniform a) =>
(b -> a) -> (a -> b) -> (b, b) -> g -> m b
signedBitmaskWithRejectionRM (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
  {-# INLINE uniformM #-}

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

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

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

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

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

#if __GLASGOW_HASKELL__ >= 802
instance Uniform CBool where
  uniformM :: 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
  {-# INLINE 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
  {-# INLINE 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
  {-# INLINE 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
  {-# INLINE 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
  {-# INLINE 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
  {-# INLINE 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
  {-# INLINE 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
  {-# INLINE 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
  {-# INLINE 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
  {-# INLINE 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
  {-# INLINE 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
  {-# INLINE 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
  {-# INLINE 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
  {-# INLINE 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
  {-# INLINE 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
  {-# INLINE 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
  {-# INLINE 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
  {-# INLINE 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
  {-# INLINE 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
  {-# INLINE 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
#if __GLASGOW_HASKELL__ < 902
word32ToChar :: Word32 -> Char
word32ToChar (W32# Word#
w#) = Char# -> Char
C# (Int# -> Char#
chr# (Word# -> Int#
word2Int# Word#
w#))
#else
word32ToChar (W32# w#) = C# (chr# (word2Int# (word32ToWord# w#)))
#endif
{-# INLINE word32ToChar #-}

charToWord32 :: Char -> Word32
#if __GLASGOW_HASKELL__ < 902
charToWord32 :: Char -> Word32
charToWord32 (C# Char#
c#) = Word# -> Word32
W32# (Int# -> Word#
int2Word# (Char# -> Int#
ord# Char#
c#))
#else
charToWord32 (C# c#) = W32# (wordToWord32# (int2Word# (ord# c#)))
#endif
{-# 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 a g (m :: * -> *).
(Integral a, StatefulGen g m) =>
(a, a) -> g -> m a
unbiasedWordMult32RM (Char -> Word32
charToWord32 Char
l, Char -> Word32
charToWord32 Char
h) g
g
  {-# INLINE uniformRM #-}

instance Uniform () where
  uniformM :: g -> m ()
uniformM = m () -> g -> m ()
forall a b. a -> b -> a
const (m () -> g -> m ()) -> m () -> g -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  {-# INLINE uniformM #-}
instance UniformRange () where
  uniformRM :: ((), ()) -> g -> m ()
uniformRM = (g -> m ()) -> ((), ()) -> g -> m ()
forall a b. a -> b -> a
const ((g -> m ()) -> ((), ()) -> g -> m ())
-> (g -> m ()) -> ((), ()) -> g -> m ()
forall a b. (a -> b) -> a -> b
$ m () -> g -> m ()
forall a b. a -> b -> a
const (m () -> g -> m ()) -> m () -> g -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  {-# 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
          {-# INLINE wordToBool #-}
  {-# INLINE uniformM #-}
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
  {-# INLINE uniformRM #-}

-- | 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
    | Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
l Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
h =
      -- Optimisation exploiting absorption:
      --   (-Infinity) + (anything but +Infinity) = -Infinity
      --   (anything but -Infinity) + (+Infinity) = +Infinity
      --                (-Infinity) + (+Infinity) = NaN
      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
h Double -> Double -> Double
forall a. Num a => a -> a -> a
+ 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
  {-# INLINE uniformRM #-}

-- | Generates uniformly distributed 'Double' in the range \([0, 1]\).
--   Numbers are generated by generating uniform 'Word64' and dividing
--   it by \(2^{64}\). It's used to implement 'UniformRange' instance for
--   'Double'.
--
-- @since 1.2.0
uniformDouble01M :: forall g m. StatefulGen g m => g -> m Double
uniformDouble01M :: g -> 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
{-# INLINE uniformDouble01M #-}

-- | Generates uniformly distributed 'Double' in the range
--   \((0, 1]\). Number is generated as \(2^{-64}/2+\operatorname{uniformDouble01M}\).
--   Constant is 1\/2 of smallest nonzero value which could be generated
--   by 'uniformDouble01M'.
--
-- @since 1.2.0
uniformDoublePositive01M :: forall g m. StatefulGen g m => g -> m Double
uniformDoublePositive01M :: g -> 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)
{-# INLINE uniformDoublePositive01M #-}

-- | 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
    | Float -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Float
l Bool -> Bool -> Bool
|| Float -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Float
h =
      -- Optimisation exploiting absorption:
      --   (-Infinity) + (anything but +Infinity) = -Infinity
      --   (anything but -Infinity) + (+Infinity) = +Infinity
      --                (-Infinity) + (+Infinity) = NaN
      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
h Float -> Float -> Float
forall a. Num a => a -> a -> a
+ 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
  {-# INLINE uniformRM #-}

-- | Generates uniformly distributed 'Float' in the range \([0, 1]\).
--   Numbers are generated by generating uniform 'Word32' and dividing
--   it by \(2^{32}\). It's used to implement 'UniformRange' instance for 'Float'.
--
-- @since 1.2.0
uniformFloat01M :: forall g m. StatefulGen g m => g -> m Float
uniformFloat01M :: g -> 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
{-# INLINE uniformFloat01M #-}

-- | Generates uniformly distributed 'Float' in the range
--   \((0, 1]\). Number is generated as \(2^{-32}/2+\operatorname{uniformFloat01M}\).
--   Constant is 1\/2 of smallest nonzero value which could be generated
--   by 'uniformFloat01M'.
--
-- @since 1.2.0
uniformFloatPositive01M :: forall g m. StatefulGen g m => g -> m Float
uniformFloatPositive01M :: g -> 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)
{-# INLINE uniformFloatPositive01M #-}

-- | Generates uniformly distributed 'Enum'.
-- One can use it to define a 'Uniform' instance:
--
-- > data Colors = Red | Green | Blue deriving (Enum, Bounded)
-- > instance Uniform Colors where uniformM = uniformEnumM
--
-- @since 1.2.1
uniformEnumM :: forall a g m. (Enum a, Bounded a, StatefulGen g m) => g -> m a
uniformEnumM :: g -> m a
uniformEnumM g
g = Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> m Int -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> g -> m Int
forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (a -> Int
forall a. Enum a => a -> Int
fromEnum (a
forall a. Bounded a => a
minBound :: a), a -> Int
forall a. Enum a => a -> Int
fromEnum (a
forall a. Bounded a => a
maxBound :: a)) g
g
{-# INLINE uniformEnumM #-}

-- | Generates uniformly distributed 'Enum' in the given range.
-- One can use it to define a 'UniformRange' instance:
--
-- > data Colors = Red | Green | Blue deriving (Enum)
-- > instance UniformRange Colors where
-- >   uniformRM = uniformEnumRM
-- >   inInRange (lo, hi) x = isInRange (fromEnum lo, fromEnum hi) (fromEnum x)
--
-- @since 1.2.1
uniformEnumRM :: forall a g m. (Enum a, StatefulGen g m) => (a, a) -> g -> m a
uniformEnumRM :: (a, a) -> g -> m a
uniformEnumRM (a
l, a
h) g
g = Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> m Int -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> g -> m Int
forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (a -> Int
forall a. Enum a => a -> Int
fromEnum a
l, a -> Int
forall a. Enum a => a -> Int
fromEnum a
h) g
g
{-# INLINE uniformEnumRM #-}

-- The two integer functions below take an [inclusive,inclusive] range.
randomIvalIntegral :: (RandomGen g, Integral a) => (a, a) -> g -> (a, g)
randomIvalIntegral :: (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 :: forall a g m. (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 #-}
{-# SPECIALIZE uniformIntegralM :: StatefulGen g m => (Integer, Integer) -> g -> m Integer #-}
{-# SPECIALIZE uniformIntegralM :: StatefulGen g m => (Natural, Natural) -> g -> m Natural #-}

-- | Generate an integral in the range @[0, s)@ using a variant of Lemire's
-- multiplication method.
--
-- Daniel Lemire. 2019. Fast Random Integer Generation in an Interval. In ACM
-- Transactions on Modeling and Computer Simulation
-- https://doi.org/10.1145/3230636
--
-- PRECONDITION (unchecked): s > 0
boundedExclusiveIntegralM :: forall a g m . (Bits a, Integral a, StatefulGen g m) => a -> g -> m a
boundedExclusiveIntegralM :: 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 #-}

-- | boundedByPowerOf2ExclusiveIntegralM s ~ boundedExclusiveIntegralM (bit s)
boundedByPowerOf2ExclusiveIntegralM ::
  forall a g m. (Bits a, Integral a, StatefulGen g m) => Int -> g -> m a
boundedByPowerOf2ExclusiveIntegralM :: Int -> g -> m a
boundedByPowerOf2ExclusiveIntegralM Int
s g
gen = do
  let n :: Int
n = (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
wordSizeInBits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
wordSizeInBits
  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
  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
x a -> a -> a
forall a. Bits a => a -> a -> a
.&. (Int -> a
forall a. Bits a => Int -> a
bit Int
s a -> a -> a
forall a. Num a => a -> a -> a
- a
1)
{-# INLINE boundedByPowerOf2ExclusiveIntegralM #-}

-- | @integralWordSize i@ returns that least @w@ such that
-- @i <= WORD_SIZE_IN_BITS^w@.
integralWordSize :: (Bits a, Num a) => a -> Int
integralWordSize :: 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 :: forall a g m. (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 :: forall a g m. (Integral a, StatefulGen g m) => (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
{-# INLINE unbiasedWordMult32RM #-}

-- | Uniformly generate Word32 in @[0, s]@.
unbiasedWordMult32 :: forall g m. 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
{-# INLINE unbiasedWordMult32Exclusive #-}

-- | This only works for unsigned integrals
unsignedBitmaskWithRejectionRM ::
     forall a g m . (FiniteBits a, Num a, Ord a, Uniform a, StatefulGen g m)
  => (a, a)
  -> g
  -> m a
unsignedBitmaskWithRejectionRM :: (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 ::
     forall a b g m. (Num a, Num b, Ord b, Ord a, FiniteBits a, StatefulGen g m, Uniform a)
  => (b -> a) -- ^ Convert signed to unsigned. @a@ and @b@ must be of the same size.
  -> (a -> b) -- ^ Convert unsigned to signed. @a@ and @b@ must be of the same size.
  -> (b, b) -- ^ Range.
  -> g -- ^ Generator.
  -> m b
signedBitmaskWithRejectionRM :: (b -> a) -> (a -> b) -> (b, b) -> g -> m 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 -> m 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) -> m a -> m b
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
    -- 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
  {-# INLINE uniformM #-}

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
  {-# INLINE uniformM #-}

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
  {-# INLINE uniformM #-}

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
  {-# INLINE uniformM #-}

instance (Uniform a, Uniform b, Uniform c, Uniform d, Uniform e, Uniform f) =>
  Uniform (a, b, c, d, e, f) where
  uniformM :: g -> 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
  {-# INLINE uniformM #-}

instance (Uniform a, Uniform b, Uniform c, Uniform d, Uniform e, Uniform f, Uniform g) =>
  Uniform (a, b, c, d, e, f, g) where
  uniformM :: g -> 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
  {-# INLINE uniformM #-}

-- Appendix 1.
--
-- @top@ and @bottom@ are signed integers of bit width @n@. @toUnsigned@
-- converts a signed integer to an unsigned number of the same bit width @n@.
--
--     range = toUnsigned top - toUnsigned bottom
--
-- This works out correctly thanks to modular arithmetic. Conceptually,
--
--     toUnsigned x | x >= 0 = x
--     toUnsigned x | x <  0 = 2^n + x
--
-- The following combinations are possible:
--
-- 1. @bottom >= 0@ and @top >= 0@
-- 2. @bottom < 0@ and @top >= 0@
-- 3. @bottom < 0@ and @top < 0@
--
-- Note that @bottom >= 0@ and @top < 0@ is impossible because of the
-- invariant @bottom < top@.
--
-- For any signed integer @i@ of width @n@, we have:
--
--     -2^(n-1) <= i <= 2^(n-1) - 1
--
-- Considering each combination in turn, we have
--
-- 1. @bottom >= 0@ and @top >= 0@
--
--     range = (toUnsigned top - toUnsigned bottom) `mod` 2^n
--                 --^ top    >= 0, so toUnsigned top    == top
--                 --^ bottom >= 0, so toUnsigned bottom == bottom
--           = (top - bottom) `mod` 2^n
--                 --^ top <= 2^(n-1) - 1 and bottom >= 0
--                 --^ top - bottom <= 2^(n-1) - 1
--                 --^ 0 < top - bottom <= 2^(n-1) - 1
--           = top - bottom
--
-- 2. @bottom < 0@ and @top >= 0@
--
--     range = (toUnsigned top - toUnsigned bottom) `mod` 2^n
--                 --^ top    >= 0, so toUnsigned top    == top
--                 --^ bottom <  0, so toUnsigned bottom == 2^n + bottom
--           = (top - (2^n + bottom)) `mod` 2^n
--                 --^ summand -2^n cancels out in calculation modulo 2^n
--           = (top - bottom) `mod` 2^n
--                 --^ top <= 2^(n-1) - 1 and bottom >= -2^(n-1)
--                 --^ top - bottom <= (2^(n-1) - 1) - (-2^(n-1)) = 2^n - 1
--                 --^ 0 < top - bottom <= 2^n - 1
--           = top - bottom
--
-- 3. @bottom < 0@ and @top < 0@
--
--     range = (toUnsigned top - toUnsigned bottom) `mod` 2^n
--                 --^ top    < 0, so toUnsigned top    == 2^n + top
--                 --^ bottom < 0, so toUnsigned bottom == 2^n + bottom
--           = ((2^n + top) - (2^n + bottom)) `mod` 2^n
--                 --^ summand 2^n cancels out in calculation modulo 2^n
--           = (top - bottom) `mod` 2^n
--                 --^ top <= -1
--                 --^ bottom >= -2^(n-1)
--                 --^ top - bottom <= -1 - (-2^(n-1)) = 2^(n-1) - 1
--                 --^ 0 < top - bottom <= 2^(n-1) - 1
--           = top - bottom