{-# LANGUAGE BangPatterns, CPP, DeriveDataTypeable, FlexibleContexts,
MagicHash, Rank2Types, ScopedTypeVariables, TypeFamilies, UnboxedTuples
#-}
module System.Random.MWC
(
Gen
, create
, initialize
, withSystemRandom
, createSystemRandom
, GenIO
, GenST
, asGenIO
, asGenST
, Variate(..)
, uniformVector
, Seed
, fromSeed
, toSeed
, save
, restore
) where
#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
#include "MachDeps.h"
#endif
import Control.Monad (ap, liftM, unless)
import Control.Monad.Primitive (PrimMonad, PrimBase, PrimState, unsafePrimToIO)
import Control.Monad.ST (ST)
import Data.Bits ((.&.), (.|.), shiftL, shiftR, xor)
import Data.Int (Int8, Int16, Int32, Int64)
import Data.IORef (atomicModifyIORef, newIORef)
import Data.Typeable (Typeable)
import Data.Vector.Generic (Vector)
import Data.Word
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Unboxed as I
import qualified Data.Vector.Unboxed.Mutable as M
import System.IO (hPutStrLn, stderr)
import System.IO.Unsafe (unsafePerformIO)
import qualified Control.Exception as E
#if defined(mingw32_HOST_OS)
import Foreign.Ptr
import Foreign.C.Types
#endif
import System.Random.MWC.SeedSource
class Variate a where
uniform :: (PrimMonad m) => Gen (PrimState m) -> m a
uniformR :: (PrimMonad m) => (a,a) -> Gen (PrimState m) -> m a
instance Variate Int8 where
uniform :: Gen (PrimState m) -> m Int8
uniform = (Word32 -> Int8) -> Gen (PrimState m) -> m Int8
forall (m :: * -> *) a.
PrimMonad m =>
(Word32 -> a) -> Gen (PrimState m) -> m a
uniform1 Word32 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
uniformR :: (Int8, Int8) -> Gen (PrimState m) -> m Int8
uniformR a :: (Int8, Int8)
a b :: Gen (PrimState m)
b = (Int8, Int8) -> Gen (PrimState m) -> m Int8
forall (m :: * -> *) a.
(PrimMonad m, Integral a, Bounded a, Variate a,
Integral (Unsigned a), Bounded (Unsigned a),
Variate (Unsigned a)) =>
(a, a) -> Gen (PrimState m) -> m a
uniformRange (Int8, Int8)
a Gen (PrimState m)
b
{-# INLINE uniform #-}
{-# INLINE uniformR #-}
instance Variate Int16 where
uniform :: Gen (PrimState m) -> m Int16
uniform = (Word32 -> Int16) -> Gen (PrimState m) -> m Int16
forall (m :: * -> *) a.
PrimMonad m =>
(Word32 -> a) -> Gen (PrimState m) -> m a
uniform1 Word32 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
uniformR :: (Int16, Int16) -> Gen (PrimState m) -> m Int16
uniformR a :: (Int16, Int16)
a b :: Gen (PrimState m)
b = (Int16, Int16) -> Gen (PrimState m) -> m Int16
forall (m :: * -> *) a.
(PrimMonad m, Integral a, Bounded a, Variate a,
Integral (Unsigned a), Bounded (Unsigned a),
Variate (Unsigned a)) =>
(a, a) -> Gen (PrimState m) -> m a
uniformRange (Int16, Int16)
a Gen (PrimState m)
b
{-# INLINE uniform #-}
{-# INLINE uniformR #-}
instance Variate Int32 where
uniform :: Gen (PrimState m) -> m Int32
uniform = (Word32 -> Int32) -> Gen (PrimState m) -> m Int32
forall (m :: * -> *) a.
PrimMonad m =>
(Word32 -> a) -> Gen (PrimState m) -> m a
uniform1 Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
uniformR :: (Int32, Int32) -> Gen (PrimState m) -> m Int32
uniformR a :: (Int32, Int32)
a b :: Gen (PrimState m)
b = (Int32, Int32) -> Gen (PrimState m) -> m Int32
forall (m :: * -> *) a.
(PrimMonad m, Integral a, Bounded a, Variate a,
Integral (Unsigned a), Bounded (Unsigned a),
Variate (Unsigned a)) =>
(a, a) -> Gen (PrimState m) -> m a
uniformRange (Int32, Int32)
a Gen (PrimState m)
b
{-# INLINE uniform #-}
{-# INLINE uniformR #-}
instance Variate Int64 where
uniform :: Gen (PrimState m) -> m Int64
uniform = (Word32 -> Word32 -> Int64) -> Gen (PrimState m) -> m Int64
forall (m :: * -> *) a.
PrimMonad m =>
(Word32 -> Word32 -> a) -> Gen (PrimState m) -> m a
uniform2 Word32 -> Word32 -> Int64
forall a. Integral a => Word32 -> Word32 -> a
wordsTo64Bit
uniformR :: (Int64, Int64) -> Gen (PrimState m) -> m Int64
uniformR a :: (Int64, Int64)
a b :: Gen (PrimState m)
b = (Int64, Int64) -> Gen (PrimState m) -> m Int64
forall (m :: * -> *) a.
(PrimMonad m, Integral a, Bounded a, Variate a,
Integral (Unsigned a), Bounded (Unsigned a),
Variate (Unsigned a)) =>
(a, a) -> Gen (PrimState m) -> m a
uniformRange (Int64, Int64)
a Gen (PrimState m)
b
{-# INLINE uniform #-}
{-# INLINE uniformR #-}
instance Variate Word8 where
uniform :: Gen (PrimState m) -> m Word8
uniform = (Word32 -> Word8) -> Gen (PrimState m) -> m Word8
forall (m :: * -> *) a.
PrimMonad m =>
(Word32 -> a) -> Gen (PrimState m) -> m a
uniform1 Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
uniformR :: (Word8, Word8) -> Gen (PrimState m) -> m Word8
uniformR a :: (Word8, Word8)
a b :: Gen (PrimState m)
b = (Word8, Word8) -> Gen (PrimState m) -> m Word8
forall (m :: * -> *) a.
(PrimMonad m, Integral a, Bounded a, Variate a,
Integral (Unsigned a), Bounded (Unsigned a),
Variate (Unsigned a)) =>
(a, a) -> Gen (PrimState m) -> m a
uniformRange (Word8, Word8)
a Gen (PrimState m)
b
{-# INLINE uniform #-}
{-# INLINE uniformR #-}
instance Variate Word16 where
uniform :: Gen (PrimState m) -> m Word16
uniform = (Word32 -> Word16) -> Gen (PrimState m) -> m Word16
forall (m :: * -> *) a.
PrimMonad m =>
(Word32 -> a) -> Gen (PrimState m) -> m a
uniform1 Word32 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
uniformR :: (Word16, Word16) -> Gen (PrimState m) -> m Word16
uniformR a :: (Word16, Word16)
a b :: Gen (PrimState m)
b = (Word16, Word16) -> Gen (PrimState m) -> m Word16
forall (m :: * -> *) a.
(PrimMonad m, Integral a, Bounded a, Variate a,
Integral (Unsigned a), Bounded (Unsigned a),
Variate (Unsigned a)) =>
(a, a) -> Gen (PrimState m) -> m a
uniformRange (Word16, Word16)
a Gen (PrimState m)
b
{-# INLINE uniform #-}
{-# INLINE uniformR #-}
instance Variate Word32 where
uniform :: Gen (PrimState m) -> m Word32
uniform = (Word32 -> Word32) -> Gen (PrimState m) -> m Word32
forall (m :: * -> *) a.
PrimMonad m =>
(Word32 -> a) -> Gen (PrimState m) -> m a
uniform1 Word32 -> Word32
forall a. a -> a
id
uniformR :: (Word32, Word32) -> Gen (PrimState m) -> m Word32
uniformR a :: (Word32, Word32)
a b :: Gen (PrimState m)
b = (Word32, Word32) -> Gen (PrimState m) -> m Word32
forall (m :: * -> *) a.
(PrimMonad m, Integral a, Bounded a, Variate a,
Integral (Unsigned a), Bounded (Unsigned a),
Variate (Unsigned a)) =>
(a, a) -> Gen (PrimState m) -> m a
uniformRange (Word32, Word32)
a Gen (PrimState m)
b
{-# INLINE uniform #-}
{-# INLINE uniformR #-}
instance Variate Word64 where
uniform :: Gen (PrimState m) -> m Word64
uniform = (Word32 -> Word32 -> Word64) -> Gen (PrimState m) -> m Word64
forall (m :: * -> *) a.
PrimMonad m =>
(Word32 -> Word32 -> a) -> Gen (PrimState m) -> m a
uniform2 Word32 -> Word32 -> Word64
forall a. Integral a => Word32 -> Word32 -> a
wordsTo64Bit
uniformR :: (Word64, Word64) -> Gen (PrimState m) -> m Word64
uniformR a :: (Word64, Word64)
a b :: Gen (PrimState m)
b = (Word64, Word64) -> Gen (PrimState m) -> m Word64
forall (m :: * -> *) a.
(PrimMonad m, Integral a, Bounded a, Variate a,
Integral (Unsigned a), Bounded (Unsigned a),
Variate (Unsigned a)) =>
(a, a) -> Gen (PrimState m) -> m a
uniformRange (Word64, Word64)
a Gen (PrimState m)
b
{-# INLINE uniform #-}
{-# INLINE uniformR #-}
instance Variate Bool where
uniform :: Gen (PrimState m) -> m Bool
uniform = (Word32 -> Bool) -> Gen (PrimState m) -> m Bool
forall (m :: * -> *) a.
PrimMonad m =>
(Word32 -> a) -> Gen (PrimState m) -> m a
uniform1 Word32 -> Bool
wordToBool
uniformR :: (Bool, Bool) -> Gen (PrimState m) -> m Bool
uniformR (False,True) g :: Gen (PrimState m)
g = Gen (PrimState m) -> m Bool
forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
Gen (PrimState m) -> m a
uniform Gen (PrimState m)
g
uniformR (False,False) _ = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
uniformR (True,True) _ = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
uniformR (True,False) g :: Gen (PrimState m)
g = Gen (PrimState m) -> m Bool
forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
Gen (PrimState m) -> m a
uniform Gen (PrimState m)
g
{-# INLINE uniform #-}
{-# INLINE uniformR #-}
instance Variate Float where
uniform :: Gen (PrimState m) -> m Float
uniform = (Word32 -> Float) -> Gen (PrimState m) -> m Float
forall (m :: * -> *) a.
PrimMonad m =>
(Word32 -> a) -> Gen (PrimState m) -> m a
uniform1 Word32 -> Float
wordToFloat
uniformR :: (Float, Float) -> Gen (PrimState m) -> m Float
uniformR (x1 :: Float
x1,x2 :: Float
x2) = (Word32 -> Float) -> Gen (PrimState m) -> m Float
forall (m :: * -> *) a.
PrimMonad m =>
(Word32 -> a) -> Gen (PrimState m) -> m a
uniform1 (\w :: Word32
w -> Float
x1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ (Float
x2Float -> Float -> Float
forall a. Num a => a -> a -> a
-Float
x1) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Word32 -> Float
wordToFloat Word32
w)
{-# INLINE uniform #-}
{-# INLINE uniformR #-}
instance Variate Double where
uniform :: Gen (PrimState m) -> m Double
uniform = (Word32 -> Word32 -> Double) -> Gen (PrimState m) -> m Double
forall (m :: * -> *) a.
PrimMonad m =>
(Word32 -> Word32 -> a) -> Gen (PrimState m) -> m a
uniform2 Word32 -> Word32 -> Double
wordsToDouble
uniformR :: (Double, Double) -> Gen (PrimState m) -> m Double
uniformR (x1 :: Double
x1,x2 :: Double
x2) = (Word32 -> Word32 -> Double) -> Gen (PrimState m) -> m Double
forall (m :: * -> *) a.
PrimMonad m =>
(Word32 -> Word32 -> a) -> Gen (PrimState m) -> m a
uniform2 (\w1 :: Word32
w1 w2 :: Word32
w2 -> Double
x1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
x2Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
x1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Word32 -> Word32 -> Double
wordsToDouble Word32
w1 Word32
w2)
{-# INLINE uniform #-}
{-# INLINE uniformR #-}
instance Variate Int where
#if WORD_SIZE_IN_BITS < 64
uniform = uniform1 fromIntegral
#else
uniform :: Gen (PrimState m) -> m Int
uniform = (Word32 -> Word32 -> Int) -> Gen (PrimState m) -> m Int
forall (m :: * -> *) a.
PrimMonad m =>
(Word32 -> Word32 -> a) -> Gen (PrimState m) -> m a
uniform2 Word32 -> Word32 -> Int
forall a. Integral a => Word32 -> Word32 -> a
wordsTo64Bit
#endif
uniformR :: (Int, Int) -> Gen (PrimState m) -> m Int
uniformR a :: (Int, Int)
a b :: Gen (PrimState m)
b = (Int, Int) -> Gen (PrimState m) -> m Int
forall (m :: * -> *) a.
(PrimMonad m, Integral a, Bounded a, Variate a,
Integral (Unsigned a), Bounded (Unsigned a),
Variate (Unsigned a)) =>
(a, a) -> Gen (PrimState m) -> m a
uniformRange (Int, Int)
a Gen (PrimState m)
b
{-# INLINE uniform #-}
{-# INLINE uniformR #-}
instance Variate Word where
#if WORD_SIZE_IN_BITS < 64
uniform = uniform1 fromIntegral
#else
uniform :: Gen (PrimState m) -> m Word
uniform = (Word32 -> Word32 -> Word) -> Gen (PrimState m) -> m Word
forall (m :: * -> *) a.
PrimMonad m =>
(Word32 -> Word32 -> a) -> Gen (PrimState m) -> m a
uniform2 Word32 -> Word32 -> Word
forall a. Integral a => Word32 -> Word32 -> a
wordsTo64Bit
#endif
uniformR :: (Word, Word) -> Gen (PrimState m) -> m Word
uniformR a :: (Word, Word)
a b :: Gen (PrimState m)
b = (Word, Word) -> Gen (PrimState m) -> m Word
forall (m :: * -> *) a.
(PrimMonad m, Integral a, Bounded a, Variate a,
Integral (Unsigned a), Bounded (Unsigned a),
Variate (Unsigned a)) =>
(a, a) -> Gen (PrimState m) -> m a
uniformRange (Word, Word)
a Gen (PrimState m)
b
{-# INLINE uniform #-}
{-# INLINE uniformR #-}
instance (Variate a, Variate b) => Variate (a,b) where
uniform :: Gen (PrimState m) -> m (a, b)
uniform g :: Gen (PrimState m)
g = (,) (a -> b -> (a, b)) -> m a -> m (b -> (a, b))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Gen (PrimState m) -> m a
forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
Gen (PrimState m) -> m a
uniform Gen (PrimState m)
g m (b -> (a, b)) -> m b -> m (a, b)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` Gen (PrimState m) -> m b
forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
Gen (PrimState m) -> m a
uniform Gen (PrimState m)
g
uniformR :: ((a, b), (a, b)) -> Gen (PrimState m) -> m (a, b)
uniformR ((x1 :: a
x1,y1 :: b
y1),(x2 :: a
x2,y2 :: b
y2)) g :: Gen (PrimState m)
g = (,) (a -> b -> (a, b)) -> m a -> m (b -> (a, b))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` (a, a) -> Gen (PrimState m) -> m a
forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
(a, a) -> Gen (PrimState m) -> m a
uniformR (a
x1,a
x2) Gen (PrimState m)
g m (b -> (a, b)) -> m b -> m (a, b)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` (b, b) -> Gen (PrimState m) -> m b
forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
(a, a) -> Gen (PrimState m) -> m a
uniformR (b
y1,b
y2) Gen (PrimState m)
g
{-# INLINE uniform #-}
{-# INLINE uniformR #-}
instance (Variate a, Variate b, Variate c) => Variate (a,b,c) where
uniform :: Gen (PrimState m) -> m (a, b, c)
uniform g :: Gen (PrimState m)
g = (,,) (a -> b -> c -> (a, b, c)) -> m a -> m (b -> c -> (a, b, c))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Gen (PrimState m) -> m a
forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
Gen (PrimState m) -> m a
uniform Gen (PrimState m)
g m (b -> c -> (a, b, c)) -> m b -> m (c -> (a, b, c))
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` Gen (PrimState m) -> m b
forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
Gen (PrimState m) -> m a
uniform Gen (PrimState m)
g m (c -> (a, b, c)) -> m c -> m (a, b, c)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` Gen (PrimState m) -> m c
forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
Gen (PrimState m) -> m a
uniform Gen (PrimState m)
g
uniformR :: ((a, b, c), (a, b, c)) -> Gen (PrimState m) -> m (a, b, c)
uniformR ((x1 :: a
x1,y1 :: b
y1,z1 :: c
z1),(x2 :: a
x2,y2 :: b
y2,z2 :: c
z2)) g :: Gen (PrimState m)
g =
(,,) (a -> b -> c -> (a, b, c)) -> m a -> m (b -> c -> (a, b, c))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` (a, a) -> Gen (PrimState m) -> m a
forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
(a, a) -> Gen (PrimState m) -> m a
uniformR (a
x1,a
x2) Gen (PrimState m)
g m (b -> c -> (a, b, c)) -> m b -> m (c -> (a, b, c))
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` (b, b) -> Gen (PrimState m) -> m b
forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
(a, a) -> Gen (PrimState m) -> m a
uniformR (b
y1,b
y2) Gen (PrimState m)
g m (c -> (a, b, c)) -> m c -> m (a, b, c)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` (c, c) -> Gen (PrimState m) -> m c
forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
(a, a) -> Gen (PrimState m) -> m a
uniformR (c
z1,c
z2) Gen (PrimState m)
g
{-# INLINE uniform #-}
{-# INLINE uniformR #-}
instance (Variate a, Variate b, Variate c, Variate d) => Variate (a,b,c,d) where
uniform :: Gen (PrimState m) -> m (a, b, c, d)
uniform g :: Gen (PrimState m)
g = (,,,) (a -> b -> c -> d -> (a, b, c, d))
-> m a -> m (b -> c -> d -> (a, b, c, d))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Gen (PrimState m) -> m a
forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
Gen (PrimState m) -> m a
uniform Gen (PrimState m)
g m (b -> c -> d -> (a, b, c, d))
-> m b -> m (c -> d -> (a, b, c, d))
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` Gen (PrimState m) -> m b
forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
Gen (PrimState m) -> m a
uniform Gen (PrimState m)
g m (c -> d -> (a, b, c, d)) -> m c -> m (d -> (a, b, c, d))
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` Gen (PrimState m) -> m c
forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
Gen (PrimState m) -> m a
uniform Gen (PrimState m)
g
m (d -> (a, b, c, d)) -> m d -> m (a, b, c, d)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` Gen (PrimState m) -> m d
forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
Gen (PrimState m) -> m a
uniform Gen (PrimState m)
g
uniformR :: ((a, b, c, d), (a, b, c, d)) -> Gen (PrimState m) -> m (a, b, c, d)
uniformR ((x1 :: a
x1,y1 :: b
y1,z1 :: c
z1,t1 :: d
t1),(x2 :: a
x2,y2 :: b
y2,z2 :: c
z2,t2 :: d
t2)) g :: Gen (PrimState m)
g =
(,,,) (a -> b -> c -> d -> (a, b, c, d))
-> m a -> m (b -> c -> d -> (a, b, c, d))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` (a, a) -> Gen (PrimState m) -> m a
forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
(a, a) -> Gen (PrimState m) -> m a
uniformR (a
x1,a
x2) Gen (PrimState m)
g m (b -> c -> d -> (a, b, c, d))
-> m b -> m (c -> d -> (a, b, c, d))
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` (b, b) -> Gen (PrimState m) -> m b
forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
(a, a) -> Gen (PrimState m) -> m a
uniformR (b
y1,b
y2) Gen (PrimState m)
g m (c -> d -> (a, b, c, d)) -> m c -> m (d -> (a, b, c, d))
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap`
(c, c) -> Gen (PrimState m) -> m c
forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
(a, a) -> Gen (PrimState m) -> m a
uniformR (c
z1,c
z2) Gen (PrimState m)
g m (d -> (a, b, c, d)) -> m d -> m (a, b, c, d)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` (d, d) -> Gen (PrimState m) -> m d
forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
(a, a) -> Gen (PrimState m) -> m a
uniformR (d
t1,d
t2) Gen (PrimState m)
g
{-# INLINE uniform #-}
{-# INLINE uniformR #-}
wordsTo64Bit :: (Integral a) => Word32 -> Word32 -> a
wordsTo64Bit :: Word32 -> Word32 -> a
wordsTo64Bit x :: Word32
x y :: Word32
y =
Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` 32) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
y :: Word64)
{-# INLINE wordsTo64Bit #-}
wordToBool :: Word32 -> Bool
wordToBool :: Word32 -> Bool
wordToBool i :: Word32
i = (Word32
i Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. 1) Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= 0
{-# INLINE wordToBool #-}
wordToFloat :: Word32 -> Float
wordToFloat :: Word32 -> Float
wordToFloat x :: Word32
x = (Int32 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
m_inv_32) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ 0.5 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
m_inv_33
where m_inv_33 :: Float
m_inv_33 = 1.16415321826934814453125e-10
m_inv_32 :: Float
m_inv_32 = 2.3283064365386962890625e-10
i :: Int32
i = Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x :: Int32
{-# INLINE wordToFloat #-}
wordsToDouble :: Word32 -> Word32 -> Double
wordsToDouble :: Word32 -> Word32 -> Double
wordsToDouble x :: Word32
x y :: Word32
y = (Int32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
u Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
m_inv_32 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
m_inv_53) Double -> Double -> Double
forall a. Num a => a -> a -> a
+
Int32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32
v Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
.&. 0xFFFFF) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
m_inv_52)
where m_inv_52 :: Double
m_inv_52 = 2.220446049250313080847263336181640625e-16
m_inv_53 :: Double
m_inv_53 = 1.1102230246251565404236316680908203125e-16
m_inv_32 :: Double
m_inv_32 = 2.3283064365386962890625e-10
u :: Int32
u = Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x :: Int32
v :: Int32
v = Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
y :: Int32
{-# INLINE wordsToDouble #-}
newtype Gen s = Gen (M.MVector s Word32)
type GenIO = Gen (PrimState IO)
type GenST s = Gen (PrimState (ST s))
asGenIO :: (GenIO -> IO a) -> (GenIO -> IO a)
asGenIO :: (GenIO -> IO a) -> GenIO -> IO a
asGenIO = (GenIO -> IO a) -> GenIO -> IO a
forall a. a -> a
id
asGenST :: (GenST s -> ST s a) -> (GenST s -> ST s a)
asGenST :: (GenST s -> ST s a) -> GenST s -> ST s a
asGenST = (GenST s -> ST s a) -> GenST s -> ST s a
forall a. a -> a
id
ioff, coff :: Int
ioff :: Int
ioff = 256
coff :: Int
coff = 257
create :: PrimMonad m => m (Gen (PrimState m))
create :: m (Gen (PrimState m))
create = Vector Word32 -> m (Gen (PrimState m))
forall (m :: * -> *) (v :: * -> *).
(PrimMonad m, Vector v Word32) =>
v Word32 -> m (Gen (PrimState m))
initialize Vector Word32
defaultSeed
{-# INLINE create #-}
initialize :: (PrimMonad m, Vector v Word32) =>
v Word32 -> m (Gen (PrimState m))
initialize :: v Word32 -> m (Gen (PrimState m))
initialize seed :: v Word32
seed = do
MVector (PrimState m) Word32
q <- Int -> m (MVector (PrimState m) Word32)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
M.unsafeNew 258
MVector (PrimState m) Word32 -> m ()
fill MVector (PrimState m) Word32
q
if Int
fini Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 258
then do
MVector (PrimState m) Word32 -> Int -> Word32 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Word32
q Int
ioff (Word32 -> m ()) -> Word32 -> m ()
forall a b. (a -> b) -> a -> b
$ v Word32 -> Int -> Word32
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
G.unsafeIndex v Word32
seed Int
ioff Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. 255
MVector (PrimState m) Word32 -> Int -> Word32 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Word32
q Int
coff (Word32 -> m ()) -> Word32 -> m ()
forall a b. (a -> b) -> a -> b
$ v Word32 -> Int -> Word32
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
G.unsafeIndex v Word32
seed Int
coff Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`mod` Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
aa
else do
MVector (PrimState m) Word32 -> Int -> Word32 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Word32
q Int
ioff 255
MVector (PrimState m) Word32 -> Int -> Word32 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Word32
q Int
coff 362436
Gen (PrimState m) -> m (Gen (PrimState m))
forall (m :: * -> *) a. Monad m => a -> m a
return (MVector (PrimState m) Word32 -> Gen (PrimState m)
forall s. MVector s Word32 -> Gen s
Gen MVector (PrimState m) Word32
q)
where fill :: MVector (PrimState m) Word32 -> m ()
fill q :: MVector (PrimState m) Word32
q = Int -> m ()
go 0 where
go :: Int -> m ()
go i :: Int
i | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 256 = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = MVector (PrimState m) Word32 -> Int -> Word32 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Word32
q Int
i Word32
s m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> m ()
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
where s :: Word32
s | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
fini = if Int
fini Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
then Vector Word32 -> Int -> Word32
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
G.unsafeIndex Vector Word32
defaultSeed Int
i
else Vector Word32 -> Int -> Word32
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
G.unsafeIndex Vector Word32
defaultSeed Int
i Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor`
v Word32 -> Int -> Word32
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
G.unsafeIndex v Word32
seed (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
fini)
| Bool
otherwise = v Word32 -> Int -> Word32
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
G.unsafeIndex v Word32
seed Int
i
fini :: Int
fini = v Word32 -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
G.length v Word32
seed
{-# INLINE initialize #-}
newtype Seed = Seed {
Seed -> Vector Word32
fromSeed :: I.Vector Word32
}
deriving (Seed -> Seed -> Bool
(Seed -> Seed -> Bool) -> (Seed -> Seed -> Bool) -> Eq Seed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Seed -> Seed -> Bool
$c/= :: Seed -> Seed -> Bool
== :: Seed -> Seed -> Bool
$c== :: Seed -> Seed -> Bool
Eq, Int -> Seed -> ShowS
[Seed] -> ShowS
Seed -> String
(Int -> Seed -> ShowS)
-> (Seed -> String) -> ([Seed] -> ShowS) -> Show Seed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Seed] -> ShowS
$cshowList :: [Seed] -> ShowS
show :: Seed -> String
$cshow :: Seed -> String
showsPrec :: Int -> Seed -> ShowS
$cshowsPrec :: Int -> Seed -> ShowS
Show, Typeable)
toSeed :: (Vector v Word32) => v Word32 -> Seed
toSeed :: v Word32 -> Seed
toSeed v :: v Word32
v = Vector Word32 -> Seed
Seed (Vector Word32 -> Seed) -> Vector Word32 -> Seed
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (MVector s Word32)) -> Vector Word32
forall a. Unbox a => (forall s. ST s (MVector s a)) -> Vector a
I.create ((forall s. ST s (MVector s Word32)) -> Vector Word32)
-> (forall s. ST s (MVector s Word32)) -> Vector Word32
forall a b. (a -> b) -> a -> b
$ do { Gen q :: MVector s Word32
q <- v Word32 -> ST s (Gen (PrimState (ST s)))
forall (m :: * -> *) (v :: * -> *).
(PrimMonad m, Vector v Word32) =>
v Word32 -> m (Gen (PrimState m))
initialize v Word32
v; MVector s Word32 -> ST s (MVector s Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return MVector s Word32
q }
save :: PrimMonad m => Gen (PrimState m) -> m Seed
save :: Gen (PrimState m) -> m Seed
save (Gen q :: MVector (PrimState m) Word32
q) = Vector Word32 -> Seed
Seed (Vector Word32 -> Seed) -> m (Vector Word32) -> m Seed
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Mutable Vector (PrimState m) Word32 -> m (Vector Word32)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
G.freeze MVector (PrimState m) Word32
Mutable Vector (PrimState m) Word32
q
{-# INLINE save #-}
restore :: PrimMonad m => Seed -> m (Gen (PrimState m))
restore :: Seed -> m (Gen (PrimState m))
restore (Seed s :: Vector Word32
s) = MVector (PrimState m) Word32 -> Gen (PrimState m)
forall s. MVector s Word32 -> Gen s
Gen (MVector (PrimState m) Word32 -> Gen (PrimState m))
-> m (MVector (PrimState m) Word32) -> m (Gen (PrimState m))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Vector Word32 -> m (Mutable Vector (PrimState m) Word32)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
v a -> m (Mutable v (PrimState m) a)
G.thaw Vector Word32
s
{-# INLINE restore #-}
withSystemRandom :: PrimBase m
=> (Gen (PrimState m) -> m a) -> IO a
withSystemRandom :: (Gen (PrimState m) -> m a) -> IO a
withSystemRandom act :: Gen (PrimState m) -> m a
act = do
[Word32]
seed <- Int -> IO [Word32]
forall a. Storable a => Int -> IO [a]
acquireSeedSystem 256 IO [Word32] -> (IOException -> IO [Word32]) -> IO [Word32]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \(IOException
_::E.IOException) -> do
Bool
seen <- IORef Bool -> (Bool -> (Bool, Bool)) -> IO Bool
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef Bool
warned ((,) Bool
True)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
seen (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (IOException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle (\(IOException
_::E.IOException) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Warning: Couldn't use randomness source " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
randomSourceName
Handle -> String -> IO ()
hPutStrLn Handle
stderr ("Warning: using system clock for seed instead " String -> ShowS
forall a. [a] -> [a] -> [a]
++
"(quality will be lower)")
IO [Word32]
acquireSeedTime
m a -> IO a
forall (m :: * -> *) a. PrimBase m => m a -> IO a
unsafePrimToIO (m a -> IO a) -> m a -> IO a
forall a b. (a -> b) -> a -> b
$ Vector Word32 -> m (Gen (PrimState m))
forall (m :: * -> *) (v :: * -> *).
(PrimMonad m, Vector v Word32) =>
v Word32 -> m (Gen (PrimState m))
initialize ([Word32] -> Vector Word32
forall a. Unbox a => [a] -> Vector a
I.fromList [Word32]
seed) m (Gen (PrimState m)) -> (Gen (PrimState m) -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Gen (PrimState m) -> m a
act
where
warned :: IORef Bool
warned = IO (IORef Bool) -> IORef Bool
forall a. IO a -> a
unsafePerformIO (IO (IORef Bool) -> IORef Bool) -> IO (IORef Bool) -> IORef Bool
forall a b. (a -> b) -> a -> b
$ Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
{-# NOINLINE warned #-}
createSystemRandom :: IO GenIO
createSystemRandom :: IO GenIO
createSystemRandom = (GenIO -> IO (Gen RealWorld)) -> IO (Gen RealWorld)
forall (m :: * -> *) a.
PrimBase m =>
(Gen (PrimState m) -> m a) -> IO a
withSystemRandom (GenIO -> IO GenIO
forall (m :: * -> *) a. Monad m => a -> m a
return :: GenIO -> IO GenIO)
nextIndex :: Integral a => a -> Int
nextIndex :: a -> Int
nextIndex i :: a
i = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
j
where j :: Word8
j = a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
ia -> a -> a
forall a. Num a => a -> a -> a
+1) :: Word8
{-# INLINE nextIndex #-}
aa :: Word64
aa :: Word64
aa = 1540315826
{-# INLINE aa #-}
uniformWord32 :: PrimMonad m => Gen (PrimState m) -> m Word32
uniformWord32 :: Gen (PrimState m) -> m Word32
uniformWord32 (Gen q :: MVector (PrimState m) Word32
q) = do
Int
i <- Word32 -> Int
forall a. Integral a => a -> Int
nextIndex (Word32 -> Int) -> m Word32 -> m Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector (PrimState m) Word32 -> Int -> m Word32
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Word32
q Int
ioff
Word64
c <- Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> m Word32 -> m Word64
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector (PrimState m) Word32 -> Int -> m Word32
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Word32
q Int
coff
Word64
qi <- Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> m Word32 -> m Word64
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector (PrimState m) Word32 -> Int -> m Word32
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Word32
q Int
i
let t :: Word64
t = Word64
aa Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
qi Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
c
c' :: Word32
c' = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
t Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` 32)
x :: Word32
x = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
t Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
c'
(# x' :: Word32
x', c'' :: Word32
c'' #) | Word32
x Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
c' = (# Word32
x Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ 1, Word32
c' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ 1 #)
| Bool
otherwise = (# Word32
x, Word32
c' #)
MVector (PrimState m) Word32 -> Int -> Word32 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Word32
q Int
i Word32
x'
MVector (PrimState m) Word32 -> Int -> Word32 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Word32
q Int
ioff (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
MVector (PrimState m) Word32 -> Int -> Word32 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Word32
q Int
coff (Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
c'')
Word32 -> m Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
x'
{-# INLINE uniformWord32 #-}
uniform1 :: PrimMonad m => (Word32 -> a) -> Gen (PrimState m) -> m a
uniform1 :: (Word32 -> a) -> Gen (PrimState m) -> m a
uniform1 f :: Word32 -> a
f gen :: Gen (PrimState m)
gen = do
Word32
i <- Gen (PrimState m) -> m Word32
forall (m :: * -> *). PrimMonad m => Gen (PrimState m) -> m Word32
uniformWord32 Gen (PrimState m)
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
$! Word32 -> a
f Word32
i
{-# INLINE uniform1 #-}
uniform2 :: PrimMonad m => (Word32 -> Word32 -> a) -> Gen (PrimState m) -> m a
uniform2 :: (Word32 -> Word32 -> a) -> Gen (PrimState m) -> m a
uniform2 f :: Word32 -> Word32 -> a
f (Gen q :: MVector (PrimState m) Word32
q) = do
Int
i <- Word32 -> Int
forall a. Integral a => a -> Int
nextIndex (Word32 -> Int) -> m Word32 -> m Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector (PrimState m) Word32 -> Int -> m Word32
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Word32
q Int
ioff
let j :: Int
j = Int -> Int
forall a. Integral a => a -> Int
nextIndex Int
i
Word64
c <- Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> m Word32 -> m Word64
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector (PrimState m) Word32 -> Int -> m Word32
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Word32
q Int
coff
Word64
qi <- Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> m Word32 -> m Word64
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector (PrimState m) Word32 -> Int -> m Word32
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Word32
q Int
i
Word64
qj <- Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> m Word32 -> m Word64
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector (PrimState m) Word32 -> Int -> m Word32
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Word32
q Int
j
let t :: Word64
t = Word64
aa Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
qi Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
c
c' :: Word32
c' = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
t Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` 32)
x :: Word32
x = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
t Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
c'
(# x' :: Word32
x', c'' :: Word32
c'' #) | Word32
x Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
c' = (# Word32
x Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ 1, Word32
c' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ 1 #)
| Bool
otherwise = (# Word32
x, Word32
c' #)
u :: Word64
u = Word64
aa Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
qj Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
c''
d' :: Word32
d' = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
u Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` 32)
y :: Word32
y = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
u Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
d'
(# y' :: Word32
y', d'' :: Word32
d'' #) | Word32
y Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
d' = (# Word32
y Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ 1, Word32
d' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ 1 #)
| Bool
otherwise = (# Word32
y, Word32
d' #)
MVector (PrimState m) Word32 -> Int -> Word32 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Word32
q Int
i Word32
x'
MVector (PrimState m) Word32 -> Int -> Word32 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Word32
q Int
j Word32
y'
MVector (PrimState m) Word32 -> Int -> Word32 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Word32
q Int
ioff (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
j)
MVector (PrimState m) Word32 -> Int -> Word32 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Word32
q Int
coff (Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
d'')
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
$! Word32 -> Word32 -> a
f Word32
x' Word32
y'
{-# INLINE uniform2 #-}
type family Unsigned a :: *
type instance Unsigned Int8 = Word8
type instance Unsigned Int16 = Word16
type instance Unsigned Int32 = Word32
type instance Unsigned Int64 = Word64
type instance Unsigned Word8 = Word8
type instance Unsigned Word16 = Word16
type instance Unsigned Word32 = Word32
type instance Unsigned Word64 = Word64
#if (WORD_SIZE_IN_BITS < 64) && (__GLASGOW_HASKELL__ == 706)
type instance Unsigned Int = Word32
type instance Unsigned Word = Word32
#else
type instance Unsigned Int = Word
type instance Unsigned Word = Word
#endif
sub :: (Integral a, Integral (Unsigned a)) => a -> a -> Unsigned a
sub :: a -> a -> Unsigned a
sub x :: a
x y :: a
y = a -> Unsigned a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x Unsigned a -> Unsigned a -> Unsigned a
forall a. Num a => a -> a -> a
- a -> Unsigned a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y
{-# INLINE sub #-}
add :: (Integral a, Integral (Unsigned a)) => a -> Unsigned a -> a
add :: a -> Unsigned a -> a
add m :: a
m x :: Unsigned a
x = a
m a -> a -> a
forall a. Num a => a -> a -> a
+ Unsigned a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Unsigned a
x
{-# INLINE add #-}
uniformRange :: ( PrimMonad m
, Integral a, Bounded a, Variate a
, Integral (Unsigned a), Bounded (Unsigned a), Variate (Unsigned a))
=> (a,a) -> Gen (PrimState m) -> m a
uniformRange :: (a, a) -> Gen (PrimState m) -> m a
uniformRange (x1 :: a
x1,x2 :: a
x2) g :: Gen (PrimState m)
g
| Unsigned a
n Unsigned a -> Unsigned a -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = Gen (PrimState m) -> m a
forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
Gen (PrimState m) -> m a
uniform Gen (PrimState m)
g
| Bool
otherwise = m a
loop
where
(# i :: a
i, j :: a
j #) | a
x1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
x2 = (# a
x1, a
x2 #)
| Bool
otherwise = (# a
x2, a
x1 #)
n :: Unsigned a
n = 1 Unsigned a -> Unsigned a -> Unsigned a
forall a. Num a => a -> a -> a
+ a -> a -> Unsigned a
forall a.
(Integral a, Integral (Unsigned a)) =>
a -> a -> Unsigned a
sub a
j a
i
buckets :: Unsigned a
buckets = Unsigned a
forall a. Bounded a => a
maxBound Unsigned a -> Unsigned a -> Unsigned a
forall a. Integral a => a -> a -> a
`div` Unsigned a
n
maxN :: Unsigned a
maxN = Unsigned a
buckets Unsigned a -> Unsigned a -> Unsigned a
forall a. Num a => a -> a -> a
* Unsigned a
n
loop :: m a
loop = do Unsigned a
x <- Gen (PrimState m) -> m (Unsigned a)
forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
Gen (PrimState m) -> m a
uniform Gen (PrimState m)
g
if Unsigned a
x Unsigned a -> Unsigned a -> Bool
forall a. Ord a => a -> a -> Bool
< Unsigned a
maxN then 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 -> Unsigned a -> a
forall a.
(Integral a, Integral (Unsigned a)) =>
a -> Unsigned a -> a
add a
i (Unsigned a
x Unsigned a -> Unsigned a -> Unsigned a
forall a. Integral a => a -> a -> a
`div` Unsigned a
buckets)
else m a
loop
{-# INLINE uniformRange #-}
uniformVector :: (PrimMonad m, Variate a, Vector v a)
=> Gen (PrimState m) -> Int -> m (v a)
uniformVector :: Gen (PrimState m) -> Int -> m (v a)
uniformVector gen :: Gen (PrimState m)
gen n :: Int
n = Int -> m a -> m (v a)
forall (m :: * -> *) (v :: * -> *) a.
(Monad m, Vector v a) =>
Int -> m a -> m (v a)
G.replicateM Int
n (Gen (PrimState m) -> m a
forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
Gen (PrimState m) -> m a
uniform Gen (PrimState m)
gen)
{-# INLINE uniformVector #-}
defaultSeed :: I.Vector Word32
defaultSeed :: Vector Word32
defaultSeed = [Word32] -> Vector Word32
forall a. Unbox a => [a] -> Vector a
I.fromList [
0x7042e8b3, 0x06f7f4c5, 0x789ea382, 0x6fb15ad8, 0x54f7a879, 0x0474b184,
0xb3f8f692, 0x4114ea35, 0xb6af0230, 0xebb457d2, 0x47693630, 0x15bc0433,
0x2e1e5b18, 0xbe91129c, 0xcc0815a0, 0xb1260436, 0xd6f605b1, 0xeaadd777,
0x8f59f791, 0xe7149ed9, 0x72d49dd5, 0xd68d9ded, 0xe2a13153, 0x67648eab,
0x48d6a1a1, 0xa69ab6d7, 0x236f34ec, 0x4e717a21, 0x9d07553d, 0x6683a701,
0x19004315, 0x7b6429c5, 0x84964f99, 0x982eb292, 0x3a8be83e, 0xc1df1845,
0x3cf7b527, 0xb66a7d3f, 0xf93f6838, 0x736b1c85, 0x5f0825c1, 0x37e9904b,
0x724cd7b3, 0xfdcb7a46, 0xfdd39f52, 0x715506d5, 0xbd1b6637, 0xadabc0c0,
0x219037fc, 0x9d71b317, 0x3bec717b, 0xd4501d20, 0xd95ea1c9, 0xbe717202,
0xa254bd61, 0xd78a6c5b, 0x043a5b16, 0x0f447a25, 0xf4862a00, 0x48a48b75,
0x1e580143, 0xd5b6a11b, 0x6fb5b0a4, 0x5aaf27f9, 0x668bcd0e, 0x3fdf18fd,
0x8fdcec4a, 0x5255ce87, 0xa1b24dbf, 0x3ee4c2e1, 0x9087eea2, 0xa4131b26,
0x694531a5, 0xa143d867, 0xd9f77c03, 0xf0085918, 0x1e85071c, 0x164d1aba,
0xe61abab5, 0xb8b0c124, 0x84899697, 0xea022359, 0x0cc7fa0c, 0xd6499adf,
0x746da638, 0xd9e5d200, 0xefb3360b, 0x9426716a, 0xabddf8c2, 0xdd1ed9e4,
0x17e1d567, 0xa9a65000, 0x2f37dbc5, 0x9a4b8fd5, 0xaeb22492, 0x0ebe8845,
0xd89dd090, 0xcfbb88c6, 0xb1325561, 0x6d811d90, 0x03aa86f4, 0xbddba397,
0x0986b9ed, 0x6f4cfc69, 0xc02b43bc, 0xee916274, 0xde7d9659, 0x7d3afd93,
0xf52a7095, 0xf21a009c, 0xfd3f795e, 0x98cef25b, 0x6cb3af61, 0x6fa0e310,
0x0196d036, 0xbc198bca, 0x15b0412d, 0xde454349, 0x5719472b, 0x8244ebce,
0xee61afc6, 0xa60c9cb5, 0x1f4d1fd0, 0xe4fb3059, 0xab9ec0f9, 0x8d8b0255,
0x4e7430bf, 0x3a22aa6b, 0x27de22d3, 0x60c4b6e6, 0x0cf61eb3, 0x469a87df,
0xa4da1388, 0xf650f6aa, 0x3db87d68, 0xcdb6964c, 0xb2649b6c, 0x6a880fa9,
0x1b0c845b, 0xe0af2f28, 0xfc1d5da9, 0xf64878a6, 0x667ca525, 0x2114b1ce,
0x2d119ae3, 0x8d29d3bf, 0x1a1b4922, 0x3132980e, 0xd59e4385, 0x4dbd49b8,
0x2de0bb05, 0xd6c96598, 0xb4c527c3, 0xb5562afc, 0x61eeb602, 0x05aa192a,
0x7d127e77, 0xc719222d, 0xde7cf8db, 0x2de439b8, 0x250b5f1a, 0xd7b21053,
0xef6c14a1, 0x2041f80f, 0xc287332e, 0xbb1dbfd3, 0x783bb979, 0x9a2e6327,
0x6eb03027, 0x0225fa2f, 0xa319bc89, 0x864112d4, 0xfe990445, 0xe5e2e07c,
0xf7c6acb8, 0x1bc92142, 0x12e9b40e, 0x2979282d, 0x05278e70, 0xe160ba4c,
0xc1de0909, 0x458b9bf4, 0xbfce9c94, 0xa276f72a, 0x8441597d, 0x67adc2da,
0x6162b854, 0x7f9b2f4a, 0x0d995b6b, 0x193b643d, 0x399362b3, 0x8b653a4b,
0x1028d2db, 0x2b3df842, 0x6eecafaf, 0x261667e9, 0x9c7e8cda, 0x46063eab,
0x7ce7a3a1, 0xadc899c9, 0x017291c4, 0x528d1a93, 0x9a1ee498, 0xbb7d4d43,
0x7837f0ed, 0x34a230cc, 0x614a628d, 0xb03f93b8, 0xd72e3b08, 0x604c98db,
0x3cfacb79, 0x8b81646a, 0xc0f082fa, 0xd1f92388, 0xe5a91e39, 0xf95c756d,
0x1177742f, 0xf8819323, 0x5c060b80, 0x96c1cd8f, 0x47d7b440, 0xbbb84197,
0x35f749cc, 0x95b0e132, 0x8d90ad54, 0x5c3f9423, 0x4994005b, 0xb58f53b9,
0x32df7348, 0x60f61c29, 0x9eae2f32, 0x85a3d398, 0x3b995dd4, 0x94c5e460,
0x8e54b9f3, 0x87bc6e2a, 0x90bbf1ea, 0x55d44719, 0x2cbbfe6e, 0x439d82f0,
0x4eb3782d, 0xc3f1e669, 0x61ff8d9e, 0x0909238d, 0xef406165, 0x09c1d762,
0x705d184f, 0x188f2cc4, 0x9c5aa12a, 0xc7a5d70e, 0xbc78cb1b, 0x1d26ae62,
0x23f96ae3, 0xd456bf32, 0xe4654f55, 0x31462bd8 ]
{-# NOINLINE defaultSeed #-}