Merge pull request #160 from haskell/lehins/SplitGen

Introduce new `SplitGen` type class

CHANGELOG.md

@@ -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`:
@@ -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`:

src/System/Random.hs

@@ -30,6 +30,7 @@ module System.Random
       , genWord64R
       , unsafeUniformFillMutableByteArray
       )
+  , SplitGen (splitGen)
   , uniform
   , uniformR
   , Random(..)
@@ -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

src/System/Random/Internal.hs

@@ -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(..)
@@ -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
@@ -251,7 +252,29 @@ 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 in the
+-- `split` function, however, few pseudo-random generators posses this property of
+-- splittability. This lead the old `split` function being usually implemented in terms of
+-- `error`.
+--
+-- @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.
+  --
+  -- @since 1.3.0
+  splitGen :: g -> (g, g)
 
 -- | 'StatefulGen' is an interface to monadic pseudo-random number generators.
 --
@@ -427,15 +450,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.
@@ -869,7 +892,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
@@ -881,23 +904,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

src/System/Random/Stateful.hs

@@ -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
@@ -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
 
@@ -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'.
 --
@@ -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'.
@@ -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'.
 --
@@ -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`.
 --

test/Spec.hs

@@ -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)

test/Spec/Stateful.hs

@@ -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