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 Jan 27, 2024
1 parent ac31dc6 commit 360d1e4
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 @@ -141,6 +142,10 @@ import Data.STRef
import Foreign.Storable
import System.Random
import System.Random.Internal
#if __GLASGOW_HASKELL__ >= 802
import GHC.IORef (atomicModifyIORef2Lazy)

Check failure on line 146 in src/System/Random/Stateful.hs

View workflow job for this annotation

GitHub Actions / CI-stack (ubuntu-latest, lts-11)

Module ‘GHC.IORef’ does not export ‘atomicModifyIORef2Lazy’

Check failure on line 146 in src/System/Random/Stateful.hs

View workflow job for this annotation

GitHub Actions / CI-stack (ubuntu-latest, lts-12)

Module ‘GHC.IORef’ does not export ‘atomicModifyIORef2Lazy’

Check failure on line 146 in src/System/Random/Stateful.hs

View workflow job for this annotation

GitHub Actions / CI-stack (ubuntu-latest, lts-14)

Module ‘GHC.IORef’ does not export ‘atomicModifyIORef2Lazy’

Check failure on line 146 in src/System/Random/Stateful.hs

View workflow job for this annotation

GitHub Actions / CI-cabal (macOS-latest, 8.2.2)

Module ‘GHC.IORef’ does not export ‘atomicModifyIORef2Lazy’

Check failure on line 146 in src/System/Random/Stateful.hs

View workflow job for this annotation

GitHub Actions / CI-cabal (ubuntu-latest, 8.2.2)

Module ‘GHC.IORef’ does not export ‘atomicModifyIORef2Lazy’

Check failure on line 146 in src/System/Random/Stateful.hs

View workflow job for this annotation

GitHub Actions / CI-cabal (macOS-latest, 8.4.4)

Module ‘GHC.IORef’ does not export ‘atomicModifyIORef2Lazy’

Check failure on line 146 in src/System/Random/Stateful.hs

View workflow job for this annotation

GitHub Actions / CI-cabal (ubuntu-latest, 8.6.5)

Module ‘GHC.IORef’ does not export ‘atomicModifyIORef2Lazy’

Check failure on line 146 in src/System/Random/Stateful.hs

View workflow job for this annotation

GitHub Actions / CI-cabal (macOS-latest, 8.6.5)

Module ‘GHC.IORef’ does not export ‘atomicModifyIORef2Lazy’

Check failure on line 146 in src/System/Random/Stateful.hs

View workflow job for this annotation

GitHub Actions / CI-cabal (ubuntu-latest, 8.4.4)

Module ‘GHC.IORef’ does not export ‘atomicModifyIORef2Lazy’

Check failure on line 146 in src/System/Random/Stateful.hs

View workflow job for this annotation

GitHub Actions / CI-cabal (windows-latest, 8.4.4)

Module ‘GHC.IORef’ does not export ‘atomicModifyIORef2Lazy’

Check failure on line 146 in src/System/Random/Stateful.hs

View workflow job for this annotation

GitHub Actions / CI-cabal (windows-latest, 8.2.2)

Module ‘GHC.IORef’ does not export ‘atomicModifyIORef2Lazy’

Check failure on line 146 in src/System/Random/Stateful.hs

View workflow job for this annotation

GitHub Actions / CI-cabal (windows-latest, 8.6.5)

Module ‘GHC.IORef’ does not export ‘atomicModifyIORef2Lazy’
#endif


-- $introduction
--
Expand Down Expand Up @@ -391,7 +396,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 @@ -413,11 +418,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 360d1e4

Please sign in to comment.