From 5ca65396bebe72a409279e2006a39826c39cc0ab Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Thu, 28 Jan 2021 04:01:53 +0300 Subject: [PATCH 1/2] Implementation of `TGen` and `TGenM` --- CHANGELOG.md | 1 + random.cabal | 3 +- src/System/Random/Internal.hs | 3 +- src/System/Random/Stateful.hs | 77 +++++++++++++++++++++++++++++++++++ 4 files changed, 81 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index c0244712..c69b53a6 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,7 @@ # 1.2.1 * Addition of `initStdGen` +* Addition of `TGen` and `TGenM` # 1.2.0 diff --git a/random.cabal b/random.cabal index e19e799e..dc3b05d4 100644 --- a/random.cabal +++ b/random.cabal @@ -102,7 +102,8 @@ library bytestring >=0.10.4 && <0.12, deepseq >=1.1 && <2, mtl >=2.2 && <2.3, - splitmix >=0.1 && <0.2 + splitmix >=0.1 && <0.2, + stm if impl(ghc < 8.0) build-depends: transformers diff --git a/src/System/Random/Internal.hs b/src/System/Random/Internal.hs index eab2d3b9..e3331e77 100644 --- a/src/System/Random/Internal.hs +++ b/src/System/Random/Internal.hs @@ -3,7 +3,7 @@ {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE GHCForeignImportPrim #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MagicHash #-} @@ -18,7 +18,6 @@ {-# LANGUAGE TypeFamilyDependencies #-} #else {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE KindSignatures #-} #endif {-# OPTIONS_HADDOCK hide, not-home #-} diff --git a/src/System/Random/Stateful.hs b/src/System/Random/Stateful.hs index 29797d6b..94a2f2ce 100644 --- a/src/System/Random/Stateful.hs +++ b/src/System/Random/Stateful.hs @@ -65,6 +65,12 @@ module System.Random.Stateful , applySTGen , runSTGen , runSTGen_ + -- ** Mutable adapter in 'STM' + , TGen(..) + , TGenM(..) + , newTGenM + , newTGenMIO + , applyTGen -- * Pseudo-random values of various types -- $uniform @@ -99,6 +105,7 @@ module System.Random.Stateful import Control.DeepSeq import Control.Monad.IO.Class import Control.Monad.ST +import Control.Concurrent.STM import Control.Monad.State.Strict import Data.IORef import Data.STRef @@ -226,6 +233,9 @@ instance (RandomGen r, MonadState r m) => RandomGenM (StateGenM r) r m where instance RandomGen r => RandomGenM (STGenM r s) r (ST s) where applyRandomGenM = applySTGen +instance RandomGen r => RandomGenM (TGenM r) r STM where + applyRandomGenM = applyTGen + -- | Runs a mutable pseudo-random number generator from its 'FrozenGen' state. -- @@ -536,6 +546,73 @@ runSTGen_ :: RandomGen g => g -> (forall s . STGenM g s -> ST s a) -> a runSTGen_ g action = fst $ runSTGen g action +-- | Wraps a 'TVar' that holds a pure pseudo-random number generator. +-- +-- @since 1.2.1 +newtype TGenM g = TGenM { unTGenM :: TVar g } + +-- | Frozen version of mutable `TGenM` generator +-- +-- @since 1.2.1 +newtype TGen g = TGen { unTGen :: g } + deriving (Eq, Ord, Show, RandomGen, Storable, NFData) + +-- | Creates a new 'TGenM' in `STM`. +-- +-- @since 1.2.1 +newTGenM :: g -> STM (TGenM g) +newTGenM = fmap TGenM . newTVar + + +-- | Creates a new 'TGenM' in `IO`. +-- +-- @since 1.2.1 +newTGenMIO :: MonadIO m => g -> m (TGenM g) +newTGenMIO g = liftIO (TGenM <$> newTVarIO g) + + +-- | @since 1.2.1 +instance RandomGen g => StatefulGen (TGenM g) STM where + uniformWord32R r = applyTGen (genWord32R r) + {-# INLINE uniformWord32R #-} + uniformWord64R r = applyTGen (genWord64R r) + {-# INLINE uniformWord64R #-} + uniformWord8 = applyTGen genWord8 + {-# INLINE uniformWord8 #-} + uniformWord16 = applyTGen genWord16 + {-# INLINE uniformWord16 #-} + uniformWord32 = applyTGen genWord32 + {-# INLINE uniformWord32 #-} + uniformWord64 = applyTGen genWord64 + {-# INLINE uniformWord64 #-} + uniformShortByteString n = applyTGen (genShortByteString n) + +-- | @since 1.2.1 +instance RandomGen g => FrozenGen (TGen g) STM where + type MutableGen (TGen g) STM = TGenM g + freezeGen = fmap TGen . readTVar . unTGenM + thawGen (TGen g) = newTGenM g + + +-- | Applies a pure operation to the wrapped pseudo-random number generator. +-- +-- ====__Examples__ +-- +-- >>> import Control.Concurrent.STM +-- >>> import System.Random.Stateful +-- >>> let pureGen = mkStdGen 137 +-- >>> stmGen <- newTGenMIO pureGen +-- >>> atomically $ applyTGen uniform stmGen :: IO Int +-- 7879794327570578227 +-- +-- @since 1.2.1 +applyTGen :: (g -> (a, g)) -> TGenM g -> STM a +applyTGen f (TGenM tvar) = do + g <- readTVar tvar + case f g of + (a, !g') -> a <$ writeTVar tvar g' +{-# INLINE applyTGen #-} + -- $uniform -- -- This library provides two type classes to generate pseudo-random values: From 33805bb4ba8dcbdf791ccd1c30e4769ebdb37533 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Fri, 25 Jun 2021 00:08:02 +0300 Subject: [PATCH 2/2] Improve haddock a bit --- src/System/Random/Stateful.hs | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/src/System/Random/Stateful.hs b/src/System/Random/Stateful.hs index 94a2f2ce..f2d67945 100644 --- a/src/System/Random/Stateful.hs +++ b/src/System/Random/Stateful.hs @@ -105,7 +105,7 @@ module System.Random.Stateful import Control.DeepSeq import Control.Monad.IO.Class import Control.Monad.ST -import Control.Concurrent.STM +import Control.Concurrent.STM (STM, TVar, newTVar, newTVarIO, readTVar, writeTVar) import Control.Monad.State.Strict import Data.IORef import Data.STRef @@ -120,8 +120,8 @@ import System.Random.Internal -- [Monadic pseudo-random number generators] 'StatefulGen' is an interface to -- monadic pseudo-random number generators. -- --- [Monadic adapters] 'StateGenM', 'AtomicGenM', 'IOGenM' and 'STGenM' turn a --- 'RandomGen' instance into a 'StatefulGen' instance. +-- [Monadic adapters] 'StateGenM', 'AtomicGenM', 'IOGenM', 'STGenM` and 'TGenM' +-- turn a 'RandomGen' instance into a 'StatefulGen' instance. -- -- [Drawing from a range] 'UniformRange' is used to generate a value of a -- type uniformly within a range. @@ -192,7 +192,7 @@ import System.Random.Internal -- $monadicadapters -- -- Pure pseudo-random number generators can be used in monadic code via the --- adapters 'StateGenM', 'AtomicGenM', 'IOGenM' and 'STGenM'. +-- adapters 'StateGenM', 'AtomicGenM', 'IOGenM', 'STGenM' and 'TGenM' -- -- * 'StateGenM' can be used in any state monad. With strict 'StateT' there is -- no performance overhead compared to using the 'RandomGen' instance @@ -207,6 +207,11 @@ import System.Random.Internal -- -- * 'STGenM' is a wrapper around an 'STRef' that holds a pure generator. -- 'STGenM' is safe in the presence of exceptions, but not concurrency. +-- +-- * 'TGenM' is a wrapper around a 'TVar' that holds a pure generator. 'TGenM' +-- can be used in a software transactional memory monad 'STM`. It is not as +-- performant as 'AtomicGenM`, but it can provide stronger guarantees in a +-- concurrent setting. -- | Interface to operations on 'RandomGen' wrappers like 'IOGenM' and 'StateGenM'. --