-- |
-- /SplitMix/ is a splittable pseudorandom number generator (PRNG) that is quite fast.
--
-- Guy L. Steele, Jr., Doug Lea, and Christine H. Flood. 2014.
--  Fast splittable pseudorandom number generators. In Proceedings
--  of the 2014 ACM International Conference on Object Oriented
--  Programming Systems Languages & Applications (OOPSLA '14). ACM,
--  New York, NY, USA, 453-472. DOI:
--  <https://doi.org/10.1145/2660193.2660195>
--
--  The paper describes a new algorithm /SplitMix/ for /splittable/
--  pseudorandom number generator that is quite fast: 9 64 bit arithmetic/logical
--  operations per 64 bits generated.
--
--  /SplitMix/ is tested with two standard statistical test suites (DieHarder and
--  TestU01, this implementation only using the former) and it appears to be
--  adequate for "everyday" use, such as Monte Carlo algorithms and randomized
--  data structures where speed is important.
--
--  In particular, it __should not be used for cryptographic or security applications__,
--  because generated sequences of pseudorandom values are too predictable
--  (the mixing functions are easily inverted, and two successive outputs
--  suffice to reconstruct the internal state).
--
--  Note: This module supports all GHCs since GHC-7.0.4,
--  but GHC-7.0 and GHC-7.2 have slow implementation, as there
--  are no native 'popCount'.
--
{-# LANGUAGE CPP         #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
module System.Random.SplitMix (
    SMGen,
    nextWord64,
    nextWord32,
    nextTwoWord32,
    nextInt,
    nextDouble,
    nextFloat,
    splitSMGen,
    -- * Generation
    bitmaskWithRejection32,
    bitmaskWithRejection32',
    bitmaskWithRejection64,
    bitmaskWithRejection64',
    -- * Initialisation
    mkSMGen,
    initSMGen,
    newSMGen,
    seedSMGen,
    seedSMGen',
    unseedSMGen,
    ) where

import Control.DeepSeq       (NFData (..))
import Data.Bits             (complement, shiftL, shiftR, xor, (.&.), (.|.))
import Data.Bits.Compat      (countLeadingZeros, popCount, zeroBits)
import Data.IORef            (IORef, atomicModifyIORef, newIORef)
import Data.Time.Clock.POSIX (getPOSIXTime)
import Data.Word             (Word32, Word64)
import System.IO.Unsafe      (unsafePerformIO)

#ifdef MIN_VERSION_random
import qualified System.Random as R
#endif

#if !__GHCJS__
import System.CPUTime (cpuTimePrecision, getCPUTime)
#endif

-- $setup
-- >>> import Text.Read (readMaybe)
-- >>> import Data.List (unfoldr)
-- >>> import Text.Printf (printf)

-------------------------------------------------------------------------------
-- Generator
-------------------------------------------------------------------------------

-- | SplitMix generator state.
data SMGen = SMGen !Word64 !Word64 -- seed and gamma; gamma is odd
  deriving Int -> SMGen -> ShowS
[SMGen] -> ShowS
SMGen -> String
(Int -> SMGen -> ShowS)
-> (SMGen -> String) -> ([SMGen] -> ShowS) -> Show SMGen
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SMGen] -> ShowS
$cshowList :: [SMGen] -> ShowS
show :: SMGen -> String
$cshow :: SMGen -> String
showsPrec :: Int -> SMGen -> ShowS
$cshowsPrec :: Int -> SMGen -> ShowS
Show

instance NFData SMGen where
    rnf :: SMGen -> ()
rnf (SMGen Word64
_ Word64
_) = ()

-- |
--
-- >>> readMaybe "SMGen 1 1" :: Maybe SMGen
-- Just (SMGen 1 1)
--
-- >>> readMaybe "SMGen 1 2" :: Maybe SMGen
-- Nothing
--
-- >>> readMaybe (show (mkSMGen 42)) :: Maybe SMGen
-- Just (SMGen 9297814886316923340 13679457532755275413)
--
instance Read SMGen where
    readsPrec :: Int -> ReadS SMGen
readsPrec Int
d String
r =  Bool -> ReadS SMGen -> ReadS SMGen
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (\String
r0 ->
        [ (Word64 -> Word64 -> SMGen
SMGen Word64
seed Word64
gamma, String
r3)
        | (String
"SMGen", String
r1) <- ReadS String
lex String
r0
        , (Word64
seed, String
r2) <- Int -> ReadS Word64
forall a. Read a => Int -> ReadS a
readsPrec Int
11 String
r1
        , (Word64
gamma, String
r3) <- Int -> ReadS Word64
forall a. Read a => Int -> ReadS a
readsPrec Int
11 String
r2
        , Word64 -> Bool
forall a. Integral a => a -> Bool
odd Word64
gamma
        ]) String
r

-------------------------------------------------------------------------------
-- Operations
-------------------------------------------------------------------------------

-- | Generate a 'Word64'.
--
-- >>> take 3 $ map (printf "%x") $ unfoldr (Just . nextWord64) (mkSMGen 1337) :: [String]
-- ["b5c19e300e8b07b3","d600e0e216c0ac76","c54efc3b3cc5af29"]
--
nextWord64 :: SMGen -> (Word64, SMGen)
nextWord64 :: SMGen -> (Word64, SMGen)
nextWord64 (SMGen Word64
seed Word64
gamma) = (Word64 -> Word64
mix64 Word64
seed', Word64 -> Word64 -> SMGen
SMGen Word64
seed' Word64
gamma)
  where
    seed' :: Word64
seed' = Word64
seed Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
gamma

-- | Generate 'Word32' by truncating 'nextWord64'.
--
-- @since 0.0.3
nextWord32 :: SMGen -> (Word32, SMGen)
nextWord32 :: SMGen -> (Word32, SMGen)
nextWord32 SMGen
g = (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w64, SMGen
g') where
    (Word64
w64, SMGen
g') = SMGen -> (Word64, SMGen)
nextWord64 SMGen
g

-- | Generate two 'Word32'.
--
-- @since 0.0.3
nextTwoWord32 :: SMGen -> (Word32, Word32, SMGen)
nextTwoWord32 :: SMGen -> (Word32, Word32, SMGen)
nextTwoWord32 SMGen
g = (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word32) -> Word64 -> Word32
forall a b. (a -> b) -> a -> b
$ Word64
w64 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32, Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w64, SMGen
g') where
    (Word64
w64, SMGen
g') = SMGen -> (Word64, SMGen)
nextWord64 SMGen
g

-- | Generate an 'Int'.
nextInt :: SMGen -> (Int, SMGen)
nextInt :: SMGen -> (Int, SMGen)
nextInt SMGen
g = case SMGen -> (Word64, SMGen)
nextWord64 SMGen
g of
    (Word64
w64, SMGen
g') -> (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w64, SMGen
g')

-- | Generate a 'Double' in @[0, 1)@ range.
--
-- >>> take 8 $ map (printf "%0.3f") $ unfoldr (Just . nextDouble) (mkSMGen 1337) :: [String]
-- ["0.710","0.836","0.771","0.409","0.297","0.527","0.589","0.067"]
--
nextDouble :: SMGen -> (Double, SMGen)
nextDouble :: SMGen -> (Double, SMGen)
nextDouble SMGen
g = case SMGen -> (Word64, SMGen)
nextWord64 SMGen
g of
    (Word64
w64, SMGen
g') -> (Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w64 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
11) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
doubleUlp, SMGen
g')

-- | Generate a 'Float' in @[0, 1)@ range.
--
-- >>> take 8 $ map (printf "%0.3f") $ unfoldr (Just . nextFloat) (mkSMGen 1337) :: [String]
-- ["0.057","0.089","0.237","0.383","0.680","0.320","0.826","0.007"]
--
-- @since 0.0.3
nextFloat :: SMGen -> (Float, SMGen)
nextFloat :: SMGen -> (Float, SMGen)
nextFloat SMGen
g = case SMGen -> (Word32, SMGen)
nextWord32 SMGen
g of
    (Word32
w32, SMGen
g') -> (Word32 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w32 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
floatUlp, SMGen
g')

-- | Split a generator into a two uncorrelated generators.
splitSMGen :: SMGen -> (SMGen, SMGen)
splitSMGen :: SMGen -> (SMGen, SMGen)
splitSMGen (SMGen Word64
seed Word64
gamma) =
    (Word64 -> Word64 -> SMGen
SMGen Word64
seed'' Word64
gamma, Word64 -> Word64 -> SMGen
SMGen (Word64 -> Word64
mix64 Word64
seed') (Word64 -> Word64
mixGamma Word64
seed''))
  where
    seed' :: Word64
seed'  = Word64
seed Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
gamma
    seed'' :: Word64
seed'' = Word64
seed' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
gamma

-------------------------------------------------------------------------------
-- Algorithm
-------------------------------------------------------------------------------

goldenGamma :: Word64
goldenGamma :: Word64
goldenGamma = Word64
0x9e3779b97f4a7c15

floatUlp :: Float
floatUlp :: Float
floatUlp =  Float
1.0 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Word32 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
24 :: Word32)

doubleUlp :: Double
doubleUlp :: Double
doubleUlp =  Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
53 :: Word64)

-- Note: in JDK implementations the mix64 and mix64variant13
-- (which is inlined into mixGamma) are swapped.
mix64 :: Word64 -> Word64
mix64 :: Word64 -> Word64
mix64 Word64
z0 =
   -- MurmurHash3Mixer
    let z1 :: Word64
z1 = Int -> Word64 -> Word64 -> Word64
shiftXorMultiply Int
33 Word64
0xff51afd7ed558ccd Word64
z0
        z2 :: Word64
z2 = Int -> Word64 -> Word64 -> Word64
shiftXorMultiply Int
33 Word64
0xc4ceb9fe1a85ec53 Word64
z1
        z3 :: Word64
z3 = Int -> Word64 -> Word64
shiftXor Int
33 Word64
z2
    in Word64
z3

-- used only in mixGamma
mix64variant13 :: Word64 -> Word64
mix64variant13 :: Word64 -> Word64
mix64variant13 Word64
z0 =
   -- Better Bit Mixing - Improving on MurmurHash3's 64-bit Finalizer
   -- http://zimbry.blogspot.fi/2011/09/better-bit-mixing-improving-on.html
   --
   -- Stafford's Mix13
    let z1 :: Word64
z1 = Int -> Word64 -> Word64 -> Word64
shiftXorMultiply Int
30 Word64
0xbf58476d1ce4e5b9 Word64
z0 -- MurmurHash3 mix constants
        z2 :: Word64
z2 = Int -> Word64 -> Word64 -> Word64
shiftXorMultiply Int
27 Word64
0x94d049bb133111eb Word64
z1
        z3 :: Word64
z3 = Int -> Word64 -> Word64
shiftXor Int
31 Word64
z2
    in Word64
z3

mixGamma :: Word64 -> Word64
mixGamma :: Word64 -> Word64
mixGamma Word64
z0 =
    let z1 :: Word64
z1 = Word64 -> Word64
mix64variant13 Word64
z0 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
1             -- force to be odd
        n :: Int
n  = Word64 -> Int
forall a. Bits a => a -> Int
popCount (Word64
z1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` (Word64
z1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
1))
    -- see: http://www.pcg-random.org/posts/bugs-in-splitmix.html
    -- let's trust the text of the paper, not the code.
    in if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
24
        then Word64
z1
        else Word64
z1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
0xaaaaaaaaaaaaaaaa

shiftXor :: Int -> Word64 -> Word64
shiftXor :: Int -> Word64 -> Word64
shiftXor Int
n Word64
w = Word64
w Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` (Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
n)

shiftXorMultiply :: Int -> Word64 -> Word64 -> Word64
shiftXorMultiply :: Int -> Word64 -> Word64 -> Word64
shiftXorMultiply Int
n Word64
k Word64
w = Int -> Word64 -> Word64
shiftXor Int
n Word64
w Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
k

-------------------------------------------------------------------------------
-- Generation
-------------------------------------------------------------------------------

-- | /Bitmask with rejection/ method of generating subrange of 'Word32'.
--
-- @since 0.0.3
bitmaskWithRejection32 :: Word32 -> SMGen -> (Word32, SMGen)
bitmaskWithRejection32 :: Word32 -> SMGen -> (Word32, SMGen)
bitmaskWithRejection32 Word32
range = SMGen -> (Word32, SMGen)
go where
    mask :: Word32
mask = Word32 -> Word32
forall a. Bits a => a -> a
complement Word32
forall a. Bits a => a
zeroBits Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Word32 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros (Word32
range Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
1)
    go :: SMGen -> (Word32, SMGen)
go SMGen
g = let (Word32
x, SMGen
g') = SMGen -> (Word32, SMGen)
nextWord32 SMGen
g
               x' :: Word32
x' = Word32
x Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
mask
           in if Word32
x' Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
range
              then SMGen -> (Word32, SMGen)
go SMGen
g'
              else (Word32
x', SMGen
g')

-- | /Bitmask with rejection/ method of generating subrange of 'Word64'.
--
-- @bitmaskWithRejection64 w64@ generates random numbers in closed-open
-- range of @[0, w64)@.
--
-- >>> take 20 $ unfoldr (Just . bitmaskWithRejection64 5) (mkSMGen 1337)
-- [3,1,4,1,2,3,1,1,0,3,4,2,3,0,2,3,3,4,1,0]
--
-- @since 0.0.3
bitmaskWithRejection64 :: Word64 -> SMGen -> (Word64, SMGen)
bitmaskWithRejection64 :: Word64 -> SMGen -> (Word64, SMGen)
bitmaskWithRejection64 Word64
range = SMGen -> (Word64, SMGen)
go where
    mask :: Word64
mask = Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
forall a. Bits a => a
zeroBits Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Word64 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros (Word64
range Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
1)
    go :: SMGen -> (Word64, SMGen)
go SMGen
g = let (Word64
x, SMGen
g') = SMGen -> (Word64, SMGen)
nextWord64 SMGen
g
               x' :: Word64
x' = Word64
x Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
mask
           in if Word64
x' Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
range
              then SMGen -> (Word64, SMGen)
go SMGen
g'
              else (Word64
x', SMGen
g')

-- | /Bitmask with rejection/ method of generating subrange of 'Word32'.
--
-- @since 0.0.4
bitmaskWithRejection32' :: Word32 -> SMGen -> (Word32, SMGen)
bitmaskWithRejection32' :: Word32 -> SMGen -> (Word32, SMGen)
bitmaskWithRejection32' Word32
range = SMGen -> (Word32, SMGen)
go where
    mask :: Word32
mask = Word32 -> Word32
forall a. Bits a => a -> a
complement Word32
forall a. Bits a => a
zeroBits Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Word32 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros (Word32
range Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
1)
    go :: SMGen -> (Word32, SMGen)
go SMGen
g = let (Word32
x, SMGen
g') = SMGen -> (Word32, SMGen)
nextWord32 SMGen
g
               x' :: Word32
x' = Word32
x Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
mask
           in if Word32
x' Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
range
              then SMGen -> (Word32, SMGen)
go SMGen
g'
              else (Word32
x', SMGen
g')

-- | /Bitmask with rejection/ method of generating subrange of 'Word64'.
--
-- @bitmaskWithRejection64' w64@ generates random numbers in closed-closed
-- range of @[0, w64]@.
--
-- >>> take 20 $ unfoldr (Just . bitmaskWithRejection64' 5) (mkSMGen 1337)
-- [3,1,4,1,2,3,1,1,0,3,4,5,2,3,0,2,3,5,3,4]
--
-- @since 0.0.4
bitmaskWithRejection64' :: Word64 -> SMGen -> (Word64, SMGen)
bitmaskWithRejection64' :: Word64 -> SMGen -> (Word64, SMGen)
bitmaskWithRejection64' Word64
range = SMGen -> (Word64, SMGen)
go where
    mask :: Word64
mask = Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
forall a. Bits a => a
zeroBits Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Word64 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros (Word64
range Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
1)
    go :: SMGen -> (Word64, SMGen)
go SMGen
g = let (Word64
x, SMGen
g') = SMGen -> (Word64, SMGen)
nextWord64 SMGen
g
               x' :: Word64
x' = Word64
x Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
mask
           in if Word64
x' Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
range
              then SMGen -> (Word64, SMGen)
go SMGen
g'
              else (Word64
x', SMGen
g')


-------------------------------------------------------------------------------
-- Initialisation
-------------------------------------------------------------------------------

-- | Create 'SMGen' using seed and gamma.
--
-- >>> seedSMGen 2 2
-- SMGen 2 3
--
seedSMGen
    :: Word64 -- ^ seed
    -> Word64 -- ^ gamma
    -> SMGen
seedSMGen :: Word64 -> Word64 -> SMGen
seedSMGen Word64
seed Word64
gamma = Word64 -> Word64 -> SMGen
SMGen Word64
seed (Word64
gamma Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
1)

-- | Like 'seedSMGen' but takes a pair.
seedSMGen' :: (Word64, Word64) -> SMGen
seedSMGen' :: (Word64, Word64) -> SMGen
seedSMGen' = (Word64 -> Word64 -> SMGen) -> (Word64, Word64) -> SMGen
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Word64 -> Word64 -> SMGen
seedSMGen

-- | Extract current state of 'SMGen'.
unseedSMGen :: SMGen -> (Word64, Word64)
unseedSMGen :: SMGen -> (Word64, Word64)
unseedSMGen (SMGen Word64
seed Word64
gamma) = (Word64
seed, Word64
gamma)

-- | Preferred way to deterministically construct 'SMGen'.
--
-- >>> mkSMGen 42
-- SMGen 9297814886316923340 13679457532755275413
--
mkSMGen :: Word64 -> SMGen
mkSMGen :: Word64 -> SMGen
mkSMGen Word64
s = Word64 -> Word64 -> SMGen
SMGen (Word64 -> Word64
mix64 Word64
s) (Word64 -> Word64
mixGamma (Word64
s Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
goldenGamma))

-- | Initialize 'SMGen' using system time.
initSMGen :: IO SMGen
initSMGen :: IO SMGen
initSMGen = (Word64 -> SMGen) -> IO Word64 -> IO SMGen
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> SMGen
mkSMGen IO Word64
mkSeedTime

-- | Derive a new generator instance from the global 'SMGen' using 'splitSMGen'.
newSMGen :: IO SMGen
newSMGen :: IO SMGen
newSMGen = IORef SMGen -> (SMGen -> (SMGen, SMGen)) -> IO SMGen
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef SMGen
theSMGen SMGen -> (SMGen, SMGen)
splitSMGen

theSMGen :: IORef SMGen
theSMGen :: IORef SMGen
theSMGen = IO (IORef SMGen) -> IORef SMGen
forall a. IO a -> a
unsafePerformIO (IO (IORef SMGen) -> IORef SMGen)
-> IO (IORef SMGen) -> IORef SMGen
forall a b. (a -> b) -> a -> b
$ IO SMGen
initSMGen IO SMGen -> (SMGen -> IO (IORef SMGen)) -> IO (IORef SMGen)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SMGen -> IO (IORef SMGen)
forall a. a -> IO (IORef a)
newIORef
{-# NOINLINE theSMGen #-}

mkSeedTime :: IO Word64
mkSeedTime :: IO Word64
mkSeedTime = do
    POSIXTime
now <- IO POSIXTime
getPOSIXTime
    let lo :: Word32
lo = POSIXTime -> Word32
forall a b. (RealFrac a, Integral b) => a -> b
truncate POSIXTime
now :: Word32
#if __GHCJS__
    let hi = lo
#else
    Integer
cpu <- IO Integer
getCPUTime
    let hi :: Word32
hi = Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
cpu Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
cpuTimePrecision) :: Word32
#endif
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> IO Word64) -> Word64 -> IO Word64
forall a b. (a -> b) -> a -> b
$ Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
hi 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
lo

-------------------------------------------------------------------------------
-- System.Random
-------------------------------------------------------------------------------

#ifdef MIN_VERSION_random
instance R.RandomGen SMGen where
    next :: SMGen -> (Int, SMGen)
next = SMGen -> (Int, SMGen)
nextInt
    split :: SMGen -> (SMGen, SMGen)
split = SMGen -> (SMGen, SMGen)
splitSMGen
#endif