{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell, GADTs #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Random.Source.PureMT
( PureMT, newPureMT, pureMT
, getRandomPrimFromMTRef
) where
import Control.Monad.State
import Control.Monad.RWS
import qualified Control.Monad.State.Strict as S
import qualified Control.Monad.RWS.Strict as S
import Data.Random.Internal.Source
import Data.Random.Source.Internal.TH
import Data.StateRef
import System.Random.Mersenne.Pure64
{-# INLINE withMTRef #-}
withMTRef :: (Monad m, ModifyRef sr m PureMT) => (PureMT -> (t, PureMT)) -> sr -> m t
withMTRef :: forall (m :: * -> *) sr t.
(Monad m, ModifyRef sr m PureMT) =>
(PureMT -> (t, PureMT)) -> sr -> m t
withMTRef PureMT -> (t, PureMT)
thing sr
ref = sr -> (PureMT -> (PureMT, t)) -> m t
forall sr (m :: * -> *) a b.
ModifyRef sr m a =>
sr -> (a -> (a, b)) -> m b
atomicModifyReference sr
ref ((PureMT -> (PureMT, t)) -> m t) -> (PureMT -> (PureMT, t)) -> m t
forall a b. (a -> b) -> a -> b
$ \(!PureMT
oldMT) ->
case PureMT -> (t, PureMT)
thing PureMT
oldMT of (!t
w, !PureMT
newMT) -> (PureMT
newMT, t
w)
{-# INLINE withMTState #-}
withMTState :: MonadState PureMT m => (PureMT -> (t, PureMT)) -> m t
withMTState :: forall (m :: * -> *) t.
MonadState PureMT m =>
(PureMT -> (t, PureMT)) -> m t
withMTState PureMT -> (t, PureMT)
thing = do
!PureMT
mt <- m PureMT
forall s (m :: * -> *). MonadState s m => m s
get
let (!t
ws, !PureMT
newMt) = PureMT -> (t, PureMT)
thing PureMT
mt
PureMT -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PureMT
newMt
t -> m t
forall (m :: * -> *) a. Monad m => a -> m a
return t
ws
#ifndef MTL2
$(monadRandom
[d| instance MonadRandom (State PureMT) where
getRandomWord64 = withMTState randomWord64
getRandomDouble = withMTState randomDouble
|])
$(monadRandom
[d| instance MonadRandom (S.State PureMT) where
getRandomWord64 = withMTState randomWord64
getRandomDouble = withMTState randomDouble
|])
$(monadRandom
[d| instance Monoid w => MonadRandom (RWS r w PureMT) where
getRandomWord64 = withMTState randomWord64
getRandomDouble = withMTState randomDouble
|])
$(monadRandom
[d| instance Monoid w => MonadRandom (S.RWS r w PureMT) where
getRandomWord64 = withMTState randomWord64
getRandomDouble = withMTState randomDouble
|])
#endif
$(randomSource
[d| instance (Monad m1, ModifyRef (Ref m2 PureMT) m1 PureMT) => RandomSource m1 (Ref m2 PureMT) where
getRandomWord64From = withMTRef randomWord64
getRandomDoubleFrom = withMTRef randomDouble
|])
$(monadRandom
[d| instance Monad m => MonadRandom (StateT PureMT m) where
getRandomWord64 = withMTState randomWord64
getRandomDouble = withMTState randomDouble
|])
$(monadRandom
[d| instance Monad m => MonadRandom (S.StateT PureMT m) where
getRandomWord64 = withMTState randomWord64
getRandomDouble = withMTState randomDouble
|])
$(monadRandom
[d| instance (Monad m, Monoid w) => MonadRandom (RWST r w PureMT m) where
getRandomWord64 = withMTState randomWord64
getRandomDouble = withMTState randomDouble
|])
$(monadRandom
[d| instance (Monad m, Monoid w) => MonadRandom (S.RWST r w PureMT m) where
getRandomWord64 = withMTState randomWord64
getRandomDouble = withMTState randomDouble
|])
$(randomSource
[d| instance (MonadIO m) => RandomSource m (IORef PureMT) where
getRandomWord64From = withMTRef randomWord64
getRandomDoubleFrom = withMTRef randomDouble
|])
$(randomSource
[d| instance (Monad m, ModifyRef (STRef s PureMT) m PureMT) => RandomSource m (STRef s PureMT) where
getRandomWord64From = withMTRef randomWord64
getRandomDoubleFrom = withMTRef randomDouble
|])
getRandomPrimFromMTRef :: ModifyRef sr m PureMT => sr -> Prim a -> m a
getRandomPrimFromMTRef :: forall sr (m :: * -> *) a.
ModifyRef sr m PureMT =>
sr -> Prim a -> m a
getRandomPrimFromMTRef sr
ref
= sr -> (PureMT -> (a, PureMT)) -> m a
forall sr (m :: * -> *) a b.
ModifyRef sr m a =>
sr -> (a -> (b, a)) -> m b
atomicModifyReference' sr
ref
((PureMT -> (a, PureMT)) -> m a)
-> (Prim a -> PureMT -> (a, PureMT)) -> Prim a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State PureMT a -> PureMT -> (a, PureMT)
forall s a. State s a -> s -> (a, s)
runState
(State PureMT a -> PureMT -> (a, PureMT))
-> (Prim a -> State PureMT a) -> Prim a -> PureMT -> (a, PureMT)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prim a -> State PureMT a
forall (m :: * -> *) t. MonadRandom m => Prim t -> m t
getRandomPrim
atomicModifyReference' :: ModifyRef sr m a => sr -> (a -> (b, a)) -> m b
atomicModifyReference' :: forall sr (m :: * -> *) a b.
ModifyRef sr m a =>
sr -> (a -> (b, a)) -> m b
atomicModifyReference' sr
ref a -> (b, a)
getR =
sr -> (a -> (a, b)) -> m b
forall sr (m :: * -> *) a b.
ModifyRef sr m a =>
sr -> (a -> (a, b)) -> m b
atomicModifyReference sr
ref ((b, a) -> (a, b)
forall {b} {a}. (b, a) -> (a, b)
swap' ((b, a) -> (a, b)) -> (a -> (b, a)) -> a -> (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (b, a)
getR)
where swap' :: (b, a) -> (a, b)
swap' (!b
a,!a
b) = (a
b,b
a)