{-# LANGUAGE CPP #-}
module System.Random.TF.Init
(newTFGen, mkTFGen, mkSeedTime, mkSeedUnix, initTFGen)
where
import System.Random.TF.Gen (TFGen, seedTFGen, split)
import Control.Monad (when)
import Data.Bits (bitSize)
import Data.IORef
import Data.Word
import Foreign (allocaBytes, peekArray)
import Data.Ratio (numerator, denominator)
import Data.Time
import System.CPUTime
import System.IO
import System.IO.Unsafe (unsafePerformIO)
mkSeedTime :: IO (Word64, Word64, Word64, Word64)
mkSeedTime :: IO (Word64, Word64, Word64, Word64)
mkSeedTime = do
UTCTime
utcTm <- IO UTCTime
getCurrentTime
Integer
cpu <- IO Integer
getCPUTime
let daytime :: Rational
daytime = forall a. Real a => a -> Rational
toRational forall a b. (a -> b) -> a -> b
$ UTCTime -> DiffTime
utctDayTime UTCTime
utcTm
t1, t2 :: Word64
t1 :: Word64
t1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Ratio a -> a
numerator Rational
daytime
t2 :: Word64
t2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Ratio a -> a
denominator Rational
daytime
day :: Integer
day = Day -> Integer
toModifiedJulianDay forall a b. (a -> b) -> a -> b
$ UTCTime -> Day
utctDay UTCTime
utcTm
d1 :: Word64
d1 :: Word64
d1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
day
c1 :: Word64
c1 :: Word64
c1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
cpu
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
t1, Word64
t2, Word64
d1, Word64
c1)
mkSeedUnix :: IO (Word64, Word64, Word64, Word64)
mkSeedUnix :: IO (Word64, Word64, Word64, Word64)
mkSeedUnix = do
let bytes :: Int
bytes = Int
32
rfile :: String
rfile = String
"/dev/urandom"
[Word64]
l <- forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
bytes forall a b. (a -> b) -> a -> b
$ \Ptr Word64
buf -> do
Int
nread <- forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
rfile IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
h ->
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
h Ptr Word64
buf Int
bytes
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nread forall a. Eq a => a -> a -> Bool
/= Int
bytes) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"mkSeedUnix: Failed to read " forall a. [a] -> [a] -> [a]
++
forall a. Show a => a -> String
show Int
bytes forall a. [a] -> [a] -> [a]
++ String
" from " forall a. [a] -> [a] -> [a]
++ String
rfile
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
4 Ptr Word64
buf
let [Word64
x1, Word64
x2, Word64
x3, Word64
x4] = [Word64]
l
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
x1, Word64
x2, Word64
x3, Word64
x4)
initTFGen :: IO TFGen
initTFGen :: IO TFGen
initTFGen = do
#ifdef UNIX
s <- mkSeedUnix
#else
(Word64, Word64, Word64, Word64)
s <- IO (Word64, Word64, Word64, Word64)
mkSeedTime
#endif
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Word64, Word64, Word64, Word64) -> TFGen
seedTFGen (Word64, Word64, Word64, Word64)
s
newTFGen :: IO TFGen
newTFGen :: IO TFGen
newTFGen = forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef TFGen
theTFGen forall g. RandomGen g => g -> (g, g)
split
{-# NOINLINE theTFGen #-}
theTFGen :: IORef TFGen
theTFGen :: IORef TFGen
theTFGen = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
TFGen
rng <- IO TFGen
initTFGen
forall a. a -> IO (IORef a)
newIORef TFGen
rng
mkTFGen :: Int -> TFGen
mkTFGen :: Int -> TFGen
mkTFGen Int
n
| forall a. Bits a => a -> Int
bitSize Int
n forall a. Ord a => a -> a -> Bool
> Int
64 = forall a. HasCallStack => String -> a
error String
"mkTFGen: case where size of Int > 64 not implemented"
| Bool
otherwise = (Word64, Word64, Word64, Word64) -> TFGen
seedTFGen (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n, Word64
0, Word64
0, Word64
0)