strict-mutable-base 1.1.0.0 → 2.0.0.0

raw patch · 11 files changed

+633/−146 lines, 11 filesdep +strict-mutable-basedep +tastydep +tasty-hunitdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: strict-mutable-base, tasty, tasty-hunit

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• README.md +2/−0
• src/Control/Concurrent/Chan/Strict.hs +47/−28
• src/Control/Concurrent/MVar/Strict.hs +252/−81
• src/Data/IORef/Strict.hs +89/−34
• strict-mutable-base.cabal +24/−3
• tests/ChanTests.hs +39/−0
• tests/IORefTests.hs +58/−0
• tests/MVarTests.hs +75/−0
• tests/Main.hs +14/−0
• tests/Utils.hs +27/−0

@@ -1,3 +1,9 @@+# strict-mutable-base-2.0.0.0 (2026-08-19)+* Drop support for GHC < 8.10.+* Drop ticks in names of all operations and types to make the modules+  forward-compatible with versions to-be-included in `base`+  (https://github.com/haskell/core-libraries-committee/issues/341).+ # strict-mutable-base-1.1.0.0 (2024-09-04) * Rename `getChanContents'` to `getChan'Contents` for consistency. 

@@ -11,3 +11,5 @@ [IORef](https://hackage.haskell.org/package/base/docs/Data-IORef.html) and [MVar](https://hackage.haskell.org/package/base/docs/Control-Concurrent-MVar.html) for proactive prevention of space leaks.++Modules in this package are designed to be imported qualified (usually as `S` or `Strict`, depending on your taste for verbosity).

@@ -1,47 +1,66 @@--- | For full documentation please refer to "Control.Concurrent.Chan".+-- | Unbounded channels whose content is evaluated to Weak Head Normal Form (WHNF).+--+-- The channels are implemented with t'Control.Concurrent.MVar.MVar's and+-- therefore inherit all the caveats that apply to @MVar@s (possibility of+-- races, deadlocks etc). The+-- @stm@ (software transactional memory) library has a more robust implementation+-- of channels called @TChan@s. module Control.Concurrent.Chan.Strict-  ( Chan'+  ( Chan      -- * Operations-  , newChan'-  , writeChan'-  , readChan'-  , dupChan'-  , getChan'Contents-  , writeList2Chan'+  , newChan+  , writeChan+  , readChan+  , dupChan+  , getChanContents+  , writeList2Chan   ) where  import Control.Exception (evaluate) import qualified Control.Concurrent.Chan as Base --- | A strict (WHNF) variant of 'Base.Chan'.-newtype Chan' a = Chan' (Base.Chan a)+-- | 'Chan' is a strict (WHNF) abstract type representing an unbounded FIFO channel.+newtype Chan a = Chan (Base.Chan a)   deriving Eq --- | 'Base.newChan' for 'Chan''.-newChan' :: IO (Chan' a)-newChan' = Chan' <$> Base.newChan+-- | Build and return a new instance of 'Chan'.+newChan :: IO (Chan a)+newChan = Chan <$> Base.newChan --- | 'Base.writeChan' for 'Chan''.+-- | Write a value to a 'Chan'. -- -- Evaluates the value to WHNF.-writeChan' :: Chan' a -> a -> IO ()-writeChan' (Chan' chan) a = Base.writeChan chan =<< evaluate a+writeChan :: Chan a -> a -> IO ()+writeChan (Chan chan) a = Base.writeChan chan =<< evaluate a --- | 'Base.readChan' for 'Chan''.-readChan' :: Chan' a -> IO a-readChan' (Chan' chan) = Base.readChan chan+-- | Read the next value from the 'Chan'. Blocks when the channel is empty. Since+-- the read end of a channel is an t'Control.Concurrent.MVar.MVar', this+-- operation inherits fairness guarantees of @MVar@s (e.g. threads blocked in+-- this operation are woken up in FIFO order).+--+-- Throws t'Control.Exception.BlockedIndefinitelyOnMVar' when the channel is+-- empty and no other thread holds a reference to the channel.+readChan :: Chan a -> IO a+readChan (Chan chan) = Base.readChan chan --- | 'Base.dupChan' for 'Chan''.-dupChan' :: Chan' a -> IO (Chan' a)-dupChan' (Chan' chan) = Chan' <$> Base.dupChan chan+-- | Duplicate a 'Chan': the duplicate channel begins empty, but data written to+-- either channel from then on will be available from both. Hence this creates+-- a kind of broadcast channel, where data written by anyone is seen by+-- everyone else.+--+-- (Note that a duplicated channel is not equal to its original.+-- So: @fmap (c /=) $ dupChan c@ returns 'True' for all @c@.)+dupChan :: Chan a -> IO (Chan a)+dupChan (Chan chan) = Chan <$> Base.dupChan chan --- | 'Base.getChanContents' for 'Chan''.-getChan'Contents :: Chan' a -> IO [a]-getChan'Contents (Chan' chan) = Base.getChanContents chan+-- | Return a lazy list representing the contents of the supplied 'Chan', much+-- like 'System.IO.hGetContents'.+getChanContents :: Chan a -> IO [a]+getChanContents (Chan chan) = Base.getChanContents chan --- | 'Base.writeList2Chan' for 'Chan''.+-- | Write an entire list of items to a 'Chan'. -- -- Evaluates the values to WHNF.-writeList2Chan' :: Chan' a -> [a] -> IO ()-writeList2Chan' = mapM_ . writeChan'+writeList2Chan :: Chan a -> [a] -> IO ()+writeList2Chan = mapM_ . writeChan

@@ -1,135 +1,306 @@--- | For full documentation please refer to "Control.Concurrent.MVar".+-- | An @'MVar' t@ is a mutable location that is either empty or contains a+-- value of type @t@.  It has two fundamental operations: 'putMVar'+-- which fills an 'MVar' if it is empty and blocks otherwise, and+-- 'takeMVar' which empties an 'MVar' if it is full and blocks+-- otherwise.  They can be used in multiple different ways:+--+--   1. As synchronized mutable variables,+--+--   2. As channels, with 'takeMVar' and 'putMVar' as receive and send, and+--+--   3. As a binary semaphore @'MVar' ()@, with 'takeMVar' and 'putMVar' as+--      wait and signal.+--+-- They were introduced in the paper+-- ["Concurrent Haskell"](https://www.microsoft.com/en-us/research/wp-content/uploads/1996/01/concurrent-haskell.pdf)+-- by Simon Peyton Jones, Andrew Gordon and Sigbjorn Finne, though+-- some details of their implementation have since then changed (in+-- particular, a put on a full 'MVar' used to error, but now merely+-- blocks.)+--+-- === Applicability+--+-- 'MVar's offer more flexibility than t'Data.IORef.Strict.IORef's, but less+-- flexibility than t'GHC.Conc.STM'.  They are appropriate for building+-- synchronization primitives and performing simple inter-thread communication;+-- however they are very simple and susceptible to race conditions, deadlocks or+-- uncaught exceptions.  Do not use them if you need to perform larger+-- atomic operations such as reading from multiple variables: use t'GHC.Conc.STM'+-- instead.+--+-- In particular, the "bigger" functions in this module ('swapMVar',+-- 'withMVar', 'modifyMVar_' and 'modifyMVar') are simply+-- the composition of a 'takeMVar' followed by a 'putMVar' with+-- exception safety.+-- These have atomicity guarantees only if all other threads+-- perform a 'takeMVar' before a 'putMVar' as well;  otherwise, they may+-- block.+--+-- === Fairness+--+-- No thread can be blocked indefinitely on an 'MVar' unless another+-- thread holds that 'MVar' indefinitely.  One usual implementation of+-- this fairness guarantee is that threads blocked on an 'MVar' are+-- served in a first-in-first-out fashion (this is what GHC does),+-- but this is not guaranteed in the semantics.+--+-- === Ordering+--+-- 'MVar' operations are always observed to take place in the order+-- they are written in the program, regardless of the memory model of+-- the underlying machine.  This is in contrast to t'Data.IORef.Strict.IORef'+-- operations which may appear out-of-order to another thread in some cases.+--+-- === Example+--+-- Consider the following concurrent data structure, a skip channel.+-- This is a channel for an intermittent source of high bandwidth+-- information (for example, mouse movement events.)  Writing to the+-- channel never blocks, and reading from the channel only returns the+-- most recent value, or blocks if there are no new values.  Multiple+-- readers are supported with a @dupSkipChan@ operation.+--+-- A skip channel is a pair of 'MVar's. The first 'MVar' contains the+-- current value, and a list of semaphores that need to be notified+-- when it changes. The second 'MVar' is a semaphore for this particular+-- reader: it is full if there is a value in the channel that this+-- reader has not read yet, and empty otherwise.+--+-- @+-- data SkipChan a = SkipChan (MVar (a, [MVar ()])) (MVar ())+--+-- newSkipChan :: IO (SkipChan a)+-- newSkipChan = do+--     sem <- newEmptyMVar+--     main <- newMVar (undefined, [sem])+--     return (SkipChan main sem)+--+-- putSkipChan :: SkipChan a -> a -> IO ()+-- putSkipChan (SkipChan main _) v = do+--     (_, sems) <- takeMVar main+--     putMVar main (v, [])+--     mapM_ (\\sem -> putMVar sem ()) sems+--+-- getSkipChan :: SkipChan a -> IO a+-- getSkipChan (SkipChan main sem) = do+--     takeMVar sem+--     (v, sems) <- takeMVar main+--     putMVar main (v, sem : sems)+--     return v+--+-- dupSkipChan :: SkipChan a -> IO (SkipChan a)+-- dupSkipChan (SkipChan main _) = do+--     sem <- newEmptyMVar+--     (v, sems) <- takeMVar main+--     putMVar main (v, sem : sems)+--     return (SkipChan main sem)+-- @+--+-- This example was adapted from the original Concurrent Haskell paper.+-- For more examples of 'MVar's being used to build higher-level+-- synchronization primitives, see t'Control.Concurrent.Chan.Strict.Chan' and+-- t'Control.Concurrent.QSem.QSem'. module Control.Concurrent.MVar.Strict-  ( MVar'+  ( MVar      -- * Operations-  , newEmptyMVar'-  , newMVar'-  , takeMVar'-  , putMVar'-  , readMVar'-  , swapMVar'-  , tryTakeMVar'-  , tryPutMVar'-  , tryReadMVar'-  , isEmptyMVar'-  , withMVar'-  , withMVar'Masked-  , modifyMVar'_-  , modifyMVar'-  , modifyMVar'Masked_-  , modifyMVar'Masked-  , mkWeakMVar'+  , newEmptyMVar+  , newMVar+  , takeMVar+  , putMVar+  , readMVar+  , swapMVar+  , tryTakeMVar+  , tryPutMVar+  , tryReadMVar+  , isEmptyMVar+  , withMVar+  , withMVarMasked+  , modifyMVar_+  , modifyMVar+  , modifyMVarMasked_+  , modifyMVarMasked+  , mkWeakMVar   ) where  import Control.DeepSeq import Control.Exception (evaluate) import GHC.Exts (mkWeak#) import GHC.IO (IO(..))-import GHC.MVar (MVar(..)) import GHC.Weak (Weak(..)) import qualified Control.Concurrent.MVar as Base+import qualified GHC.MVar as GHC --- | Strict (WHNF) version of 'MVar'.-newtype MVar' a = MVar' (MVar a)+-- | An 'MVar' (pronounced \"em-var\") is a synchronising variable+-- used for communication between concurrent threads, which evaluates its content+-- to Weak Head Normal Form.+-- It can be thought of as a box, which may be empty or full.+newtype MVar a = MVar (GHC.MVar a)   deriving (Eq, NFData, NFData1) --- | 'Base.newEmptyMVar' for an 'MVar''.-newEmptyMVar' :: IO (MVar' a)-newEmptyMVar' = MVar' <$> Base.newEmptyMVar+-- | Create an 'MVar' which is initially empty.+newEmptyMVar :: IO (MVar a)+newEmptyMVar = MVar <$> Base.newEmptyMVar --- | 'Base.newMVar' for an 'MVar''.+-- | Create an 'MVar' which contains the supplied value. -- -- Evaluates the initial value to WHNF.-newMVar' :: a -> IO (MVar' a)-newMVar' a = fmap MVar' . Base.newMVar =<< evaluate a+newMVar :: a -> IO (MVar a)+newMVar a = fmap MVar . Base.newMVar =<< evaluate a --- | 'Base.takeMVar' for an 'MVar''.-takeMVar' :: MVar' a -> IO a-takeMVar' (MVar' var) = Base.takeMVar var+-- | Return the contents of the 'MVar'.  If the 'MVar' is currently+-- empty, 'takeMVar' will wait until it is full.  After a 'takeMVar',+-- the 'MVar' is left empty.+--+-- There are two further important properties of 'takeMVar':+--+--   * 'takeMVar' is single-wakeup.  That is, if there are multiple+--     threads blocked in 'takeMVar', and the 'MVar' becomes full,+--     only one thread will be woken up.  The runtime guarantees that+--     the woken thread completes its 'takeMVar' operation.+--+--   * When multiple threads are blocked on an 'MVar', they are+--     woken up in FIFO order.  This is useful for providing+--     fairness properties of abstractions built using 'MVar's.+--+takeMVar :: MVar a -> IO a+takeMVar (MVar var) = Base.takeMVar var --- | 'Base.putMVar' for an 'MVar''.+-- | Put a value into an 'MVar'.  If the 'MVar' is currently full,+-- 'putMVar' will wait until it becomes empty. --+-- There are two further important properties of 'putMVar':+--+--   * 'putMVar' is single-wakeup.  That is, if there are multiple+--     threads blocked in 'putMVar', and the 'MVar' becomes empty,+--     only one thread will be woken up.  The runtime guarantees that+--     the woken thread completes its 'putMVar' operation.+--+--   * When multiple threads are blocked on an 'MVar', they are+--     woken up in FIFO order.  This is useful for providing+--     fairness properties of abstractions built using 'MVar's.+-- -- Evaluates the new value to WHNF.-putMVar' :: MVar' a -> a -> IO ()-putMVar' (MVar' var) a = Base.putMVar var =<< evaluate a+putMVar :: MVar a -> a -> IO ()+putMVar (MVar var) a = Base.putMVar var =<< evaluate a --- | 'Base.readMVar' for an 'MVar''.-readMVar' :: MVar' a -> IO a-readMVar' (MVar' var) = Base.readMVar var+-- | Atomically read the contents of an 'MVar'.  If the 'MVar' is+-- currently empty, 'readMVar' will wait until it is full.+-- 'readMVar' is guaranteed to receive the next 'putMVar'.+--+-- 'readMVar' is multiple-wakeup, so when multiple readers are+-- blocked on an 'MVar', all of them are woken up at the same time.+-- The runtime guarantees that all woken threads complete their 'readMVar' operation.+readMVar :: MVar a -> IO a+readMVar (MVar var) = Base.readMVar var --- | 'Base.swapMVar' for an 'MVar''.+-- | Take a value from an 'MVar', put a new value into the 'MVar' and+-- return the value taken. This function is atomic only if there are+-- no other producers for this 'MVar'. In other words, it cannot guarantee+-- that, by the time 'swapMVar' gets the chance to write to the 'MVar',+-- the value of the 'MVar' has not been altered+-- by a write operation from another thread. -- -- Evaluates the new value to WHNF.-swapMVar' :: MVar' a -> a -> IO a-swapMVar' (MVar' var) a = Base.swapMVar var =<< evaluate a+swapMVar :: MVar a -> a -> IO a+swapMVar (MVar var) a = Base.swapMVar var =<< evaluate a --- | 'Base.tryTakeMVar' for an 'MVar''.-tryTakeMVar' :: MVar' a -> IO (Maybe a)-tryTakeMVar' (MVar' var) = Base.tryTakeMVar var+-- | A non-blocking version of 'takeMVar'.  The 'tryTakeMVar' function+-- returns immediately, with 'Nothing' if the 'MVar' was empty, or+-- @'Just' a@ if the 'MVar' was full with contents @a@.  After 'tryTakeMVar',+-- the 'MVar' is left empty.+tryTakeMVar :: MVar a -> IO (Maybe a)+tryTakeMVar (MVar var) = Base.tryTakeMVar var --- | 'Base.tryPutMVar' for an 'MVar''.+-- | A non-blocking version of 'putMVar'.  The 'tryPutMVar' function+-- attempts to put the value @a@ into the 'MVar', returning 'True' if+-- it was successful, or 'False' otherwise. -- -- Evaluates the new value to WHNF.-tryPutMVar' :: MVar' a -> a -> IO Bool-tryPutMVar' (MVar' var) a = Base.tryPutMVar var =<< evaluate a+tryPutMVar :: MVar a -> a -> IO Bool+tryPutMVar (MVar var) a = Base.tryPutMVar var =<< evaluate a --- | 'Base.tryReadMVar' for an 'MVar''.-tryReadMVar' :: MVar' a -> IO (Maybe a)-tryReadMVar' (MVar' var) = Base.tryReadMVar var+-- | A non-blocking version of 'readMVar'.  The 'tryReadMVar' function+-- returns immediately, with 'Nothing' if the 'MVar' was empty, or+-- @'Just' a@ if the 'MVar' was full with contents @a@.+tryReadMVar :: MVar a -> IO (Maybe a)+tryReadMVar (MVar var) = Base.tryReadMVar var --- | 'Base.isEmptyMVar' for an 'MVar''.-isEmptyMVar' :: MVar' a -> IO Bool-isEmptyMVar' (MVar' var) = Base.isEmptyMVar var+-- | Check whether a given 'MVar' is empty.+--+-- Notice that the boolean value returned is just a snapshot of+-- the state of the 'MVar'. By the time you get to react on its result,+-- the 'MVar' may have been filled (or emptied) - so be extremely+-- careful when using this operation.  Use 'tryTakeMVar' instead if possible.+isEmptyMVar :: MVar a -> IO Bool+isEmptyMVar (MVar var) = Base.isEmptyMVar var --- | 'Base.withMVar' for an 'MVar''.-withMVar' :: MVar' a -> (a -> IO b) -> IO b-withMVar' (MVar' var) action = Base.withMVar var action-{-# INLINE withMVar' #-}+-- | 'withMVar' is an exception-safe wrapper for operating on the contents+-- of an 'MVar'.  This operation is exception-safe: it will replace the+-- original contents of the 'MVar' if an exception is raised (see+-- "Control.Exception").  However, it is only atomic if there are no+-- other producers for this 'MVar'. In other words, it cannot guarantee+-- that, by the time 'withMVar' gets the chance to write to the 'MVar',+-- the value of the 'MVar' has not been altered+-- by a write operation from another thread.+withMVar :: MVar a -> (a -> IO b) -> IO b+withMVar (MVar var) action = Base.withMVar var action+{-# INLINE withMVar #-} --- | 'Base.withMVarMasked' for an 'MVar''.-withMVar'Masked :: MVar' a -> (a -> IO b) -> IO b-withMVar'Masked (MVar' var) action = Base.withMVarMasked var action-{-# INLINE withMVar'Masked #-}+-- | Like 'withMVar', but the @IO@ action in the second argument is executed+-- with asynchronous exceptions masked.+withMVarMasked :: MVar a -> (a -> IO b) -> IO b+withMVarMasked (MVar var) action = Base.withMVarMasked var action+{-# INLINE withMVarMasked #-} --- | 'Base.modifyMVar_' for an 'MVar''.+-- | An exception-safe wrapper for modifying the contents of an 'MVar'.+-- Like 'withMVar', 'modifyMVar_' will replace the original contents of+-- the 'MVar' if an exception is raised during the operation.  This+-- function is only atomic if there are no other producers for this+-- 'MVar'. In other words, it cannot guarantee that, by the time+-- 'modifyMVar_' gets the chance to write to the 'MVar', the value+-- of the 'MVar' has not been altered by a write operation from another thread. -- -- Evaluates the new value to WHNF.-modifyMVar'_ :: MVar' a -> (a -> IO a) -> IO ()-modifyMVar'_ (MVar' var) action = Base.modifyMVar_ var $ \a0 -> do+modifyMVar_ :: MVar a -> (a -> IO a) -> IO ()+modifyMVar_ (MVar var) action = Base.modifyMVar_ var $ \a0 -> do   a <- action a0   evaluate a-{-# INLINE modifyMVar'_ #-}+{-# INLINE modifyMVar_ #-} --- | 'Base.modifyMVar' for an 'MVar''.+-- | A slight variation on 'modifyMVar_' that allows a value to be+-- returned (@b@) in addition to the modified value of the 'MVar'. ----- Evaluates the new value to WHNF.-modifyMVar' :: MVar' a -> (a -> IO (a, b)) -> IO b-modifyMVar' (MVar' var) action = Base.modifyMVar var $ \a0 -> do+-- Evaluates the new value to WHNF. The returned value is not evaluated.+modifyMVar :: MVar a -> (a -> IO (a, b)) -> IO b+modifyMVar (MVar var) action = Base.modifyMVar var $ \a0 -> do   (a, b) <- action a0   (, b) <$> evaluate a-{-# INLINE modifyMVar' #-}+{-# INLINE modifyMVar #-} --- | 'Base.modifyMVarMasked_' for an 'MVar''.+-- | Like 'modifyMVar_', but the @IO@ action in the second argument is executed with+-- asynchronous exceptions masked. -- -- Evaluates the new value to WHNF.-modifyMVar'Masked_ :: MVar' a -> (a -> IO a) -> IO ()-modifyMVar'Masked_ (MVar' var) action = Base.modifyMVarMasked_ var $ \a0 -> do+modifyMVarMasked_ :: MVar a -> (a -> IO a) -> IO ()+modifyMVarMasked_ (MVar var) action = Base.modifyMVarMasked_ var $ \a0 -> do   a <- action a0   evaluate a-{-# INLINE modifyMVar'Masked_ #-}+{-# INLINE modifyMVarMasked_ #-} --- | 'Base.modifyMVarMasked' for an 'MVar''.+-- | Like 'modifyMVar', but the @IO@ action in the second argument is executed with+-- asynchronous exceptions masked. ----- Evaluates the new value to WHNF.-modifyMVar'Masked :: MVar' a -> (a -> IO (a, b)) -> IO b-modifyMVar'Masked (MVar' var) action = Base.modifyMVarMasked var $ \a0 -> do+-- Evaluates the new value to WHNF. The returned value is not evaluated.+modifyMVarMasked :: MVar a -> (a -> IO (a, b)) -> IO b+modifyMVarMasked (MVar var) action = Base.modifyMVarMasked var $ \a0 -> do   (a, b) <- action a0   (, b) <$> evaluate a-{-# INLINE modifyMVar'Masked #-}+{-# INLINE modifyMVarMasked #-} --- | 'Base.mkWeakMVar' for an 'MVar''.-mkWeakMVar' :: MVar' a -> IO () -> IO (Weak (MVar' a))-mkWeakMVar' var@(MVar' (MVar var#)) (IO finalizer) = IO $ \s0 ->+-- | Make a 'Weak' pointer to an 'MVar', using the second argument as+-- a finalizer to run when the 'MVar' is garbage-collected.+mkWeakMVar :: MVar a -> IO () -> IO (Weak (MVar a))+mkWeakMVar var@(MVar (GHC.MVar var#)) (IO finalizer) = IO $ \s0 ->   case mkWeak# var# var finalizer s0 of     (# s1, w #) -> (# s1, Weak w #)

@@ -1,64 +1,119 @@--- | For full documentation please refer to "Data.IORef".+-- | Mutable references in the IO monad. module Data.IORef.Strict-  ( IORef'+  ( IORef      -- * Operations-  , newIORef'-  , readIORef'-  , writeIORef'-  , modifyIORef'-  , atomicModifyIORef'-  , atomicWriteIORef'-  , mkWeakIORef'+  , newIORef+  , readIORef+  , writeIORef+  , modifyIORef+  , atomicModifyIORef+  , atomicWriteIORef+  , mkWeakIORef   ) where  import Control.DeepSeq import Control.Exception (evaluate) import GHC.Exts (mkWeak#) import GHC.IO (IO(..))-import GHC.IORef (IORef(..)) import GHC.STRef (STRef(..)) import GHC.Weak (Weak(..)) import qualified Data.IORef as Base+import qualified GHC.IORef as GHC --- | A strict (WHNF) variant of 'IORef'.-newtype IORef' a = IORef' (Base.IORef a)+-- | A mutable variable in the @IO@ monad, which evaluates its content to Weak+-- Head Normal Form.+newtype IORef a = IORef (Base.IORef a)   deriving (Eq, NFData, NFData1) --- | 'Base.newIORef' for 'IORef''.+-- | Build a new 'IORef'. -- -- Evaluates the initial value to WHNF.-newIORef' :: a -> IO (IORef' a)-newIORef' a = fmap IORef' . Base.newIORef =<< evaluate a+newIORef :: a -> IO (IORef a)+newIORef a = fmap IORef . Base.newIORef =<< evaluate a --- | 'Base.readIORef' for 'IORef''.-readIORef' :: IORef' a -> IO a-readIORef' (IORef' var) = Base.readIORef var+-- | Read the value of an 'IORef'.+--+-- Beware that the CPU executing a thread can reorder reads or writes+-- to independent locations. See "Data.IORef#memmodel" for more details.+readIORef :: IORef a -> IO a+readIORef (IORef var) = Base.readIORef var --- | 'Base.writeIORef' for 'IORef''.+-- | Write a new value into an 'IORef'. --+-- This function does not create a memory barrier and can be reordered+-- with other independent reads and writes within a thread, which may cause issues+-- for multithreaded execution. In these cases, consider using 'atomicWriteIORef'+-- instead. See "Data.IORef#memmodel" for more details.+-- -- Evaluates the new value to WHNF.-writeIORef' :: IORef' a -> a -> IO ()-writeIORef' (IORef' var) a = Base.writeIORef var =<< evaluate a---- | 'Base.modifyIORef' for 'IORef''.-modifyIORef' :: IORef' a -> (a -> a) -> IO ()-modifyIORef' (IORef' var) f = Base.modifyIORef' var f+writeIORef :: IORef a -> a -> IO ()+writeIORef (IORef var) a = Base.writeIORef var =<< evaluate a --- | 'Base.atomicModifyIORef' for 'IORef''.+-- | Mutate the contents of an 'IORef', combining 'readIORef' and 'writeIORef'.+-- This is not an atomic update, consider using 'atomicModifyIORef' when+-- operating in a multithreaded environment. -- -- Evaluates the new value to WHNF.-atomicModifyIORef' :: IORef' a -> (a -> (a, b)) -> IO b-atomicModifyIORef' (IORef' var) f = Base.atomicModifyIORef' var f+modifyIORef :: IORef a -> (a -> a) -> IO ()+modifyIORef (IORef var) f = Base.modifyIORef' var f --- | 'Base.atomicWriteIORef' for 'IORef''.+-- | Atomically modifies the contents of an 'IORef'. --+-- This function is useful for using 'IORef' in a safe way in a multithreaded+-- program.  If you only have one 'IORef', then using 'atomicModifyIORef' to+-- access and modify it will prevent race conditions.+--+-- Extending the atomicity to multiple 'IORef's is problematic, so it+-- is recommended that if you need to do anything more complicated+-- then using t'Control.Concurrent.MVar.Strict.MVar' instead is a good idea.+--+-- Conceptually,+--+-- @+-- atomicModifyIORef ref f = do+--   -- Begin atomic block+--   old <- 'readIORef' ref+--   let r = f old+--       new = fst r+--   'writeIORef' ref new+--   -- End atomic block+--   case r of+--     (_new, res) -> pure res+-- @+--+-- The actions in the section labeled \"atomic block\" are not subject to+-- interference from other threads. In particular, it is impossible for the+-- value in the 'IORef' to change between the 'readIORef' and 'writeIORef'+-- invocations.+--+-- Note that+--+-- @atomicModifyIORef ref (\\_ -> undefined)@+--+-- will raise an exception in the calling thread, but will /also/+-- install the bottoming value in the 'IORef', where it may be read by+-- other threads.+--+-- This function imposes a memory barrier, preventing reordering around the+-- \"atomic block\"; see "Data.IORef#memmodel" for details.+--+-- Evaluates both the new value and the returned value to WHNF.+atomicModifyIORef :: IORef a -> (a -> (a, b)) -> IO b+atomicModifyIORef (IORef var) f = Base.atomicModifyIORef' var f++-- | Variant of 'writeIORef'. The prefix "atomic" relates to a fact that+-- it imposes a reordering barrier, similar to 'atomicModifyIORef'.+-- Such a write will not be reordered with other reads+-- or writes even on CPUs with weak memory model.+-- -- Evaluates the new value to WHNF.-atomicWriteIORef' :: IORef' a -> a -> IO ()-atomicWriteIORef' (IORef' var) a = Base.atomicWriteIORef var =<< evaluate a+atomicWriteIORef :: IORef a -> a -> IO ()+atomicWriteIORef (IORef var) a = Base.atomicWriteIORef var =<< evaluate a --- | 'Base.mkWeakIORef' for 'IORef''.-mkWeakIORef' :: IORef' a -> IO () -> IO (Weak (IORef' a))-mkWeakIORef' var@(IORef' (IORef (STRef var#))) (IO finalizer) = IO $ \s0 ->+-- | Make a 'Weak' pointer to an 'IORef', using the second argument as a finalizer+-- to run when the 'IORef' is garbage-collected.+mkWeakIORef :: IORef a -> IO () -> IO (Weak (IORef a))+mkWeakIORef var@(IORef (GHC.IORef (STRef var#))) (IO finalizer) = IO $ \s0 ->   case mkWeak# var# var finalizer s0 of     (# s1, w #) -> (# s1, Weak w #)

@@ -1,7 +1,7 @@ cabal-version:      3.0 build-type:         Simple name:               strict-mutable-base-version:            1.1.0.0+version:            2.0.0.0 homepage:           https://github.com/arybczak/strict-mutable license:            BSD-3-Clause license-file:       LICENSE@@ -18,7 +18,7 @@   CHANGELOG.md   README.md -tested-with: GHC == { 8.0.2, 8.2.2, 8.4.4, 8.6.5, 8.8.4, 8.10.7, 9.0.2, 9.2.8, 9.4.8, 9.6.6, 9.8.2, 9.10.1 }+tested-with: GHC == { 8.10.7, 9.0.2, 9.2.8, 9.4.8, 9.6.7, 9.8.4, 9.10.3, 9.12.4, 9.14.1 }  bug-reports:   https://github.com/arybczak/strict-mutable/issues source-repository head@@ -39,7 +39,7 @@ library     import:           language -    build-depends:    base >=4.9 && < 5+    build-depends:    base >=4.14 && < 5                     , deepseq >= 1.4.3.0      hs-source-dirs:   src@@ -47,3 +47,24 @@     exposed-modules:  Control.Concurrent.Chan.Strict                       Control.Concurrent.MVar.Strict                       Data.IORef.Strict++test-suite test+    import:           language++    type:             exitcode-stdio-1.0++    build-depends:    base+                    , strict-mutable-base+                    , tasty >= 1.0+                    , tasty-hunit >= 0.10++    hs-source-dirs:   tests++    main-is:          Main.hs++    other-modules:    ChanTests+                      IORefTests+                      MVarTests+                      Utils++    default-extensions: TypeApplications

@@ -0,0 +1,39 @@+module ChanTests (chanTests) where++import Control.Concurrent.Chan.Strict+import Test.Tasty+import Test.Tasty.HUnit++import Utils++chanTests :: TestTree+chanTests = testGroup "Chan"+  [ testCase "basic operations" test_basicOperations+  , testCase "values are forced" test_valuesAreForced+  , testCase "values are forced only to WHNF" test_valuesAreForcedOnlyToWHNF+  ]++test_basicOperations :: Assertion+test_basicOperations = do+  chan <- newChan @Int+  writeChan chan 1+  writeList2Chan chan [2, 3]+  readChan chan >>= assertEqual "first value" 1+  dup <- dupChan chan+  writeChan chan 4+  readChan dup >>= assertEqual "value seen by the duplicate" 4+  contents <- getChanContents chan+  assertEqual "contents of the original" [2, 3, 4] (take 3 contents)++test_valuesAreForced :: Assertion+test_valuesAreForced = do+  chan <- newChan @Int+  assertForced "writeChan" $ writeChan chan bomb+  assertForced "writeList2Chan" $ writeList2Chan chan [1, bomb]+  readChan chan >>= assertEqual "only the first value was written" 1++test_valuesAreForcedOnlyToWHNF :: Assertion+test_valuesAreForcedOnlyToWHNF = do+  chan <- newChan+  assertNotForced "writeChan" $ writeChan chan (Just (bomb :: Int))+  assertNotForced "writeList2Chan" $ writeList2Chan chan [Just bomb]

@@ -0,0 +1,58 @@+module IORefTests (ioRefTests) where++import Data.IORef.Strict+import System.Mem.Weak+import Test.Tasty+import Test.Tasty.HUnit++import Utils++ioRefTests :: TestTree+ioRefTests = testGroup "IORef"+  [ testCase "basic operations" test_basicOperations+  , testCase "mkWeakIORef" test_mkWeakIORef+  , testCase "values are forced" test_valuesAreForced+  , testCase "values are forced only to WHNF" test_valuesAreForcedOnlyToWHNF+  ]++test_basicOperations :: Assertion+test_basicOperations = do+  ref <- newIORef (1 :: Int)+  readIORef ref >>= assertEqual "initial value" 1+  writeIORef ref 2+  readIORef ref >>= assertEqual "value after writeIORef" 2+  modifyIORef ref (+ 1)+  readIORef ref >>= assertEqual "value after modifyIORef" 3+  atomicWriteIORef ref 4+  readIORef ref >>= assertEqual "value after atomicWriteIORef" 4+  out <- atomicModifyIORef ref $ \a -> (a * 2, show a)+  assertEqual "result of atomicModifyIORef" "4" out+  readIORef ref >>= assertEqual "value after atomicModifyIORef" 8++test_mkWeakIORef :: Assertion+test_mkWeakIORef = do+  ref <- newIORef (1 :: Int)+  weak <- mkWeakIORef ref $ pure ()+  deRefWeak weak >>= \case+    Just ref' -> assertBool "weak pointer points at the ref" (ref' == ref)+    Nothing -> assertFailure "weak pointer is dead"++test_valuesAreForced :: Assertion+test_valuesAreForced = do+  assertForced "newIORef" $ newIORef bomb+  ref <- newIORef (1 :: Int)+  assertForced "writeIORef" $ writeIORef ref bomb+  assertForced "modifyIORef" $ modifyIORef ref (const bomb)+  assertForced "atomicWriteIORef" $ atomicWriteIORef ref bomb+  assertForced "atomicModifyIORef (result)" $ atomicModifyIORef ref $ \a -> (a, bomb)+  readIORef ref >>= assertEqual "value is intact" 1+  -- A failed atomicModifyIORef installs the bottoming value, so it goes last.+  assertForced "atomicModifyIORef (new value)" $ atomicModifyIORef ref $ \_ -> (bomb, ())++test_valuesAreForcedOnlyToWHNF :: Assertion+test_valuesAreForcedOnlyToWHNF = do+  ref <- newIORef (Just (bomb :: Int))+  assertNotForced "writeIORef" $ writeIORef ref (Just bomb)+  assertNotForced "modifyIORef" $ modifyIORef ref (const (Just bomb))+  assertNotForced "atomicWriteIORef" $ atomicWriteIORef ref (Just bomb)+  assertNotForced "atomicModifyIORef" $ atomicModifyIORef ref $ \a -> (a, Just bomb)

@@ -0,0 +1,75 @@+module MVarTests (mVarTests) where++import Control.Concurrent.MVar.Strict+import System.Mem.Weak+import Test.Tasty+import Test.Tasty.HUnit++import Utils++mVarTests :: TestTree+mVarTests = testGroup "MVar"+  [ testCase "basic operations" test_basicOperations+  , testCase "mkWeakMVar" test_mkWeakMVar+  , testCase "values are forced" test_valuesAreForced+  , testCase "values are forced only to WHNF" test_valuesAreForcedOnlyToWHNF+  ]++test_basicOperations :: Assertion+test_basicOperations = do+  var <- newEmptyMVar @Int+  isEmptyMVar var >>= assertBool "new var is empty"+  tryTakeMVar var >>= assertEqual "tryTakeMVar on an empty var" Nothing+  tryReadMVar var >>= assertEqual "tryReadMVar on an empty var" Nothing+  tryPutMVar var 1 >>= assertBool "tryPutMVar on an empty var"+  isEmptyMVar var >>= assertBool "var is full" . not+  tryPutMVar var 2 >>= assertBool "tryPutMVar on a full var" . not+  tryReadMVar var >>= assertEqual "tryReadMVar on a full var" (Just 1)+  readMVar var >>= assertEqual "value from readMVar" 1+  takeMVar var >>= assertEqual "value from takeMVar" 1+  putMVar var 3+  swapMVar var 4 >>= assertEqual "old value from swapMVar" 3+  withMVar var $ assertEqual "value in withMVar" 4+  withMVarMasked var $ assertEqual "value in withMVarMasked" 4+  modifyMVar_ var $ pure . (+ 1)+  readMVar var >>= assertEqual "value after modifyMVar_" 5+  modifyMVarMasked_ var $ pure . (+ 1)+  readMVar var >>= assertEqual "value after modifyMVarMasked_" 6+  out <- modifyMVar var $ \a -> pure (a + 1, show a)+  assertEqual "result of modifyMVar" "6" out+  outMasked <- modifyMVarMasked var $ \a -> pure (a + 1, show a)+  assertEqual "result of modifyMVarMasked" "7" outMasked+  readMVar var >>= assertEqual "final value" 8++test_mkWeakMVar :: Assertion+test_mkWeakMVar = do+  var <- newMVar (1 :: Int)+  weak <- mkWeakMVar var $ pure ()+  deRefWeak weak >>= \case+    Just var' -> assertBool "weak pointer points at the var" (var' == var)+    Nothing -> assertFailure "weak pointer is dead"++test_valuesAreForced :: Assertion+test_valuesAreForced = do+  assertForced "newMVar" $ newMVar bomb+  emptyVar <- newEmptyMVar @Int+  assertForced "putMVar" $ putMVar emptyVar bomb+  assertForced "tryPutMVar" $ tryPutMVar emptyVar bomb+  isEmptyMVar emptyVar >>= assertBool "var is still empty"+  var <- newMVar (1 :: Int)+  assertForced "swapMVar" $ swapMVar var bomb+  assertForced "modifyMVar_" $ modifyMVar_ var $ \_ -> pure bomb+  assertForced "modifyMVar" $ modifyMVar var $ \_ -> pure (bomb, ())+  assertForced "modifyMVarMasked_" $ modifyMVarMasked_ var $ \_ -> pure bomb+  assertForced "modifyMVarMasked" $ modifyMVarMasked var $ \_ -> pure (bomb, ())+  readMVar var >>= assertEqual "value is intact" 1++test_valuesAreForcedOnlyToWHNF :: Assertion+test_valuesAreForcedOnlyToWHNF = do+  emptyVar <- newEmptyMVar+  assertNotForced "putMVar" $ putMVar emptyVar (Just (bomb :: Int))+  var <- newMVar (Just (bomb :: Int))+  assertNotForced "swapMVar" $ swapMVar var (Just bomb)+  assertNotForced "modifyMVar_" $ modifyMVar_ var $ \_ -> pure (Just bomb)+  assertNotForced "modifyMVar (result)" $ modifyMVar var $ \a -> pure (a, bomb)+  assertNotForced "modifyMVarMasked (result)" $ modifyMVarMasked var $ \a -> pure (a, bomb)

@@ -0,0 +1,14 @@+module Main (main) where++import Test.Tasty++import ChanTests+import IORefTests+import MVarTests++main :: IO ()+main = defaultMain $ testGroup "strict-mutable-base"+  [ ioRefTests+  , mVarTests+  , chanTests+  ]

@@ -0,0 +1,27 @@+module Utils+  ( bomb+  , assertForced+  , assertNotForced+  ) where++import Control.Exception+import Test.Tasty.HUnit++-- | A value that throws when forced to WHNF.+bomb :: a+bomb = error bombMessage++bombMessage :: String+bombMessage = "bomb"++-- | Assert that the action forces the 'bomb' it was handed.+assertForced :: String -> IO a -> Assertion+assertForced preface action = try @ErrorCall action >>= \case+  Left (ErrorCall msg) -> assertEqual (preface ++ ": unexpected error") bombMessage msg+  Right _ -> assertFailure $ preface ++ ": the value was not forced"++-- | Assert that the action doesn't force the value it was handed past WHNF.+assertNotForced :: String -> IO a -> Assertion+assertNotForced preface action = try @ErrorCall action >>= \case+  Left err -> assertFailure $ preface ++ ": the value was forced (" ++ show err ++ ")"+  Right _ -> pure ()