module Basement.Alg.XorShift
( State(..)
, next
, nextDouble
, jump
) where
import Data.Word
import Data.Bits
import Basement.Compat.Base
import Basement.Floating (wordToDouble)
import Basement.Numerical.Additive
import Basement.Numerical.Subtractive
data State = State {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
next :: State -> (Word64 -> State -> a) -> a
next :: State -> (Word64 -> State -> a) -> a
next (State s0 :: Word64
s0 s1prev :: Word64
s1prev) f :: Word64 -> State -> a
f = Word64 -> State -> a
f Word64
ran State
stNext
where
!stNext :: State
stNext = Word64 -> Word64 -> State
State Word64
s0' Word64
s1'
!ran :: Word64
ran = Word64
s0 Word64 -> Word64 -> Word64
forall a. Additive a => a -> a -> a
+ Word64
s1prev
!s1 :: Word64
s1 = Word64
s0 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
s1prev
s0' :: Word64
s0' = (Word64
s0 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`rotateL` 55) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
s1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` (Word64
s1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` 14)
s1' :: Word64
s1' = (Word64
s1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`rotateL` 36)
nextDouble :: State -> (Double -> State -> a) -> a
nextDouble :: State -> (Double -> State -> a) -> a
nextDouble st :: State
st f :: Double -> State -> a
f = State -> (Word64 -> State -> a) -> a
forall a. State -> (Word64 -> State -> a) -> a
next State
st ((Word64 -> State -> a) -> a) -> (Word64 -> State -> a) -> a
forall a b. (a -> b) -> a -> b
$ \w :: Word64
w -> Double -> State -> a
f (Word64 -> Double
toDouble Word64
w)
where
toDouble :: Word64 -> Difference Double
toDouble w :: Word64
w = Word64 -> Double
wordToDouble (Word64
upperMask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word64
w Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
lowerMask)) Double -> Double -> Difference Double
forall a. Subtractive a => a -> a -> Difference a
- 1.0
where
upperMask :: Word64
upperMask = 0x3FF0000000000000
lowerMask :: Word64
lowerMask = 0x000FFFFFFFFFFFFF
jump :: State -> State
jump :: State -> State
jump (State s0 :: Word64
s0 s1 :: Word64
s1) = Word64 -> State -> State
withK 0xd86b048b86aa9922
(State -> State) -> State -> State
forall a b. (a -> b) -> a -> b
$ Word64 -> State -> State
withK 0xbeac0467eba5facb
(State -> State) -> State -> State
forall a b. (a -> b) -> a -> b
$ (Word64 -> Word64 -> State
State 0 0)
where
withK :: Word64 -> State -> State
withK :: Word64 -> State -> State
withK !Word64
k = Int -> State -> State
loop 0
where
loop :: Int -> State -> State
loop !Int
i st :: State
st@(State c0 :: Word64
c0 c1 :: Word64
c1)
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 64 = State
st
| Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word64
k Int
i = Int -> State -> State
loop (Int
iInt -> Int -> Int
forall a. Additive a => a -> a -> a
+1) (Word64 -> Word64 -> State
State (Word64
c0 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
s0) (Word64
c1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
s1))
| Bool
otherwise = State
st