{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
module System.Random.SplitMix32 (
SMGen,
nextWord32,
nextWord64,
nextTwoWord32,
nextInt,
nextDouble,
nextFloat,
nextInteger,
splitSMGen,
bitmaskWithRejection32,
bitmaskWithRejection32',
bitmaskWithRejection64,
bitmaskWithRejection64',
mkSMGen,
initSMGen,
newSMGen,
seedSMGen,
seedSMGen',
unseedSMGen,
) where
import Data.Bits (complement, shiftL, shiftR, xor, (.&.), (.|.))
import Data.Bits.Compat
(countLeadingZeros, finiteBitSize, popCount, zeroBits)
import Data.IORef (IORef, atomicModifyIORef, newIORef)
import Data.Word (Word32, Word64)
import System.IO.Unsafe (unsafePerformIO)
import System.Random.SplitMix.Init
#if defined(__HUGS__) || !MIN_VERSION_base(4,8,0)
import Data.Word (Word)
#endif
#ifndef __HUGS__
import Control.DeepSeq (NFData (..))
#endif
data SMGen = SMGen {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32
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
#ifndef __HUGS__
instance NFData SMGen where
rnf :: SMGen -> ()
rnf (SMGen _ _) = ()
#endif
instance Read SMGen where
readsPrec :: Int -> ReadS SMGen
readsPrec d :: Int
d r :: 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
> 10) (\r0 :: String
r0 ->
[ (Word32 -> Word32 -> SMGen
SMGen Word32
seed Word32
gamma, String
r3)
| ("SMGen", r1 :: String
r1) <- ReadS String
lex String
r0
, (seed :: Word32
seed, r2 :: String
r2) <- Int -> ReadS Word32
forall a. Read a => Int -> ReadS a
readsPrec 11 String
r1
, (gamma :: Word32
gamma, r3 :: String
r3) <- Int -> ReadS Word32
forall a. Read a => Int -> ReadS a
readsPrec 11 String
r2
, Word32 -> Bool
forall a. Integral a => a -> Bool
odd Word32
gamma
]) String
r
nextWord32 :: SMGen -> (Word32, SMGen)
nextWord32 :: SMGen -> (Word32, SMGen)
nextWord32 (SMGen seed :: Word32
seed gamma :: Word32
gamma) = (Word32 -> Word32
mix32 Word32
seed', Word32 -> Word32 -> SMGen
SMGen Word32
seed' Word32
gamma)
where
seed' :: Word32
seed' = Word32
seed Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
gamma
nextWord64 :: SMGen -> (Word64, SMGen)
nextWord64 :: SMGen -> (Word64, SMGen)
nextWord64 s0 :: SMGen
s0 = (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w0 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
w1, SMGen
s2)
where
(w0 :: Word32
w0, s1 :: SMGen
s1) = SMGen -> (Word32, SMGen)
nextWord32 SMGen
s0
(w1 :: Word32
w1, s2 :: SMGen
s2) = SMGen -> (Word32, SMGen)
nextWord32 SMGen
s1
nextTwoWord32 :: SMGen -> (Word32, Word32, SMGen)
nextTwoWord32 :: SMGen -> (Word32, Word32, SMGen)
nextTwoWord32 s0 :: SMGen
s0 = (Word32
w0, Word32
w1, SMGen
s2) where
(w0 :: Word32
w0, s1 :: SMGen
s1) = SMGen -> (Word32, SMGen)
nextWord32 SMGen
s0
(w1 :: Word32
w1, s2 :: SMGen
s2) = SMGen -> (Word32, SMGen)
nextWord32 SMGen
s1
nextInt :: SMGen -> (Int, SMGen)
nextInt :: SMGen -> (Int, SMGen)
nextInt g :: SMGen
g | Bool
isBigInt = (Int, SMGen)
int64
| Bool
otherwise = (Int, SMGen)
int32
where
int32 :: (Int, SMGen)
int32 = case SMGen -> (Word32, SMGen)
nextWord32 SMGen
g of
(w :: Word32
w, g' :: SMGen
g') -> (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w, SMGen
g')
int64 :: (Int, SMGen)
int64 = case SMGen -> (Word64, SMGen)
nextWord64 SMGen
g of
(w :: Word64
w, g' :: SMGen
g') -> (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w, SMGen
g')
isBigInt :: Bool
isBigInt :: Bool
isBigInt = Int -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Int
forall a. HasCallStack => a
undefined :: Int) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 32
nextDouble :: SMGen -> (Double, SMGen)
nextDouble :: SMGen -> (Double, SMGen)
nextDouble g :: SMGen
g = case SMGen -> (Word64, SMGen)
nextWord64 SMGen
g of
(w64 :: Word64
w64, g' :: 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` 11) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
doubleUlp, SMGen
g')
nextFloat :: SMGen -> (Float, SMGen)
nextFloat :: SMGen -> (Float, SMGen)
nextFloat g :: SMGen
g = case SMGen -> (Word32, SMGen)
nextWord32 SMGen
g of
(w32 :: Word32
w32, g' :: 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` 8) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
floatUlp, SMGen
g')
nextInteger :: Integer -> Integer -> SMGen -> (Integer, SMGen)
nextInteger :: Integer -> Integer -> SMGen -> (Integer, SMGen)
nextInteger lo :: Integer
lo hi :: Integer
hi g :: SMGen
g = case Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
lo Integer
hi of
LT -> let (i :: Integer
i, g' :: SMGen
g') = Integer -> SMGen -> (Integer, SMGen)
nextInteger' (Integer
hi Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
lo) SMGen
g in (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
lo, SMGen
g')
EQ -> (Integer
lo, SMGen
g)
GT -> let (i :: Integer
i, g' :: SMGen
g') = Integer -> SMGen -> (Integer, SMGen)
nextInteger' (Integer
lo Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
hi) SMGen
g in (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
hi, SMGen
g')
nextInteger' :: Integer -> SMGen -> (Integer, SMGen)
nextInteger' :: Integer -> SMGen -> (Integer, SMGen)
nextInteger' range :: Integer
range = SMGen -> (Integer, SMGen)
loop
where
leadMask :: Word32
restDigits :: Word
(leadMask :: Word32
leadMask, restDigits :: Word
restDigits) = Word -> Integer -> (Word32, Word)
go 0 Integer
range where
go :: Word -> Integer -> (Word32, Word)
go :: Word -> Integer -> (Word32, Word)
go n :: Word
n x :: Integer
x | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
two32 = (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 (Integer -> Word32
forall a. Num a => Integer -> a
fromInteger Integer
x :: Word32), Word
n)
| Bool
otherwise = Word -> Integer -> (Word32, Word)
go (Word
n Word -> Word -> Word
forall a. Num a => a -> a -> a
+ 1) (Integer
x Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` 32)
generate :: SMGen -> (Integer, SMGen)
generate :: SMGen -> (Integer, SMGen)
generate g0 :: SMGen
g0 =
let (x :: Word32
x, g' :: SMGen
g') = SMGen -> (Word32, SMGen)
nextWord32 SMGen
g0
x' :: Word32
x' = Word32
x Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
leadMask
in Integer -> Word -> SMGen -> (Integer, SMGen)
go (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x') Word
restDigits SMGen
g'
where
go :: Integer -> Word -> SMGen -> (Integer, SMGen)
go :: Integer -> Word -> SMGen -> (Integer, SMGen)
go acc :: Integer
acc 0 g :: SMGen
g = Integer
acc Integer -> (Integer, SMGen) -> (Integer, SMGen)
forall a b. a -> b -> b
`seq` (Integer
acc, SMGen
g)
go acc :: Integer
acc n :: Word
n g :: SMGen
g =
let (x :: Word32
x, g' :: SMGen
g') = SMGen -> (Word32, SMGen)
nextWord32 SMGen
g
in Integer -> Word -> SMGen -> (Integer, SMGen)
go (Integer
acc Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
two32 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x) (Word
n Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1) SMGen
g'
loop :: SMGen -> (Integer, SMGen)
loop g :: SMGen
g = let (x :: Integer
x, g' :: SMGen
g') = SMGen -> (Integer, SMGen)
generate SMGen
g
in if Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
range
then SMGen -> (Integer, SMGen)
loop SMGen
g'
else (Integer
x, SMGen
g')
two32 :: Integer
two32 :: Integer
two32 = 2 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (32 :: Int)
splitSMGen :: SMGen -> (SMGen, SMGen)
splitSMGen :: SMGen -> (SMGen, SMGen)
splitSMGen (SMGen seed :: Word32
seed gamma :: Word32
gamma) =
(Word32 -> Word32 -> SMGen
SMGen Word32
seed'' Word32
gamma, Word32 -> Word32 -> SMGen
SMGen (Word32 -> Word32
mix32 Word32
seed') (Word32 -> Word32
mixGamma Word32
seed''))
where
seed' :: Word32
seed' = Word32
seed Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
gamma
seed'' :: Word32
seed'' = Word32
seed' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
gamma
goldenGamma :: Word32
goldenGamma :: Word32
goldenGamma = 0x9e3779b9
floatUlp :: Float
floatUlp :: Float
floatUlp = 1.0 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Word32 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` 24 :: Word32)
doubleUlp :: Double
doubleUlp :: Double
doubleUlp = 1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` 53 :: Word64)
#if defined(__GHCJS__) && defined(OPTIMISED_MIX32)
foreign import javascript unsafe
"var x0 = $1 ^ $1 >>> 16; var x1 = x0 & 0xffff; var x2 = (((x0 >>> 16 & 0xffff) * 0x0000ca6b + x1 * 0x000085eb & 0xffff) << 16) + x1 * 0x0000ca6b; var x3 = x2 ^ x2 >>> 13; var x4 = x3 & 0xffff; var x5 = (((x3 >>> 16 & 0xffff) * 0x0000ae35 + x4 * 0x0000c2b2 & 0xffff) << 16) + x4 * 0x0000ae35; $r = (x5 ^ x5 >>> 16) | 0;"
mix32 :: Word32 -> Word32
foreign import javascript unsafe
"var x0 = $1 ^ $1 >>> 16; var x1 = x0 & 0xffff; var x2 = (((x0 >>> 16 & 0xffff) * 0x00006ccb + x1 * 0x000069ad & 0xffff) << 16) + x1 * 0x00006ccb; var x3 = x2 ^ x2 >>> 13; var x4 = x3 & 0xffff; var x5 = (((x3 >>> 16 & 0xffff) * 0x0000b5b3 + x4 * 0x0000cd9a & 0xffff) << 16) + x4 * 0x0000b5b3; $r = (x5 ^ x5 >>> 16) | 0;"
mix32variant13 :: Word32 -> Word32
#else
mix32 :: Word32 -> Word32
mix32 :: Word32 -> Word32
mix32 z0 :: Word32
z0 =
let z1 :: Word32
z1 = Int -> Word32 -> Word32 -> Word32
shiftXorMultiply 16 0x85ebca6b Word32
z0
z2 :: Word32
z2 = Int -> Word32 -> Word32 -> Word32
shiftXorMultiply 13 0xc2b2ae35 Word32
z1
z3 :: Word32
z3 = Int -> Word32 -> Word32
shiftXor 16 Word32
z2
in Word32
z3
mix32variant13 :: Word32 -> Word32
mix32variant13 :: Word32 -> Word32
mix32variant13 z0 :: Word32
z0 =
let z1 :: Word32
z1 = Int -> Word32 -> Word32 -> Word32
shiftXorMultiply 16 0x69ad6ccb Word32
z0
z2 :: Word32
z2 = Int -> Word32 -> Word32 -> Word32
shiftXorMultiply 13 0xcd9ab5b3 Word32
z1
z3 :: Word32
z3 = Int -> Word32 -> Word32
shiftXor 16 Word32
z2
in Word32
z3
shiftXor :: Int -> Word32 -> Word32
shiftXor :: Int -> Word32 -> Word32
shiftXor n :: Int
n w :: Word32
w = Word32
w Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
n)
shiftXorMultiply :: Int -> Word32 -> Word32 -> Word32
shiftXorMultiply :: Int -> Word32 -> Word32 -> Word32
shiftXorMultiply n :: Int
n k :: Word32
k w :: Word32
w = Int -> Word32 -> Word32
shiftXor Int
n Word32
w Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
k
#endif
mixGamma :: Word32 -> Word32
mixGamma :: Word32 -> Word32
mixGamma z0 :: Word32
z0 =
let z1 :: Word32
z1 = Word32 -> Word32
mix32variant13 Word32
z0 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. 1
n :: Int
n = Word32 -> Int
forall a. Bits a => a -> Int
popCount (Word32
z1 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
z1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` 1))
in if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 12
then Word32
z1
else Word32
z1 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` 0xaaaaaaaa
bitmaskWithRejection32 :: Word32 -> SMGen -> (Word32, SMGen)
bitmaskWithRejection32 :: Word32 -> SMGen -> (Word32, SMGen)
bitmaskWithRejection32 0 = String -> SMGen -> (Word32, SMGen)
forall a. HasCallStack => String -> a
error "bitmaskWithRejection32 0"
bitmaskWithRejection32 n :: Word32
n = Word32 -> SMGen -> (Word32, SMGen)
bitmaskWithRejection32' (Word32
n Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- 1)
{-# INLINEABLE bitmaskWithRejection32 #-}
bitmaskWithRejection64 :: Word64 -> SMGen -> (Word64, SMGen)
bitmaskWithRejection64 :: Word64 -> SMGen -> (Word64, SMGen)
bitmaskWithRejection64 0 = String -> SMGen -> (Word64, SMGen)
forall a. HasCallStack => String -> a
error "bitmaskWithRejection64 0"
bitmaskWithRejection64 n :: Word64
n = Word64 -> SMGen -> (Word64, SMGen)
bitmaskWithRejection64' (Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- 1)
{-# INLINEABLE bitmaskWithRejection64 #-}
bitmaskWithRejection32' :: Word32 -> SMGen -> (Word32, SMGen)
bitmaskWithRejection32' :: Word32 -> SMGen -> (Word32, SMGen)
bitmaskWithRejection32' range :: 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
.|. 1)
go :: SMGen -> (Word32, SMGen)
go g :: SMGen
g = let (x :: Word32
x, g' :: 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')
{-# INLINEABLE bitmaskWithRejection32' #-}
bitmaskWithRejection64' :: Word64 -> SMGen -> (Word64, SMGen)
bitmaskWithRejection64' :: Word64 -> SMGen -> (Word64, SMGen)
bitmaskWithRejection64' range :: 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
.|. 1)
go :: SMGen -> (Word64, SMGen)
go g :: SMGen
g = let (x :: Word64
x, g' :: 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')
{-# INLINEABLE bitmaskWithRejection64' #-}
seedSMGen
:: Word32
-> Word32
-> SMGen
seedSMGen :: Word32 -> Word32 -> SMGen
seedSMGen seed :: Word32
seed gamma :: Word32
gamma = Word32 -> Word32 -> SMGen
SMGen Word32
seed (Word32
gamma Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. 1)
seedSMGen' :: (Word32, Word32) -> SMGen
seedSMGen' :: (Word32, Word32) -> SMGen
seedSMGen' = (Word32 -> Word32 -> SMGen) -> (Word32, Word32) -> SMGen
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Word32 -> Word32 -> SMGen
seedSMGen
unseedSMGen :: SMGen -> (Word32, Word32)
unseedSMGen :: SMGen -> (Word32, Word32)
unseedSMGen (SMGen seed :: Word32
seed gamma :: Word32
gamma) = (Word32
seed, Word32
gamma)
mkSMGen :: Word32 -> SMGen
mkSMGen :: Word32 -> SMGen
mkSMGen s :: Word32
s = Word32 -> Word32 -> SMGen
SMGen (Word32 -> Word32
mix32 Word32
s) (Word32 -> Word32
mixGamma (Word32
s Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
goldenGamma))
initSMGen :: IO SMGen
initSMGen :: IO SMGen
initSMGen = (Word32 -> SMGen) -> IO Word32 -> IO SMGen
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> SMGen
mkSMGen IO Word32
initialSeed'
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 #-}
initialSeed' :: IO Word32
initialSeed' :: IO Word32
initialSeed' = do
Word64
w64 <- IO Word64
initialSeed
Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
w64 32) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w64)