    {-# 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 :: forall a. 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 a. a -> STM 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 :: forall a. 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 a. a -> IO 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 :: forall a. 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 a. a -> STM 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 a. a -> STM 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 a. a -> STM 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 :: forall a. 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 a. a -> STM 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 a. a -> STM 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 a. a -> STM 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 a. a -> STM 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 :: forall a. 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 a. a -> STM 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 :: forall a. 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 a b. (a -> b) -> Maybe a -> Maybe b
    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 :: forall a. 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 a. a -> STM a
    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 :: forall a. 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 a. a -> STM a
    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 a. a -> STM a
    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 a. a -> STM a
    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 :: forall a. 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 a. a -> STM a
    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 :: forall a. 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 :: forall a. 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 :: forall a. 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 :: forall a. 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 a. a -> STM a
    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 a. a -> STM a
    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 :: forall a. 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 a. a -> STM a
    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 a. a -> STM a
    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 :: forall a. 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 a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    n'

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