Skip to content

Commit

Permalink
Make AtomicIOGenM lazy in the value generated
Browse files Browse the repository at this point in the history
  • Loading branch information
lehins committed Oct 27, 2024
1 parent 99073e7 commit 5db2353
Showing 1 changed file with 23 additions and 2 deletions.
25 changes: 23 additions & 2 deletions src/System/Random/Stateful.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
Expand Down Expand Up @@ -143,6 +144,10 @@ import Data.STRef
import Foreign.Storable
import System.Random
import System.Random.Internal
#if __GLASGOW_HASKELL__ >= 808
import GHC.IORef (atomicModifyIORef2Lazy)
#endif


-- $introduction
--
Expand Down Expand Up @@ -414,7 +419,7 @@ instance (RandomGen g, MonadIO m) => FrozenGen (AtomicGen g) m where
type MutableGen (AtomicGen g) m = AtomicGenM g
freezeGen = fmap AtomicGen . liftIO . readIORef . unAtomicGenM
modifyGen (AtomicGenM ioRef) f =
liftIO $ atomicModifyIORef' ioRef $ \g ->
liftIO $ atomicModifyIORefHS ioRef $ \g ->
case f (AtomicGen g) of
(a, AtomicGen g') -> (g', a)
{-# INLINE modifyGen #-}
Expand All @@ -436,11 +441,27 @@ instance (RandomGen g, MonadIO m) => ThawedGen (AtomicGen g) m where
-- @since 1.2.0
applyAtomicGen :: MonadIO m => (g -> (a, g)) -> AtomicGenM g -> m a
applyAtomicGen op (AtomicGenM gVar) =
liftIO $ atomicModifyIORef' gVar $ \g ->
liftIO $ atomicModifyIORefHS gVar $ \g ->
case op g of
(a, g') -> (g', a)
{-# INLINE applyAtomicGen #-}

-- HalfStrict version of atomicModifyIORef, i.e. strict in the modifcation of the contents
-- of the IORef, but not in the result produced.
atomicModifyIORefHS :: IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORefHS ref f = do
#if __GLASGOW_HASKELL__ >= 808
(_old, (_new, res)) <- atomicModifyIORef2Lazy ref $ \old ->
case f old of
r@(!_new, _res) -> r
pure res
#else
atomicModifyIORef ref $ \old ->
case f old of
r@(!_new, _res) -> r
#endif
{-# INLINE atomicModifyIORefHS #-}

-- | Wraps an 'IORef' that holds a pure pseudo-random number generator.
--
-- * 'IOGenM' is safe in the presence of exceptions, but not concurrency.
Expand Down

0 comments on commit 5db2353

Please sign in to comment.