Skip to content

Commit

Permalink
Introduce new SplitGen type class
Browse files Browse the repository at this point in the history
  • Loading branch information
lehins committed Jan 27, 2024
1 parent a87b1c0 commit 3411863
Show file tree
Hide file tree
Showing 6 changed files with 57 additions and 34 deletions.
4 changes: 3 additions & 1 deletion CHANGELOG.md
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
# 1.3.0

* Add `SplitGen` and `splitGen`
* Add `shuffleList` and `shuffleListM`: [#140](https://github.com/haskell/random/pull/140)
* Add `mkStdGen64`: [#155](https://github.com/haskell/random/pull/155)
* Add `uniformListRM`, `uniformList`, `uniformListR`, `uniforms` and `uniformRs`:
Expand All @@ -23,7 +24,8 @@
* Move `thawGen` from `FreezeGen` into the new `ThawGen` type class. Fixes an issue with
an unlawful instance of `StateGen` for `FreezeGen`.
* Add `modifyGen` and `overwriteGen` to the `FrozenGen` type class
* Add `splitGen` and `splitMutableGen`
* Switch `splitGenM` to use `SplitGen` and `FrozenGen` instead of deprecated `RandomGenM`
* Add `splitMutableGenM`
* Switch `randomM` and `randomRM` to use `FrozenGen` instead of `RandomGenM`
* Deprecate `RandomGenM` in favor of a more powerful `FrozenGen`
* Add `isInRangeOrd` and `isInRangeEnum` that can be used for implementing `isInRange`:
Expand Down
3 changes: 2 additions & 1 deletion src/System/Random.hs
Original file line number Diff line number Diff line change
Expand Up @@ -30,6 +30,7 @@ module System.Random
, genWord64R
, unsafeUniformFillMutableByteArray
)
, SplitGen (splitGen)
, uniform
, uniformR
, Random(..)
Expand Down Expand Up @@ -632,7 +633,7 @@ getStdGen = liftIO $ readIORef theStdGen
--
-- @since 1.0.0
newStdGen :: MonadIO m => m StdGen
newStdGen = liftIO $ atomicModifyIORef' theStdGen split
newStdGen = liftIO $ atomicModifyIORef' theStdGen splitGen

-- | Uses the supplied function to get a value from the current global
-- random generator, and updates the global generator with the new generator
Expand Down
52 changes: 40 additions & 12 deletions src/System/Random/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -28,11 +28,12 @@
module System.Random.Internal
(-- * Pure and monadic pseudo-random number generator interfaces
RandomGen(..)
, SplitGen(..)
, StatefulGen(..)
, FrozenGen(..)
, ThawedGen(..)
, splitGen
, splitMutableGen
, splitGenM
, splitMutableGenM

-- ** Standard pseudo-random number generator
, StdGen(..)
Expand Down Expand Up @@ -131,7 +132,7 @@ import Data.ByteString (ByteString)
{-# DEPRECATED next "No longer used" #-}
{-# DEPRECATED genRange "No longer used" #-}
class RandomGen g where
{-# MINIMAL split,(genWord32|genWord64|(next,genRange)) #-}
{-# MINIMAL (genWord32|genWord64|(next,genRange)) #-}
-- | Returns an 'Int' that is uniformly distributed over the range returned by
-- 'genRange' (including both end points), and a new generator. Using 'next'
-- is inefficient as all operations go via 'Integer'. See
Expand Down Expand Up @@ -251,7 +252,30 @@ class RandomGen g where
--
-- @since 1.0.0
split :: g -> (g, g)
default split :: SplitGen g => g -> (g, g)
split = splitGen

{-# DEPRECATED split "In favor of `splitGen`" #-}

-- | Pseudo-random generators that can be split into two separate and independent
-- psuedo-random generators can have an instance for this type class.
--
-- Historically this functionality was included in the `RandomGen` type class, however few
-- pseudo-random generators out their have this property. This lead the old `split` being
-- usually implemented in terms of `error`, whcih is note very type safe.
--
-- @since 1.3.0
class RandomGen g => SplitGen g where

-- | Returns two distinct pseudo-random number generators.
--
-- Implementations should take care to ensure that the resulting generators
-- are not correlated. Some pseudo-random number generators are not
-- splittable. In that case, the 'split' implementation should fail with a
-- descriptive 'error' message.
--
-- @since 1.3.0
splitGen :: g -> (g, g)

-- | 'StatefulGen' is an interface to monadic pseudo-random number generators.
--
Expand Down Expand Up @@ -427,15 +451,15 @@ class FrozenGen f m => ThawedGen f m where
-- generators produced by a `split` function and returns the other.
--
-- @since 1.3.0
splitGen :: (RandomGen f, FrozenGen f m) => MutableGen f m -> m f
splitGen = flip modifyGen split
splitGenM :: (SplitGen f, FrozenGen f m) => MutableGen f m -> m f
splitGenM = flip modifyGen splitGen

-- | Splits a pseudo-random number generator into two. Overwrites the mutable wrapper with
-- one of the resulting generators and returns the other as a new mutable generator.
--
-- @since 1.3.0
splitMutableGen :: (RandomGen f, ThawedGen f m) => MutableGen f m -> m (MutableGen f m)
splitMutableGen = splitGen >=> thawGen
splitMutableGenM :: (SplitGen f, ThawedGen f m) => MutableGen f m -> m (MutableGen f m)
splitMutableGenM = splitGenM >=> thawGen

-- | Efficiently generates a sequence of pseudo-random bytes in a platform
-- independent manner.
Expand Down Expand Up @@ -869,7 +893,7 @@ shuffleListM xs gen = do

-- | The standard pseudo-random number generator.
newtype StdGen = StdGen { unStdGen :: SM.SMGen }
deriving (Show, RandomGen, NFData)
deriving (Show, RandomGen, SplitGen, NFData)

instance Eq StdGen where
StdGen x1 == StdGen x2 = SM.unseedSMGen x1 == SM.unseedSMGen x2
Expand All @@ -881,23 +905,27 @@ instance RandomGen SM.SMGen where
{-# INLINE genWord32 #-}
genWord64 = SM.nextWord64
{-# INLINE genWord64 #-}
split = SM.splitSMGen
{-# INLINE split #-}
-- Despite that this is the same default implementation as in the type class definition,
-- for some mysterious reason without this overwrite, performance of ByteArray generation
-- slows down by a factor of x4:
unsafeUniformFillMutableByteArray = defaultUnsafeUniformFillMutableByteArray
{-# INLINE unsafeUniformFillMutableByteArray #-}

instance SplitGen SM.SMGen where
splitGen = SM.splitSMGen
{-# INLINE splitGen #-}

instance RandomGen SM32.SMGen where
next = SM32.nextInt
{-# INLINE next #-}
genWord32 = SM32.nextWord32
{-# INLINE genWord32 #-}
genWord64 = SM32.nextWord64
{-# INLINE genWord64 #-}
split = SM32.splitSMGen
{-# INLINE split #-}

instance SplitGen SM32.SMGen where
splitGen = SM32.splitSMGen
{-# INLINE splitGen #-}

-- | Constructs a 'StdGen' deterministically.
mkStdGen :: Int -> StdGen
Expand Down
21 changes: 6 additions & 15 deletions src/System/Random/Stateful.hs
Original file line number Diff line number Diff line change
Expand Up @@ -43,12 +43,11 @@ module System.Random.Stateful
, withMutableGen_
, randomM
, randomRM
, splitGen
, splitMutableGen
, splitGenM
, splitMutableGenM

-- ** Deprecated
, RandomGenM(..)
, splitGenM

-- * Monadic adapters for pure pseudo-random number generators #monadicadapters#
-- $monadicadapters
Expand Down Expand Up @@ -249,14 +248,6 @@ class (RandomGen r, StatefulGen g m) => RandomGenM g r m | g -> r where
{-# DEPRECATED applyRandomGenM "In favor of `modifyGen`" #-}
{-# DEPRECATED RandomGenM "In favor of `FrozenGen`" #-}

-- | Splits a pseudo-random number generator into two. Overwrites the mutable
-- wrapper with one of the resulting generators and returns the other.
--
-- @since 1.2.0
splitGenM :: RandomGenM g r m => g -> m r
splitGenM = applyRandomGenM split
{-# DEPRECATED splitGenM "In favor of `splitGen`" #-}

instance (RandomGen r, MonadIO m) => RandomGenM (IOGenM r) r m where
applyRandomGenM = applyIOGen

Expand Down Expand Up @@ -360,7 +351,7 @@ newtype AtomicGenM g = AtomicGenM { unAtomicGenM :: IORef g}
--
-- @since 1.2.0
newtype AtomicGen g = AtomicGen { unAtomicGen :: g}
deriving (Eq, Ord, Show, RandomGen, Storable, NFData)
deriving (Eq, Ord, Show, RandomGen, SplitGen, Storable, NFData)

-- | Creates a new 'AtomicGenM'.
--
Expand Down Expand Up @@ -451,7 +442,7 @@ newtype IOGenM g = IOGenM { unIOGenM :: IORef g }
--
-- @since 1.2.0
newtype IOGen g = IOGen { unIOGen :: g }
deriving (Eq, Ord, Show, RandomGen, Storable, NFData)
deriving (Eq, Ord, Show, RandomGen, SplitGen, Storable, NFData)


-- | Creates a new 'IOGenM'.
Expand Down Expand Up @@ -522,7 +513,7 @@ newtype STGenM g s = STGenM { unSTGenM :: STRef s g }
--
-- @since 1.2.0
newtype STGen g = STGen { unSTGen :: g }
deriving (Eq, Ord, Show, RandomGen, Storable, NFData)
deriving (Eq, Ord, Show, RandomGen, SplitGen, Storable, NFData)

-- | Creates a new 'STGenM'.
--
Expand Down Expand Up @@ -617,7 +608,7 @@ newtype TGenM g = TGenM { unTGenM :: TVar g }
--
-- @since 1.2.1
newtype TGen g = TGen { unTGen :: g }
deriving (Eq, Ord, Show, RandomGen, Storable, NFData)
deriving (Eq, Ord, Show, RandomGen, SplitGen, Storable, NFData)

-- | Creates a new 'TGenM' in `STM`.
--
Expand Down
3 changes: 2 additions & 1 deletion test/Spec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -299,7 +299,8 @@ newtype ConstGen = ConstGen Word64

instance RandomGen ConstGen where
genWord64 g@(ConstGen c) = (c, g)
split g = (g, g)
instance SplitGen ConstGen where
splitGen g = (g, g)

data Colors = Red | Green | Blue | Purple | Yellow | Black | White | Orange
deriving (Eq, Ord, Show, Generic, Enum, Bounded)
Expand Down
8 changes: 4 additions & 4 deletions test/Spec/Stateful.hs
Original file line number Diff line number Diff line change
Expand Up @@ -101,19 +101,19 @@ immutableFrozenGenSpec toIO frozen =
pure $ all (x ==) xs

splitMutableGenSpec ::
forall f m. (RandomGen f, ThawedGen f m, Eq f, Show f)
forall f m. (SplitGen f, ThawedGen f m, Eq f, Show f)
=> (forall a. m a -> IO a)
-> f
-> Property IO
splitMutableGenSpec toIO frozen =
monadic $ toIO $ do
(sfg1, fg1) <- withMutableGen frozen splitGen
(smg2, fg2) <- withMutableGen frozen splitMutableGen
(sfg1, fg1) <- withMutableGen frozen splitGenM
(smg2, fg2) <- withMutableGen frozen splitMutableGenM
sfg3 <- freezeGen smg2
pure $ fg1 == fg2 && sfg1 == sfg3

thawedGenSpecFor ::
forall f m. (RandomGen f, ThawedGen f m, Eq f, Show f, Serial IO f, Typeable f)
forall f m. (SplitGen f, ThawedGen f m, Eq f, Show f, Serial IO f, Typeable f)
=> (forall a. m a -> IO a)
-> Proxy f
-> TestTree
Expand Down

0 comments on commit 3411863

Please sign in to comment.