{-# OPTIONS_GHC -Wall -fwarn-tabs #-}
{-# LANGUAGE CPP, DeriveDataTypeable #-}

#if __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Safe #-}
#endif
----------------------------------------------------------------
--                                                    2021.10.17
-- |
-- Module      :  Control.Concurrent.STM.TBMChan
-- Copyright   :  Copyright (c) 2011--2021 wren gayle romano
-- License     :  BSD
-- Maintainer  :  wren@cpan.org
-- Stability   :  provisional
-- Portability :  non-portable (GHC STM, DeriveDataTypeable)
--
-- A version of "Control.Concurrent.STM.TChan" where the queue is
-- bounded in length and closeable. This combines the abilities of
-- "Control.Concurrent.STM.TBChan" and "Control.Concurrent.STM.TMChan".
-- This variant incorporates ideas from Thomas M. DuBuisson's
-- @bounded-tchan@ package in order to reduce contention between
-- readers and writers.
----------------------------------------------------------------
module Control.Concurrent.STM.TBMChan
    (
    -- * The TBMChan type
      TBMChan()
    -- ** Creating TBMChans
    , newTBMChan
    , newTBMChanIO
    -- I don't know how to define dupTBMChan with the correct semantics
    -- ** Reading from TBMChans
    , readTBMChan
    , tryReadTBMChan
    , peekTBMChan
    , tryPeekTBMChan
    -- ** Writing to TBMChans
    , writeTBMChan
    , tryWriteTBMChan
    , unGetTBMChan
    -- ** Closing TBMChans
    , closeTBMChan
    -- ** Predicates
    , isClosedTBMChan
    , isEmptyTBMChan
    , isFullTBMChan
    -- ** Other functionality
    , estimateFreeSlotsTBMChan
    , freeSlotsTBMChan
    ) where

import Prelude             hiding (reads)
import Data.Typeable       (Typeable)
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
#endif
import Control.Monad.STM   (STM, retry)
import Control.Concurrent.STM.TVar
import Control.Concurrent.STM.TChan -- N.B., GHC only
----------------------------------------------------------------

-- | @TBMChan@ is an abstract type representing a bounded closeable
-- FIFO channel.
data TBMChan a = TBMChan
    {-# UNPACK #-} !(TVar Bool)
    {-# UNPACK #-} !(TVar Int)
    {-# UNPACK #-} !(TVar Int)
    {-# UNPACK #-} !(TChan a)
    deriving (Typeable)
-- The components are:
-- * Whether the channel has been closed.
-- * How many free slots we /know/ we have available.
-- * How many slots have been freed up by successful reads since
--   the last time the slot count was synchronized by 'isFullTBChan'.
-- * The underlying TChan.


-- | Build and returns a new instance of @TBMChan@ with the given
-- capacity. /N.B./, we do not verify the capacity is positive, but
-- if it is non-positive then 'writeTBMChan' will always retry and
-- 'isFullTBMChan' will always be true.
newTBMChan :: Int -> STM (TBMChan a)
newTBMChan :: Int -> STM (TBMChan a)
newTBMChan Int
n = do
    TVar Bool
closed <- Bool -> STM (TVar Bool)
forall a. a -> STM (TVar a)
newTVar Bool
False
    TVar Int
slots  <- Int -> STM (TVar Int)
forall a. a -> STM (TVar a)
newTVar Int
n
    TVar Int
reads  <- Int -> STM (TVar Int)
forall a. a -> STM (TVar a)
newTVar Int
0
    TChan a
chan   <- STM (TChan a)
forall a. STM (TChan a)
newTChan
    TBMChan a -> STM (TBMChan a)
forall (m :: * -> *) a. Monad m => a -> m a
return (TVar Bool -> TVar Int -> TVar Int -> TChan a -> TBMChan a
forall a. TVar Bool -> TVar Int -> TVar Int -> TChan a -> TBMChan a
TBMChan TVar Bool
closed TVar Int
slots TVar Int
reads TChan a
chan)


-- | @IO@ version of 'newTBMChan'. This is useful for creating
-- top-level @TBMChan@s using 'System.IO.Unsafe.unsafePerformIO',
-- because using 'Control.Monad.STM.atomically' inside
-- 'System.IO.Unsafe.unsafePerformIO' isn't possible.
newTBMChanIO :: Int -> IO (TBMChan a)
newTBMChanIO :: Int -> IO (TBMChan a)
newTBMChanIO Int
n = do
    TVar Bool
closed <- Bool -> IO (TVar Bool)
forall a. a -> IO (TVar a)
newTVarIO Bool
False
    TVar Int
slots  <- Int -> IO (TVar Int)
forall a. a -> IO (TVar a)
newTVarIO Int
n
    TVar Int
reads  <- Int -> IO (TVar Int)
forall a. a -> IO (TVar a)
newTVarIO Int
0
    TChan a
chan   <- IO (TChan a)
forall a. IO (TChan a)
newTChanIO
    TBMChan a -> IO (TBMChan a)
forall (m :: * -> *) a. Monad m => a -> m a
return (TVar Bool -> TVar Int -> TVar Int -> TChan a -> TBMChan a
forall a. TVar Bool -> TVar Int -> TVar Int -> TChan a -> TBMChan a
TBMChan TVar Bool
closed TVar Int
slots TVar Int
reads TChan a
chan)


-- | Read the next value from the @TBMChan@, retrying if the channel
-- is empty (and not closed). We return @Nothing@ immediately if
-- the channel is closed and empty.
readTBMChan :: TBMChan a -> STM (Maybe a)
readTBMChan :: TBMChan a -> STM (Maybe a)
readTBMChan (TBMChan TVar Bool
closed TVar Int
_slots TVar Int
reads TChan a
chan) = do
    Bool
b <- TVar Bool -> STM Bool
forall a. TVar a -> STM a
readTVar TVar Bool
closed
    if Bool
b
        then do
            Maybe a
mx <- TChan a -> STM (Maybe a)
forall a. TChan a -> STM (Maybe a)
tryReadTChan TChan a
chan
            case Maybe a
mx of
                Maybe a
Nothing -> Maybe a -> STM (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
mx
                Just a
_x -> do
                    TVar Int -> (Int -> Int) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar Int
reads (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+)
                    Maybe a -> STM (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
mx
        else do
            a
x <- TChan a -> STM a
forall a. TChan a -> STM a
readTChan TChan a
chan
            TVar Int -> (Int -> Int) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar Int
reads (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+)
            Maybe a -> STM (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x)
{-
-- The above is slightly optimized over the clearer:
readTBMChan (TBMChan closed _slots reads chan) =
    b  <- readTVar closed
    b' <- isEmptyTChan chan
    if b && b'
        then return Nothing
        else do
            x <- readTChan chan
            modifyTVar' reads (1 +)
            return (Just x)
-- TODO: compare Core and benchmarks; is the loss of clarity worth it?
-}


-- | A version of 'readTBMChan' which does not retry. Instead it
-- returns @Just Nothing@ if the channel is open but no value is
-- available; it still returns @Nothing@ if the channel is closed
-- and empty.
tryReadTBMChan :: TBMChan a -> STM (Maybe (Maybe a))
tryReadTBMChan :: TBMChan a -> STM (Maybe (Maybe a))
tryReadTBMChan (TBMChan TVar Bool
closed TVar Int
_slots TVar Int
reads TChan a
chan) = do
    Bool
b <- TVar Bool -> STM Bool
forall a. TVar a -> STM a
readTVar TVar Bool
closed
    if Bool
b
        then do
            Maybe a
mx <- TChan a -> STM (Maybe a)
forall a. TChan a -> STM (Maybe a)
tryReadTChan TChan a
chan
            case Maybe a
mx of
                Maybe a
Nothing -> Maybe (Maybe a) -> STM (Maybe (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Maybe a)
forall a. Maybe a
Nothing
                Just a
_x -> do
                    TVar Int -> (Int -> Int) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar Int
reads (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+)
                    Maybe (Maybe a) -> STM (Maybe (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
mx)
        else do
            Maybe a
mx <- TChan a -> STM (Maybe a)
forall a. TChan a -> STM (Maybe a)
tryReadTChan TChan a
chan
            case Maybe a
mx of
                Maybe a
Nothing -> Maybe (Maybe a) -> STM (Maybe (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
mx)
                Just a
_x -> do
                    TVar Int -> (Int -> Int) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar Int
reads (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+)
                    Maybe (Maybe a) -> STM (Maybe (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
mx)
{-
-- The above is slightly optimized over the clearer:
tryReadTBMChan (TBMChan closed _slots reads chan) =
    b  <- readTVar closed
    b' <- isEmptyTChan chan
    if b && b'
        then return Nothing
        else do
            mx <- tryReadTBMChan chan
            case mx of
                Nothing -> return (Just mx)
                Just _x -> do
                    modifyTVar' reads (1 +)
                    return (Just mx)
-- TODO: compare Core and benchmarks; is the loss of clarity worth it?
-}


-- | Get the next value from the @TBMChan@ without removing it,
-- retrying if the channel is empty.
peekTBMChan :: TBMChan a -> STM (Maybe a)
peekTBMChan :: TBMChan a -> STM (Maybe a)
peekTBMChan (TBMChan TVar Bool
closed TVar Int
_slots TVar Int
_reads TChan a
chan) = do
    Bool
b <- TVar Bool -> STM Bool
forall a. TVar a -> STM a
readTVar TVar Bool
closed
    if Bool
b
        then do
            Bool
b' <- TChan a -> STM Bool
forall a. TChan a -> STM Bool
isEmptyTChan TChan a
chan
            if Bool
b'
                then Maybe a -> STM (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
                else a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> STM a -> STM (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TChan a -> STM a
forall a. TChan a -> STM a
peekTChan TChan a
chan
        else a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> STM a -> STM (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TChan a -> STM a
forall a. TChan a -> STM a
peekTChan TChan a
chan
{-
-- The above is lazier reading from @chan@ than the clearer:
peekTBMChan (TBMChan closed _slots _reads chan) = do
    b  <- isEmptyTChan chan
    b' <- readTVar closed
    if b && b'
        then return Nothing
        else Just <$> peekTChan chan
-- TODO: compare Core and benchmarks; is the loss of clarity worth it?
-}


-- | A version of 'peekTBMChan' which does not retry. Instead it
-- returns @Just Nothing@ if the channel is open but no value is
-- available; it still returns @Nothing@ if the channel is closed
-- and empty.
tryPeekTBMChan :: TBMChan a -> STM (Maybe (Maybe a))
tryPeekTBMChan :: TBMChan a -> STM (Maybe (Maybe a))
tryPeekTBMChan (TBMChan TVar Bool
closed TVar Int
_slots TVar Int
_reads TChan a
chan) = do
    Bool
b <- TVar Bool -> STM Bool
forall a. TVar a -> STM a
readTVar TVar Bool
closed
    if Bool
b
        then (a -> Maybe a) -> Maybe a -> Maybe (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Maybe a -> Maybe (Maybe a))
-> STM (Maybe a) -> STM (Maybe (Maybe a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TChan a -> STM (Maybe a)
forall a. TChan a -> STM (Maybe a)
tryPeekTChan TChan a
chan
        else Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just (Maybe a -> Maybe (Maybe a))
-> STM (Maybe a) -> STM (Maybe (Maybe a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TChan a -> STM (Maybe a)
forall a. TChan a -> STM (Maybe a)
tryPeekTChan TChan a
chan
{-
-- The above is lazier reading from @chan@ (and removes an extraneous isEmptyTChan when using the compatibility layer) than the clearer:
tryPeekTBMChan (TBMChan closed _slots _reads chan) = do
    b  <- isEmptyTChan chan
    b' <- readTVar closed
    if b && b'
        then return Nothing
        else Just <$> tryPeekTChan chan
-- TODO: compare Core and benchmarks; is the loss of clarity worth it?
-}


-- | Write a value to a @TBMChan@, retrying if the channel is full.
-- If the channel is closed then the value is silently discarded.
-- Use 'isClosedTBMChan' to determine if the channel is closed
-- before writing, as needed.
writeTBMChan :: TBMChan a -> a -> STM ()
writeTBMChan :: TBMChan a -> a -> STM ()
writeTBMChan self :: TBMChan a
self@(TBMChan TVar Bool
closed TVar Int
slots TVar Int
_reads TChan a
chan) a
x = do
    Bool
b <- TVar Bool -> STM Bool
forall a. TVar a -> STM a
readTVar TVar Bool
closed
    if Bool
b
        then () -> STM ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Discard silently
        else do
            Int
n <- TBMChan a -> STM Int
forall a. TBMChan a -> STM Int
estimateFreeSlotsTBMChan TBMChan a
self
            if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
                then STM ()
forall a. STM a
retry
                else do
                    TVar Int -> Int -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Int
slots (Int -> STM ()) -> Int -> STM ()
forall a b. (a -> b) -> a -> b
$! Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                    TChan a -> a -> STM ()
forall a. TChan a -> a -> STM ()
writeTChan TChan a
chan a
x


-- | A version of 'writeTBMChan' which does not retry. Returns @Just
-- True@ if the value was successfully written, @Just False@ if it
-- could not be written (but the channel was open), and @Nothing@
-- if it was discarded (i.e., the channel was closed).
tryWriteTBMChan :: TBMChan a -> a -> STM (Maybe Bool)
tryWriteTBMChan :: TBMChan a -> a -> STM (Maybe Bool)
tryWriteTBMChan self :: TBMChan a
self@(TBMChan TVar Bool
closed TVar Int
slots TVar Int
_reads TChan a
chan) a
x = do
    Bool
b <- TVar Bool -> STM Bool
forall a. TVar a -> STM a
readTVar TVar Bool
closed
    if Bool
b
        then Maybe Bool -> STM (Maybe Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Bool
forall a. Maybe a
Nothing
        else do
            Int
n <- TBMChan a -> STM Int
forall a. TBMChan a -> STM Int
estimateFreeSlotsTBMChan TBMChan a
self
            if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
                then Maybe Bool -> STM (Maybe Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False)
                else do
                    TVar Int -> Int -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Int
slots (Int -> STM ()) -> Int -> STM ()
forall a b. (a -> b) -> a -> b
$! Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                    TChan a -> a -> STM ()
forall a. TChan a -> a -> STM ()
writeTChan TChan a
chan a
x
                    Maybe Bool -> STM (Maybe Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True)


-- | Put a data item back onto a channel, where it will be the next
-- item read. If the channel is closed then the value is silently
-- discarded; you can use 'peekTBMChan' to circumvent this in certain
-- circumstances. /N.B./, this could allow the channel to temporarily
-- become longer than the specified limit, which is necessary to
-- ensure that the item is indeed the next one read.
unGetTBMChan :: TBMChan a -> a -> STM ()
unGetTBMChan :: TBMChan a -> a -> STM ()
unGetTBMChan (TBMChan TVar Bool
closed TVar Int
slots TVar Int
_reads TChan a
chan) a
x = do
    Bool
b <- TVar Bool -> STM Bool
forall a. TVar a -> STM a
readTVar TVar Bool
closed
    if Bool
b
        then () -> STM ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Discard silently
        else do
            TVar Int -> (Int -> Int) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar Int
slots (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1)
            TChan a -> a -> STM ()
forall a. TChan a -> a -> STM ()
unGetTChan TChan a
chan a
x


-- | Closes the @TBMChan@, preventing any further writes.
closeTBMChan :: TBMChan a -> STM ()
closeTBMChan :: TBMChan a -> STM ()
closeTBMChan (TBMChan TVar Bool
closed TVar Int
_slots TVar Int
_reads TChan a
_chan) =
    TVar Bool -> Bool -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Bool
closed Bool
True


-- | Returns @True@ if the supplied @TBMChan@ has been closed.
isClosedTBMChan :: TBMChan a -> STM Bool
isClosedTBMChan :: TBMChan a -> STM Bool
isClosedTBMChan (TBMChan TVar Bool
closed TVar Int
_slots TVar Int
_reads TChan a
_chan) =
    TVar Bool -> STM Bool
forall a. TVar a -> STM a
readTVar TVar Bool
closed

{-
-- | Returns @True@ if the supplied @TBMChan@ has been closed.
isClosedTBMChanIO :: TBMChan a -> IO Bool
isClosedTBMChanIO (TBMChan closed _slots _reads _chan) =
    readTVarIO closed
-}


-- | Returns @True@ if the supplied @TBMChan@ is empty (i.e., has
-- no elements). /N.B./, a @TBMChan@ can be both \"empty\" and
-- \"full\" at the same time, if the initial limit was non-positive.
isEmptyTBMChan :: TBMChan a -> STM Bool
isEmptyTBMChan :: TBMChan a -> STM Bool
isEmptyTBMChan (TBMChan TVar Bool
_closed TVar Int
_slots TVar Int
_reads TChan a
chan) =
    TChan a -> STM Bool
forall a. TChan a -> STM Bool
isEmptyTChan TChan a
chan


-- | Returns @True@ if the supplied @TBMChan@ is full (i.e., is
-- over its limit). /N.B./, a @TBMChan@ can be both \"empty\" and
-- \"full\" at the same time, if the initial limit was non-positive.
-- /N.B./, a @TBMChan@ may still be full after reading, if
-- 'unGetTBMChan' was used to go over the initial limit.
--
-- This is equivalent to: @liftM (<= 0) estimateFreeSlotsTBMChan@
isFullTBMChan :: TBMChan a -> STM Bool
isFullTBMChan :: TBMChan a -> STM Bool
isFullTBMChan (TBMChan TVar Bool
_closed TVar Int
slots TVar Int
reads TChan a
_chan) = do
    Int
n <- TVar Int -> STM Int
forall a. TVar a -> STM a
readTVar TVar Int
slots
    if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
        then do
            Int
m <- TVar Int -> STM Int
forall a. TVar a -> STM a
readTVar TVar Int
reads
            let n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m
            TVar Int -> Int -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Int
slots (Int -> STM ()) -> Int -> STM ()
forall a b. (a -> b) -> a -> b
$! Int
n'
            TVar Int -> Int -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Int
reads Int
0
            Bool -> STM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> STM Bool) -> Bool -> STM Bool
forall a b. (a -> b) -> a -> b
$! Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
        else Bool -> STM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False


-- | Estimate the number of free slots. If the result is positive,
-- then it's a minimum bound; if it's non-positive then it's exact.
-- It will only be negative if the initial limit was negative or
-- if 'unGetTBMChan' was used to go over the initial limit.
--
-- This function always contends with writers, but only contends
-- with readers when it has to; compare against 'freeSlotsTBMChan'.
estimateFreeSlotsTBMChan :: TBMChan a -> STM Int
estimateFreeSlotsTBMChan :: TBMChan a -> STM Int
estimateFreeSlotsTBMChan (TBMChan TVar Bool
_closed TVar Int
slots TVar Int
reads TChan a
_chan) = do
    Int
n <- TVar Int -> STM Int
forall a. TVar a -> STM a
readTVar TVar Int
slots
    if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
        then Int -> STM Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
        else do
            Int
m <- TVar Int -> STM Int
forall a. TVar a -> STM a
readTVar TVar Int
reads
            let n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m
            TVar Int -> Int -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Int
slots (Int -> STM ()) -> Int -> STM ()
forall a b. (a -> b) -> a -> b
$! Int
n'
            TVar Int -> Int -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Int
reads Int
0
            Int -> STM Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n'


-- | Return the exact number of free slots. The result can be
-- negative if the initial limit was negative or if 'unGetTBMChan'
-- was used to go over the initial limit.
--
-- This function always contends with both readers and writers;
-- compare against 'estimateFreeSlotsTBMChan'.
freeSlotsTBMChan :: TBMChan a -> STM Int
freeSlotsTBMChan :: TBMChan a -> STM Int
freeSlotsTBMChan (TBMChan TVar Bool
_closed TVar Int
slots TVar Int
reads TChan a
_chan) = do
    Int
n <- TVar Int -> STM Int
forall a. TVar a -> STM a
readTVar TVar Int
slots
    Int
m <- TVar Int -> STM Int
forall a. TVar a -> STM a
readTVar TVar Int
reads
    let n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m
    TVar Int -> Int -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Int
slots (Int -> STM ()) -> Int -> STM ()
forall a b. (a -> b) -> a -> b
$! Int
n'
    TVar Int -> Int -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Int
reads Int
0
    Int -> STM Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n'

----------------------------------------------------------------
----------------------------------------------------------- fin.