    {-# LANGUAGE DeriveDataTypeable, PatternGuards #-}
    {-| Provides a fair RWLock, similar to one from Java, which is itself documented at
     <http://download.oracle.com/javase/7/docs/api/java/util/concurrent/locks/ReentrantReadWriteLock.html>

     There are complicated policy choices that have to be made.  The policy choices here are different
    from the ones for the RWLock in concurrent-extras.

     The 'FairRWLock' may be in a free unlocked state, it may be in a read locked state, or it may be a
    write locked state.  Many running threads may hold the read lock and execute concurrently.  Only one
    running thread may hold the write lock.  The scheduling is a fair FIFO queue that avoids starvation.

     When in the read lock state the first 'acquireWrite' will block, and subsequent 'acquireRead' and
    'acquireWrite' will queue in order.  When in the write locked state all other threads trying to
    'acquireWrite' or 'acquireRead' will queue in order.

     'FairRWLock' allows recursive write locks, and it allows recursive read locks, and it allows the
    write lock holding thread to acquire read locks.  When the current writer also holds read locks and
    then releases its last write lock it will immediately convert to the read locked state (and other
    waiting readers may join it).  When a reader acquires a write lock it will (1) release all its read
    locks, (2) wait to acquire the write lock, (3) retake the same number of read locks released in (1).

     The preferred way to use this API is sticking to 'new', 'withRead', and 'withWrite'.

     No sequence of calling acquire on a single RWLock should lead to deadlock.  Exceptions, espcially
    from 'killThread', do not break 'withRead' or 'withWrite'.  The 'withRead' and 'withWrite' ensure
    all locks get released when exiting due to an exception.

     The readers and writers are always identified by their 'ThreadId'.  Each thread that calls
    'acquireRead' must later call 'releaseRead' from the same thread.  Each thread that calls
    'acquireWrite' must later call 'releaseWrite' from the same thread. The main way to misuse a
    FairRWLock is to call a release without having called an acquire.  This is reported in the (Left
    error) outcomes from 'releaseRead' and 'releaseWrite'.  Only if the 'FairRWLock' has a bug and finds
    itself in an impossible state then it will throw an error.

    -}
    module Control.Concurrent.FairRWLock
      ( RWLock, RWLockException(..), RWLockExceptionKind(..),FRW(..),LockKind(..),TMap,TSet
      , new
      , withRead, withWrite
      , acquireRead, acquireWrite
      , releaseRead, releaseWrite
      , peekLock, checkLock
      ) where

    import Control.Applicative(liftA2)
    import Control.Concurrent
    import Control.Exception(Exception,bracket_,onException,evaluate,uninterruptibleMask_,mask_,throw)
    import Control.Monad((>=>),join,forM_)
    import Data.Sequence((<|),(|>),(><),Seq,ViewL(..),ViewR(..))
    import qualified Data.Sequence as Seq(empty,viewl,viewr,breakl,spanl)
    import qualified Data.Foldable as F(toList)
    import Data.Map(Map)
    import qualified Data.Map as Map
    import Data.Set(Set)
    import qualified Data.Set as Set
    import Data.Typeable(Typeable)

    -- Try to make most impossible data states unrepresentable
    type TMap = Map ThreadId Int -- nonempty, all values > 0
    type TSet = Set ThreadId     -- nonempty

    data LockKind = ReaderKind { LockKind -> TSet
    unRK :: TSet }
                  | WriterKind { LockKind -> ThreadId
    unWK :: ThreadId }
      deriving (LockKind -> LockKind -> Bool
    (LockKind -> LockKind -> Bool)
    -> (LockKind -> LockKind -> Bool) -> Eq LockKind
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: LockKind -> LockKind -> Bool
    == :: LockKind -> LockKind -> Bool
    $c/= :: LockKind -> LockKind -> Bool
    /= :: LockKind -> LockKind -> Bool
    Eq,Eq LockKind
    Eq LockKind =>
    (LockKind -> LockKind -> Ordering)
    -> (LockKind -> LockKind -> Bool)
    -> (LockKind -> LockKind -> Bool)
    -> (LockKind -> LockKind -> Bool)
    -> (LockKind -> LockKind -> Bool)
    -> (LockKind -> LockKind -> LockKind)
    -> (LockKind -> LockKind -> LockKind)
    -> Ord LockKind
    LockKind -> LockKind -> Bool
    LockKind -> LockKind -> Ordering
    LockKind -> LockKind -> LockKind
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: LockKind -> LockKind -> Ordering
    compare :: LockKind -> LockKind -> Ordering
    $c< :: LockKind -> LockKind -> Bool
    < :: LockKind -> LockKind -> Bool
    $c<= :: LockKind -> LockKind -> Bool
    <= :: LockKind -> LockKind -> Bool
    $c> :: LockKind -> LockKind -> Bool
    > :: LockKind -> LockKind -> Bool
    $c>= :: LockKind -> LockKind -> Bool
    >= :: LockKind -> LockKind -> Bool
    $cmax :: LockKind -> LockKind -> LockKind
    max :: LockKind -> LockKind -> LockKind
    $cmin :: LockKind -> LockKind -> LockKind
    min :: LockKind -> LockKind -> LockKind
    Ord,Int -> LockKind -> ShowS
    [LockKind] -> ShowS
    LockKind -> String
    (Int -> LockKind -> ShowS)
    -> (LockKind -> String) -> ([LockKind] -> ShowS) -> Show LockKind
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> LockKind -> ShowS
    showsPrec :: Int -> LockKind -> ShowS
    $cshow :: LockKind -> String
    show :: LockKind -> String
    $cshowList :: [LockKind] -> ShowS
    showList :: [LockKind] -> ShowS
    Show)

    -- LockQ may be empty
    -- No duplicate ThreadIds in LockKinds
    -- MVar () will be created empty, released once with putMVar
    type LockQ = Seq (LockKind,MVar ())

    data LockUser =
        FreeLock
      | Readers { LockUser -> TMap
    readerCounts :: TMap -- re-entrant count of reader locks held be each thread
                , LockUser -> Maybe ((ThreadId, MVar ()), LockQ)
    queueR :: Maybe ( (ThreadId,MVar ())    -- empty or queue with leading Writer
                                  , LockQ )
                }
      | Writer { LockUser -> ThreadId
    writerID :: ThreadId
               , LockUser -> Int
    writerCount           -- re-entrant writer locks held by writerID, at least 1
               , LockUser -> Int
    readerCount :: !Int   -- re-entrant reader locks held by writerID, at least 0
               , LockUser -> LockQ
    queue :: LockQ }
      deriving (LockUser -> LockUser -> Bool
    (LockUser -> LockUser -> Bool)
    -> (LockUser -> LockUser -> Bool) -> Eq LockUser
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: LockUser -> LockUser -> Bool
    == :: LockUser -> LockUser -> Bool
    $c/= :: LockUser -> LockUser -> Bool
    /= :: LockUser -> LockUser -> Bool
    Eq,Typeable)

    -- | Opaque type of the fair RWLock.
    newtype RWLock = RWL (MVar LockUser)

    -- | Exception type thrown or returned by this module.  \"Impossible\" conditions get the error thrown
    --  and usage problems get the error returned.
    data RWLockException = RWLockException ThreadId RWLockExceptionKind String
      deriving (Int -> RWLockException -> ShowS
    [RWLockException] -> ShowS
    RWLockException -> String
    (Int -> RWLockException -> ShowS)
    -> (RWLockException -> String)
    -> ([RWLockException] -> ShowS)
    -> Show RWLockException
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> RWLockException -> ShowS
    showsPrec :: Int -> RWLockException -> ShowS
    $cshow :: RWLockException -> String
    show :: RWLockException -> String
    $cshowList :: [RWLockException] -> ShowS
    showList :: [RWLockException] -> ShowS
    Show,Typeable)

    -- | Operation in which error arose,
    data RWLockExceptionKind = RWLock'acquireWrite | RWLock'releaseWrite
                             | RWLock'acquireRead  | RWLock'releaseRead
      deriving (Int -> RWLockExceptionKind -> ShowS
    [RWLockExceptionKind] -> ShowS
    RWLockExceptionKind -> String
    (Int -> RWLockExceptionKind -> ShowS)
    -> (RWLockExceptionKind -> String)
    -> ([RWLockExceptionKind] -> ShowS)
    -> Show RWLockExceptionKind
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> RWLockExceptionKind -> ShowS
    showsPrec :: Int -> RWLockExceptionKind -> ShowS
    $cshow :: RWLockExceptionKind -> String
    show :: RWLockExceptionKind -> String
    $cshowList :: [RWLockExceptionKind] -> ShowS
    showList :: [RWLockExceptionKind] -> ShowS
    Show,Typeable)

    instance Exception RWLockException

    -- | Observable state of holder(s) of lock(s).  The W returns a pair of Ints where the first is number of
    -- read locks (at least 0) and the second is the number of write locks held (at least 1).  The R
    -- returns a map from thread id to the number of read locks held (at least 1).
    data FRW = F | R TMap | W (ThreadId,(Int,Int)) deriving (Int -> FRW -> ShowS
    [FRW] -> ShowS
    FRW -> String
    (Int -> FRW -> ShowS)
    -> (FRW -> String) -> ([FRW] -> ShowS) -> Show FRW
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> FRW -> ShowS
    showsPrec :: Int -> FRW -> ShowS
    $cshow :: FRW -> String
    show :: FRW -> String
    $cshowList :: [FRW] -> ShowS
    showList :: [FRW] -> ShowS
    Show)

    -- | Create a new RWLock which starts in a free and unlocked state.
    new :: IO RWLock
    new :: IO RWLock
    new = (MVar LockUser -> RWLock) -> IO (MVar LockUser) -> IO RWLock
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap MVar LockUser -> RWLock
    RWL (LockUser -> IO (MVar LockUser)
    forall a. a -> IO (MVar a)
    newMVar LockUser
    FreeLock)

    -- | This is by far the preferred way to acquire a read lock.  This uses bracket_ to ensure
    -- acquireRead and releaseRead are called correctly around the passed command.
    --
    -- This ought to ensure releaseRead will not return a (Left error), but if it does then this error
    -- will be thrown.
    --
    -- This can block and be safely interrupted.
    withRead :: RWLock -> IO a -> IO a
    withRead :: forall a. RWLock -> IO a -> IO a
    withRead = (IO () -> IO () -> IO a -> IO a)
    -> (RWLock -> IO ()) -> (RWLock -> IO ()) -> RWLock -> IO a -> IO a
    forall a b c.
    (a -> b -> c) -> (RWLock -> a) -> (RWLock -> b) -> RWLock -> c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 IO () -> IO () -> IO a -> IO a
    forall a b c. IO a -> IO b -> IO c -> IO c
    bracket_ RWLock -> IO ()
    acquireRead (RWLock -> IO (Either RWLockException ())
    releaseRead (RWLock -> IO (Either RWLockException ()))
    -> (Either RWLockException () -> IO ()) -> RWLock -> IO ()
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> (RWLockException -> IO ())
    -> (() -> IO ()) -> Either RWLockException () -> IO ()
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either RWLockException -> IO ()
    forall a e. (HasCallStack, Exception e) => e -> a
    throw () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return)

    -- | This is by far the preferred way to acquire a write lock.  This uses bracket_ to ensure
    -- acquireWrite and releaseWrite are called correctly around the passed command.
    --
    -- This ought to ensure releaseWrite will not return a (Left error), but if it does then this error
    -- will be thrown.
    --
    -- This can block and be safely interrupted.
    withWrite :: RWLock -> IO a -> IO a
    withWrite :: forall a. RWLock -> IO a -> IO a
    withWrite = (IO () -> IO () -> IO a -> IO a)
    -> (RWLock -> IO ()) -> (RWLock -> IO ()) -> RWLock -> IO a -> IO a
    forall a b c.
    (a -> b -> c) -> (RWLock -> a) -> (RWLock -> b) -> RWLock -> c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 IO () -> IO () -> IO a -> IO a
    forall a b c. IO a -> IO b -> IO c -> IO c
    bracket_ RWLock -> IO ()
    acquireWrite (RWLock -> IO (Either RWLockException ())
    releaseWrite (RWLock -> IO (Either RWLockException ()))
    -> (Either RWLockException () -> IO ()) -> RWLock -> IO ()
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> (RWLockException -> IO ())
    -> (() -> IO ()) -> Either RWLockException () -> IO ()
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either RWLockException -> IO ()
    forall a e. (HasCallStack, Exception e) => e -> a
    throw () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return)

    -- | Observe which threads are holding the lock and which threads are waiting (in order).  This is
    -- particularly useful for writing tests.
    peekLock :: RWLock -> IO (FRW,[LockKind])
    peekLock :: RWLock -> IO (FRW, [LockKind])
    peekLock (RWL MVar LockUser
    rwlVar) = MVar LockUser
    -> (LockUser -> IO (FRW, [LockKind])) -> IO (FRW, [LockKind])
    forall a b. MVar a -> (a -> IO b) -> IO b
    withMVar MVar LockUser
    rwlVar ((LockUser -> IO (FRW, [LockKind])) -> IO (FRW, [LockKind]))
    -> (LockUser -> IO (FRW, [LockKind])) -> IO (FRW, [LockKind])
    forall a b. (a -> b) -> a -> b
    $ \ LockUser
    rwd -> (FRW, [LockKind]) -> IO (FRW, [LockKind])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((FRW, [LockKind]) -> IO (FRW, [LockKind]))
    -> (FRW, [LockKind]) -> IO (FRW, [LockKind])
    forall a b. (a -> b) -> a -> b
    $
      case LockUser
    rwd of
        LockUser
    FreeLock -> (FRW
    F,[])
        Readers { readerCounts :: LockUser -> TMap
    readerCounts=TMap
    rcs, queueR :: LockUser -> Maybe ((ThreadId, MVar ()), LockQ)
    queueR=Maybe ((ThreadId, MVar ()), LockQ)
    qr } -> (TMap -> FRW
    R TMap
    rcs,[LockKind]
    -> (((ThreadId, MVar ()), LockQ) -> [LockKind])
    -> Maybe ((ThreadId, MVar ()), LockQ)
    -> [LockKind]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] (\((ThreadId
    t,MVar ()
    _),LockQ
    q) -> ThreadId -> LockKind
    WriterKind ThreadId
    t LockKind -> [LockKind] -> [LockKind]
    forall a. a -> [a] -> [a]
    : ((LockKind, MVar ()) -> LockKind)
    -> [(LockKind, MVar ())] -> [LockKind]
    forall a b. (a -> b) -> [a] -> [b]
    map (LockKind, MVar ()) -> LockKind
    forall a b. (a, b) -> a
    fst (LockQ -> [(LockKind, MVar ())]
    forall a. Seq a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    F.toList LockQ
    q)) Maybe ((ThreadId, MVar ()), LockQ)
    qr)
        Writer { writerID :: LockUser -> ThreadId
    writerID=ThreadId
    it, writerCount :: LockUser -> Int
    writerCount=Int
    wc, readerCount :: LockUser -> Int
    readerCount=Int
    rc, queue :: LockUser -> LockQ
    queue=LockQ
    q } -> ((ThreadId, (Int, Int)) -> FRW
    W (ThreadId
    it,(Int
    rc,Int
    wc)), ((LockKind, MVar ()) -> LockKind)
    -> [(LockKind, MVar ())] -> [LockKind]
    forall a b. (a -> b) -> [a] -> [b]
    map (LockKind, MVar ()) -> LockKind
    forall a b. (a, b) -> a
    fst (LockQ -> [(LockKind, MVar ())]
    forall a. Seq a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    F.toList LockQ
    q))

    -- | checkLocks return a pair of numbers, the first is the count of read locks this thread holds,
    -- the second is the number of write locks that this thread holds.  This may be useful for sanity
    -- checking complex usage of RWLocks.
    --
    -- This may block and be safely interrupted.
    checkLock :: RWLock -> IO (Int,Int)
    checkLock :: RWLock -> IO (Int, Int)
    checkLock (RWL MVar LockUser
    rwlVar) = do
      me <- IO ThreadId
    myThreadId
      withMVar rwlVar $ \ LockUser
    rwd -> (Int, Int) -> IO (Int, Int)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Int, Int) -> IO (Int, Int)) -> (Int, Int) -> IO (Int, Int)
    forall a b. (a -> b) -> a -> b
    $
        case LockUser
    rwd of
          LockUser
    FreeLock -> (Int
    0,Int
    0)
          Readers { readerCounts :: LockUser -> TMap
    readerCounts=TMap
    rcs } ->
            case ThreadId -> TMap -> Maybe Int
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup ThreadId
    me TMap
    rcs of
              Maybe Int
    Nothing -> (Int
    0,Int
    0)
              Just Int
    rc -> (Int
    rc,Int
    0)
          Writer { writerID :: LockUser -> ThreadId
    writerID=ThreadId
    it, writerCount :: LockUser -> Int
    writerCount=Int
    wc, readerCount :: LockUser -> Int
    readerCount=Int
    rc } ->
            if ThreadId
    itThreadId -> ThreadId -> Bool
    forall a. Eq a => a -> a -> Bool
    ==ThreadId
    me then (Int
    rc,Int
    wc) else (Int
    0,Int
    0)

    -- | A thread that calls acquireRead must later call releaseRead once for each call to acquireRead.
    --
    -- If this thread has not previous called acquireRead then releaseRead will do nothing and return a
    -- (Left error).
    --
    -- This can block but cannot be interrupted.
    releaseRead :: RWLock -> IO (Either RWLockException ())
    releaseRead :: RWLock -> IO (Either RWLockException ())
    releaseRead (RWL MVar LockUser
    rwlVar) = IO (Either RWLockException ()) -> IO (Either RWLockException ())
    forall a. IO a -> IO a
    mask_ (IO (Either RWLockException ()) -> IO (Either RWLockException ()))
    -> IO (Either RWLockException ()) -> IO (Either RWLockException ())
    forall a b. (a -> b) -> a -> b
    $ do
      me <- IO ThreadId
    myThreadId
      releaseRead' False me rwlVar -- False to indicate call is from releaseRead

    -- The (abandon :: Bool) is False if called from releaseRead (from user API).
    -- The (abandon :: Bool) is True if called as handler when acquireRead[Priority] interrupted by exception (internal use).
    --
    -- There are 14 cases.
    -- Four ERROR cases from misuse of releaseRead, Three IMPOSSIBLE cases (from interruptions), Seven normal cases:
    -- Lock is Free, ERROR if releaseRead or IMPOSSIBLE if interrupted -- 1 and 2
    -- I have write lock, I have no read lock, ERROR if releaseRead or IMPOSSIBLE if interrupted -- 3 and 4
    --                  , I have at least one read lock, just decrement the counter  -- 5
    -- Someone else has write lock, abandoning my acquireWrite  -- 6
    --                            , releaseRead called in ERROR -- 7
    -- Read lock held, I have 1 read lock, no other readers, change to FreeLock -- 8
    --                                                     , change to next Writer -- 9
    --                                   , remove and leave to other readers -- 10
    --               , I have more than one read lock, just decrement the counter -- 11
    --               , I have no read lock, abandoning with no queue is IMPOSSIBLE  -- 12
    --                                    , abandoning from queue past next writer  -- 13
    --                                    , releaseRead called in ERROR -- 14
    releaseRead' :: Bool -> ThreadId -> MVar LockUser -> IO (Either RWLockException ())
    releaseRead' :: Bool -> ThreadId -> MVar LockUser -> IO (Either RWLockException ())
    releaseRead' Bool
    abandon ThreadId
    me MVar LockUser
    rwlVar = IO (Either RWLockException ()) -> IO (Either RWLockException ())
    forall a. IO a -> IO a
    uninterruptibleMask_ (IO (Either RWLockException ()) -> IO (Either RWLockException ()))
    -> ((LockUser -> IO (LockUser, Either RWLockException ()))
        -> IO (Either RWLockException ()))
    -> (LockUser -> IO (LockUser, Either RWLockException ()))
    -> IO (Either RWLockException ())
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MVar LockUser
    -> (LockUser -> IO (LockUser, Either RWLockException ()))
    -> IO (Either RWLockException ())
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar MVar LockUser
    rwlVar ((LockUser -> IO (LockUser, Either RWLockException ()))
     -> IO (Either RWLockException ()))
    -> (LockUser -> IO (LockUser, Either RWLockException ()))
    -> IO (Either RWLockException ())
    forall a b. (a -> b) -> a -> b
    $ \ LockUser
    rwd -> do
      let impossible :: Show x => String -> x -> IO a
          impossible :: forall x a. Show x => String -> x -> IO a
    impossible String
    s x
    x = RWLockException -> IO a
    forall a e. (HasCallStack, Exception e) => e -> a
    throw
            (ThreadId -> RWLockExceptionKind -> String -> RWLockException
    RWLockException ThreadId
    me (if Bool
    abandon then RWLockExceptionKind
    RWLock'acquireRead else RWLockExceptionKind
    RWLock'releaseRead) (String -> x -> String
    forall x. Show x => String -> x -> String
    imp String
    s x
    x))
          err :: Show x => String -> x -> IO (LockUser,Either RWLockException ())
          err :: forall x.
    Show x =>
    String -> x -> IO (LockUser, Either RWLockException ())
    err String
    s x
    x = (LockUser, Either RWLockException ())
    -> IO (LockUser, Either RWLockException ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((LockUser, Either RWLockException ())
     -> IO (LockUser, Either RWLockException ()))
    -> (RWLockException -> (LockUser, Either RWLockException ()))
    -> RWLockException
    -> IO (LockUser, Either RWLockException ())
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((,) LockUser
    rwd) (Either RWLockException ()
     -> (LockUser, Either RWLockException ()))
    -> (RWLockException -> Either RWLockException ())
    -> RWLockException
    -> (LockUser, Either RWLockException ())
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RWLockException -> Either RWLockException ()
    forall a b. a -> Either a b
    Left (RWLockException -> IO (LockUser, Either RWLockException ()))
    -> RWLockException -> IO (LockUser, Either RWLockException ())
    forall a b. (a -> b) -> a -> b
    $
            (ThreadId -> RWLockExceptionKind -> String -> RWLockException
    RWLockException ThreadId
    me (if Bool
    abandon then RWLockExceptionKind
    RWLock'acquireRead else RWLockExceptionKind
    RWLock'releaseRead) (String
    sString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    " : "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++x -> String
    forall a. Show a => a -> String
    show x
    x))
          ret :: LockUser -> IO (LockUser,Either RWLockException ())
          ret :: LockUser -> IO (LockUser, Either RWLockException ())
    ret LockUser
    x = (LockUser, Either RWLockException ())
    -> IO (LockUser, Either RWLockException ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LockUser
    x,() -> Either RWLockException ()
    forall a b. b -> Either a b
    Right ())

          -- if there is a bug then dropReader may find an impossible situation when abandoning a thread, and throw an error
          dropReader :: LockQ -> IO LockQ
          dropReader :: LockQ -> IO LockQ
    dropReader LockQ
    q = do
            let inR :: (LockKind, b) -> Bool
    inR (ReaderKind TSet
    rcs,b
    _) = ThreadId -> TSet -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member ThreadId
    me TSet
    rcs
                inR (LockKind, b)
    _ = Bool
    False
                (LockQ
    pre,LockQ
    myselfPost) = ((LockKind, MVar ()) -> Bool) -> LockQ -> (LockQ, LockQ)
    forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
    Seq.breakl (LockKind, MVar ()) -> Bool
    forall {b}. (LockKind, b) -> Bool
    inR LockQ
    q
            case LockQ -> ViewL (LockKind, MVar ())
    forall a. Seq a -> ViewL a
    Seq.viewl LockQ
    myselfPost of
              ViewL (LockKind, MVar ())
    EmptyL ->
                String -> ThreadId -> IO LockQ
    forall x a. Show x => String -> x -> IO a
    impossible String
    "failure to abandon acquireRead, RWLock locked by other thread(s) and this thread is not in queue" ThreadId
    me
              (LockKind
    myself,MVar ()
    mblock) :< LockQ
    post -> do
                let rcs' :: TSet
    rcs' = ThreadId -> TSet -> TSet
    forall a. Ord a => a -> Set a -> Set a
    Set.delete ThreadId
    me (LockKind -> TSet
    unRK LockKind
    myself) -- safe unRK call
                LockQ -> IO LockQ
    forall a. a -> IO a
    evaluate (LockQ -> IO LockQ) -> LockQ -> IO LockQ
    forall a b. (a -> b) -> a -> b
    $ if TSet -> Bool
    forall a. Set a -> Bool
    Set.null TSet
    rcs' then LockQ
    pre LockQ -> LockQ -> LockQ
    forall a. Seq a -> Seq a -> Seq a
    >< LockQ
    post else LockQ
    pre LockQ -> LockQ -> LockQ
    forall a. Seq a -> Seq a -> Seq a
    >< ((TSet -> LockKind
    ReaderKind TSet
    rcs',MVar ()
    mblock) (LockKind, MVar ()) -> LockQ -> LockQ
    forall a. a -> Seq a -> Seq a
    <| LockQ
    post)

      case LockUser
    rwd of
        LockUser
    FreeLock | Bool
    abandon -> {- 1 -}
          String -> ThreadId -> IO (LockUser, Either RWLockException ())
    forall x a. Show x => String -> x -> IO a
    impossible String
    "acquireRead interrupted with unlocked RWLock" ThreadId
    me

                 | Bool
    otherwise -> {- 2 -}
          String -> ThreadId -> IO (LockUser, Either RWLockException ())
    forall x.
    Show x =>
    String -> x -> IO (LockUser, Either RWLockException ())
    err String
    "cannot releaseRead lock from unlocked RWLock" ThreadId
    me

        w :: LockUser
    w@(Writer { writerID :: LockUser -> ThreadId
    writerID=ThreadId
    it, readerCount :: LockUser -> Int
    readerCount=Int
    rc, queue :: LockUser -> LockQ
    queue=LockQ
    q }) | ThreadId
    itThreadId -> ThreadId -> Bool
    forall a. Eq a => a -> a -> Bool
    ==ThreadId
    me -> do
          case Int
    rc of
            Int
    0 | Bool
    abandon -> {- 3 -}
                  String
    -> (ThreadId, ThreadId) -> IO (LockUser, Either RWLockException ())
    forall x a. Show x => String -> x -> IO a
    impossible String
    "acquireRead interrupted with write lock but not read lock" (ThreadId
    me,ThreadId
    it)

              | Bool
    otherwise -> {- 4 -}
                  String
    -> (ThreadId, ThreadId) -> IO (LockUser, Either RWLockException ())
    forall x.
    Show x =>
    String -> x -> IO (LockUser, Either RWLockException ())
    err String
    "releaseRead when holding write lock but not read lock" (ThreadId
    me,ThreadId
    it)

            Int
    _ -> do {- 5 -}
              rc' <- Int -> IO Int
    forall a. a -> IO a
    evaluate (Int -> IO Int) -> Int -> IO Int
    forall a b. (a -> b) -> a -> b
    $ Int -> Int
    forall a. Enum a => a -> a
    pred Int
    rc
              ret (w { readerCount=rc' })

        {-ditto-}                                           | Bool
    abandon -> do {- 6 -}
          q' <- LockQ -> IO LockQ
    dropReader LockQ
    q
          ret (w { queue=q' })

        {-ditto-}                                           | Bool
    otherwise -> {- 7 -}
          String -> ThreadId -> IO (LockUser, Either RWLockException ())
    forall x.
    Show x =>
    String -> x -> IO (LockUser, Either RWLockException ())
    err String
    "releaseRead called when not read locked " ThreadId
    me

        r :: LockUser
    r@(Readers { readerCounts :: LockUser -> TMap
    readerCounts=TMap
    rcs,queueR :: LockUser -> Maybe ((ThreadId, MVar ()), LockQ)
    queueR=Maybe ((ThreadId, MVar ()), LockQ)
    qR }) ->
          case ThreadId -> TMap -> Maybe Int
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup ThreadId
    me TMap
    rcs of
            Just Int
    1 -> do
              let rcs' :: TMap
    rcs' = ThreadId -> TMap -> TMap
    forall k a. Ord k => k -> Map k a -> Map k a
    Map.delete ThreadId
    me TMap
    rcs
              if TMap -> Bool
    forall k a. Map k a -> Bool
    Map.null TMap
    rcs'
                then case Maybe ((ThreadId, MVar ()), LockQ)
    qR of
                       Maybe ((ThreadId, MVar ()), LockQ)
    Nothing -> {- 8 -}
                         LockUser -> IO (LockUser, Either RWLockException ())
    ret LockUser
    FreeLock

                       Just ((ThreadId
    wid,MVar ()
    mblock),LockQ
    q) -> do {- 9 -}
                         MVar () -> () -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar ()
    mblock ()
                         LockUser -> IO (LockUser, Either RWLockException ())
    ret (Writer { writerID :: ThreadId
    writerID=ThreadId
    wid, writerCount :: Int
    writerCount=Int
    1, readerCount :: Int
    readerCount=Int
    0, queue :: LockQ
    queue=LockQ
    q })

                else LockUser -> IO (LockUser, Either RWLockException ())
    ret (LockUser
    r { readerCounts=rcs' }) {- 10 -}

            Just Int
    rc -> do {- 11 -}
              rc' <- Int -> IO Int
    forall a. a -> IO a
    evaluate (Int -> IO Int) -> Int -> IO Int
    forall a b. (a -> b) -> a -> b
    $ Int -> Int
    forall a. Enum a => a -> a
    pred Int
    rc
              rcs' <- evaluate $ Map.insert me rc' rcs
              ret (r { readerCounts=rcs' })

            Maybe Int
    Nothing   | Bool
    abandon ->
              case Maybe ((ThreadId, MVar ()), LockQ)
    qR of
                Maybe ((ThreadId, MVar ()), LockQ)
    Nothing -> {- 12 -}
                  String
    -> (ThreadId, TMap) -> IO (LockUser, Either RWLockException ())
    forall x a. Show x => String -> x -> IO a
    impossible String
    "acquireRead interrupted not holding lock and with no queue" (ThreadId
    me,TMap
    rcs)

                Just ((ThreadId, MVar ())
    w,LockQ
    q) -> {- 13 -} do
                  q' <- LockQ -> IO LockQ
    dropReader LockQ
    q
                  ret (r { queueR = Just (w,q') })

            {-ditto-} | Bool
    otherwise -> {- 14 -}
              String
    -> (ThreadId, TMap) -> IO (LockUser, Either RWLockException ())
    forall x.
    Show x =>
    String -> x -> IO (LockUser, Either RWLockException ())
    err String
    "releaseRead called with read lock held by others" (ThreadId
    me,TMap
    rcs)

    -- | A thread that calls acquireWrite must later call releaseWrite once for each call to acquireWrite.
    --
    -- If this thread has not previous called acquireWrite then releaseWrite will do nothing and return
    -- a (Left error).
    --
    -- This can block but cannot be interrupted.
    releaseWrite :: RWLock -> IO (Either RWLockException ())
    releaseWrite :: RWLock -> IO (Either RWLockException ())
    releaseWrite (RWL MVar LockUser
    rwlVar) = IO (Either RWLockException ()) -> IO (Either RWLockException ())
    forall a. IO a -> IO a
    mask_ (IO (Either RWLockException ()) -> IO (Either RWLockException ()))
    -> IO (Either RWLockException ()) -> IO (Either RWLockException ())
    forall a b. (a -> b) -> a -> b
    $ do
      me <- IO ThreadId
    myThreadId
      releaseWrite' False me rwlVar  -- False to indicate call is from releaseWrite

    -- Nine non-impossible cases, plus one impossible case
    -- Lock is Free
    -- I have write lock, I only had 1 write lock and no read locks, promote from LockQ
    --                  , I only had 1 write lock and some read locks, convert me to reader and promote leading readers
    --                  , I have many write locks, just decrement the counter
    -- Someone else has write lock, abandoning my acquireWrite
    --                            , releaseWrite called in error
    -- Read lock held, releaseWrite called in error
    --               , with no queue, abandoning acquireWrite is IMPOSSIBLE
    --               , abandoning my leading acquireWrite
    --               , abandoning my non-leading acquireWrite
    releaseWrite' :: Bool -> ThreadId -> MVar LockUser -> IO (Either RWLockException ())
    releaseWrite' :: Bool -> ThreadId -> MVar LockUser -> IO (Either RWLockException ())
    releaseWrite' Bool
    abandon ThreadId
    me MVar LockUser
    rwlVar = IO (Either RWLockException ()) -> IO (Either RWLockException ())
    forall a. IO a -> IO a
    uninterruptibleMask_ (IO (Either RWLockException ()) -> IO (Either RWLockException ()))
    -> ((LockUser -> IO (LockUser, Either RWLockException ()))
        -> IO (Either RWLockException ()))
    -> (LockUser -> IO (LockUser, Either RWLockException ()))
    -> IO (Either RWLockException ())
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MVar LockUser
    -> (LockUser -> IO (LockUser, Either RWLockException ()))
    -> IO (Either RWLockException ())
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar MVar LockUser
    rwlVar ((LockUser -> IO (LockUser, Either RWLockException ()))
     -> IO (Either RWLockException ()))
    -> (LockUser -> IO (LockUser, Either RWLockException ()))
    -> IO (Either RWLockException ())
    forall a b. (a -> b) -> a -> b
    $ \ LockUser
    rwd -> do
      let impossible :: Show x => String -> x -> IO a
          impossible :: forall x a. Show x => String -> x -> IO a
    impossible String
    s x
    x = RWLockException -> IO a
    forall a e. (HasCallStack, Exception e) => e -> a
    throw
            (ThreadId -> RWLockExceptionKind -> String -> RWLockException
    RWLockException ThreadId
    me (if Bool
    abandon then RWLockExceptionKind
    RWLock'acquireWrite else RWLockExceptionKind
    RWLock'releaseWrite) (String -> x -> String
    forall x. Show x => String -> x -> String
    imp String
    s x
    x))
          err :: Show x => String -> x -> IO (LockUser,Either RWLockException ())
          err :: forall x.
    Show x =>
    String -> x -> IO (LockUser, Either RWLockException ())
    err String
    s x
    x = (LockUser, Either RWLockException ())
    -> IO (LockUser, Either RWLockException ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((LockUser, Either RWLockException ())
     -> IO (LockUser, Either RWLockException ()))
    -> (RWLockException -> (LockUser, Either RWLockException ()))
    -> RWLockException
    -> IO (LockUser, Either RWLockException ())
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((,) LockUser
    rwd) (Either RWLockException ()
     -> (LockUser, Either RWLockException ()))
    -> (RWLockException -> Either RWLockException ())
    -> RWLockException
    -> (LockUser, Either RWLockException ())
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RWLockException -> Either RWLockException ()
    forall a b. a -> Either a b
    Left (RWLockException -> IO (LockUser, Either RWLockException ()))
    -> RWLockException -> IO (LockUser, Either RWLockException ())
    forall a b. (a -> b) -> a -> b
    $
            (ThreadId -> RWLockExceptionKind -> String -> RWLockException
    RWLockException ThreadId
    me (if Bool
    abandon then RWLockExceptionKind
    RWLock'acquireWrite else RWLockExceptionKind
    RWLock'releaseWrite) (String
    sString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    " : "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++x -> String
    forall a. Show a => a -> String
    show x
    x))
          ret :: LockUser -> IO (LockUser,Either RWLockException ())
          ret :: LockUser -> IO (LockUser, Either RWLockException ())
    ret LockUser
    x = (LockUser, Either RWLockException ())
    -> IO (LockUser, Either RWLockException ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LockUser
    x,() -> Either RWLockException ()
    forall a b. b -> Either a b
    Right ())

          dropWriter :: LockQ -> IO LockQ
          dropWriter :: LockQ -> IO LockQ
    dropWriter LockQ
    q = do
            let inW :: (LockKind, b) -> Bool
    inW (WriterKind ThreadId
    it,b
    _) = ThreadId
    meThreadId -> ThreadId -> Bool
    forall a. Eq a => a -> a -> Bool
    ==ThreadId
    it
                inW (LockKind, b)
    _ = Bool
    False
                (LockQ
    pre,LockQ
    myselfPost) = ((LockKind, MVar ()) -> Bool) -> LockQ -> (LockQ, LockQ)
    forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
    Seq.breakl (LockKind, MVar ()) -> Bool
    forall {b}. (LockKind, b) -> Bool
    inW LockQ
    q
            case LockQ -> ViewL (LockKind, MVar ())
    forall a. Seq a -> ViewL a
    Seq.viewl LockQ
    myselfPost of
              ViewL (LockKind, MVar ())
    EmptyL ->
                String -> ThreadId -> IO LockQ
    forall x a. Show x => String -> x -> IO a
    impossible String
    "failure to abandon acquireWrite, RWLock locked by other and not in queue" ThreadId
    me
              (LockKind, MVar ())
    _ :< LockQ
    post ->
                LockQ -> IO LockQ
    forall a. a -> IO a
    evaluate (LockQ -> IO LockQ) -> LockQ -> IO LockQ
    forall a b. (a -> b) -> a -> b
    $ LockQ
    preLockQ -> LockQ -> LockQ
    forall a. Seq a -> Seq a -> Seq a
    ><LockQ
    post

      case LockUser
    rwd of
        LockUser
    FreeLock | Bool
    abandon ->
         String -> ThreadId -> IO (LockUser, Either RWLockException ())
    forall x a. Show x => String -> x -> IO a
    impossible String
    "acquireWrite interrupted with unlocked RWLock" ThreadId
    me

                 | Bool
    otherwise ->
         String -> ThreadId -> IO (LockUser, Either RWLockException ())
    forall x.
    Show x =>
    String -> x -> IO (LockUser, Either RWLockException ())
    err String
    "cannot releaseWrite lock from unlocked RWLock" ThreadId
    me

        w :: LockUser
    w@(Writer { writerID :: LockUser -> ThreadId
    writerID=ThreadId
    it, writerCount :: LockUser -> Int
    writerCount=Int
    wc, readerCount :: LockUser -> Int
    readerCount=Int
    rc, queue :: LockUser -> LockQ
    queue=LockQ
    q }) | ThreadId
    itThreadId -> ThreadId -> Bool
    forall a. Eq a => a -> a -> Bool
    ==ThreadId
    me -> do
          case (Int
    wc,Int
    rc) of
            (Int
    1,Int
    0) -> LockUser -> IO (LockUser, Either RWLockException ())
    ret (LockUser -> IO (LockUser, Either RWLockException ()))
    -> IO LockUser -> IO (LockUser, Either RWLockException ())
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< LockQ -> IO LockUser
    promote LockQ
    q  -- if abandon then this is the only valid case
            (Int, Int)
    _ | Bool
    abandon -> String
    -> (ThreadId, ThreadId, Int, Int)
    -> IO (LockUser, Either RWLockException ())
    forall x a. Show x => String -> x -> IO a
    impossible String
    "acquireWrite interrupted with write lock and bad RWLock state" (ThreadId
    me,ThreadId
    it,Int
    wc,Int
    rc)
            (Int
    1,Int
    _) -> LockUser -> IO (LockUser, Either RWLockException ())
    ret (LockUser -> IO (LockUser, Either RWLockException ()))
    -> IO LockUser -> IO (LockUser, Either RWLockException ())
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Int -> LockQ -> IO LockUser
    promoteReader Int
    rc LockQ
    q
            (Int
    _,Int
    _) -> LockUser -> IO (LockUser, Either RWLockException ())
    ret (LockUser
    w { writerCount=(pred wc) })

        {-ditto-}                                                          | Bool
    abandon -> do
          q' <- LockQ -> IO LockQ
    dropWriter LockQ
    q
          ret (w { queue=q' })

        {-ditto-}                                                          | Bool
    otherwise  -> do
          String
    -> (ThreadId, ThreadId) -> IO (LockUser, Either RWLockException ())
    forall x.
    Show x =>
    String -> x -> IO (LockUser, Either RWLockException ())
    err String
    "cannot releaseWrite when not not holding the write lock" (ThreadId
    me,ThreadId
    it)

        Readers { readerCounts :: LockUser -> TMap
    readerCounts=TMap
    rcs} | Bool -> Bool
    not Bool
    abandon ->
          String
    -> (ThreadId, TMap) -> IO (LockUser, Either RWLockException ())
    forall x.
    Show x =>
    String -> x -> IO (LockUser, Either RWLockException ())
    err String
    "cannot releaseWrite when RWLock is read locked" (ThreadId
    me,TMap
    rcs)

        Readers { readerCounts :: LockUser -> TMap
    readerCounts=TMap
    rcs, queueR :: LockUser -> Maybe ((ThreadId, MVar ()), LockQ)
    queueR=Maybe ((ThreadId, MVar ()), LockQ)
    Nothing } ->
          String
    -> (ThreadId, TMap) -> IO (LockUser, Either RWLockException ())
    forall x a. Show x => String -> x -> IO a
    impossible String
    "failure to abandon acquireWrite, RWLock read locked and no queue" (ThreadId
    me,TMap
    rcs)

        r :: LockUser
    r@(Readers { readerCounts :: LockUser -> TMap
    readerCounts=TMap
    rcs, queueR :: LockUser -> Maybe ((ThreadId, MVar ()), LockQ)
    queueR=Just (w :: (ThreadId, MVar ())
    w@(ThreadId
    it,MVar ()
    _),LockQ
    q) }) | ThreadId
    itThreadId -> ThreadId -> Bool
    forall a. Eq a => a -> a -> Bool
    ==ThreadId
    me -> do
          (rcs'new,qr) <- LockQ -> IO (TMap, Maybe ((ThreadId, MVar ()), LockQ))
    splitReaders LockQ
    q
          ret (r { readerCounts=Map.union rcs rcs'new, queueR=qr })

        {- ditto -}                                                | Bool
    otherwise -> do
          q' <- LockQ -> IO LockQ
    dropWriter LockQ
    q
          ret (r { queueR=Just (w,q') })

     where
      -- | promote when converting from write lock straight to read lock
      promoteReader :: Int -> LockQ -> IO LockUser
      promoteReader :: Int -> LockQ -> IO LockUser
    promoteReader Int
    rc LockQ
    q = do
        (rcs'new, qr) <- LockQ -> IO (TMap, Maybe ((ThreadId, MVar ()), LockQ))
    splitReaders LockQ
    q
        let rcs = ThreadId -> Int -> TMap -> TMap
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert ThreadId
    me Int
    rc TMap
    rcs'new
        return (Readers { readerCounts=rcs, queueR=qr })

      -- | promote from releasing write lock
      promote :: LockQ -> IO LockUser
      promote :: LockQ -> IO LockUser
    promote LockQ
    qIn = do
        case LockQ -> ViewL (LockKind, MVar ())
    forall a. Seq a -> ViewL a
    Seq.viewl LockQ
    qIn of
          ViewL (LockKind, MVar ())
    EmptyL -> LockUser -> IO LockUser
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return LockUser
    FreeLock

          (WriterKind ThreadId
    it,MVar ()
    mblock) :< LockQ
    qOut -> do
            MVar () -> () -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar ()
    mblock ()
            LockUser -> IO LockUser
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Writer { writerID :: ThreadId
    writerID=ThreadId
    it, writerCount :: Int
    writerCount=Int
    1, readerCount :: Int
    readerCount=Int
    0, queue :: LockQ
    queue=LockQ
    qOut })

          ViewL (LockKind, MVar ())
    _ -> do
            (rcs,qr) <- LockQ -> IO (TMap, Maybe ((ThreadId, MVar ()), LockQ))
    splitReaders LockQ
    qIn
            return (Readers { readerCounts=rcs, queueR=qr })

      -- | Merge (and wake) any and all readers on left end of LockQ, and return queueR value
      splitReaders :: LockQ -> IO (TMap,Maybe ((ThreadId,MVar ()),LockQ))
      splitReaders :: LockQ -> IO (TMap, Maybe ((ThreadId, MVar ()), LockQ))
    splitReaders LockQ
    qIn = do
        let (LockQ
    more'Readers,LockQ
    qTail) = ((LockKind, MVar ()) -> Bool) -> LockQ -> (LockQ, LockQ)
    forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
    Seq.spanl (LockKind, MVar ()) -> Bool
    forall {b}. (LockKind, b) -> Bool
    isReader LockQ
    qIn
            ([LockKind]
    rks,[MVar ()]
    mblocks) = [(LockKind, MVar ())] -> ([LockKind], [MVar ()])
    forall a b. [(a, b)] -> ([a], [b])
    unzip (LockQ -> [(LockKind, MVar ())]
    forall a. Seq a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    F.toList LockQ
    more'Readers)
            rcs :: TMap
    rcs = [(ThreadId, Int)] -> TMap
    forall k a. [(k, a)] -> Map k a
    Map.fromDistinctAscList ([(ThreadId, Int)] -> TMap)
    -> ([LockKind] -> [(ThreadId, Int)]) -> [LockKind] -> TMap
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ThreadId -> (ThreadId, Int)) -> [ThreadId] -> [(ThreadId, Int)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ThreadId
    k -> (ThreadId
    k,Int
    1)) ([ThreadId] -> [(ThreadId, Int)])
    -> ([LockKind] -> [ThreadId]) -> [LockKind] -> [(ThreadId, Int)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TSet -> [ThreadId]
    forall a. Set a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    F.toList (TSet -> [ThreadId])
    -> ([LockKind] -> TSet) -> [LockKind] -> [ThreadId]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [TSet] -> TSet
    forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
    Set.unions ([TSet] -> TSet) -> ([LockKind] -> [TSet]) -> [LockKind] -> TSet
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (LockKind -> TSet) -> [LockKind] -> [TSet]
    forall a b. (a -> b) -> [a] -> [b]
    map LockKind -> TSet
    unRK ([LockKind] -> TMap) -> [LockKind] -> TMap
    forall a b. (a -> b) -> a -> b
    $ [LockKind]
    rks
            qr :: Maybe ((ThreadId, MVar ()), LockQ)
    qr = case LockQ -> ViewL (LockKind, MVar ())
    forall a. Seq a -> ViewL a
    Seq.viewl LockQ
    qTail of
                  ViewL (LockKind, MVar ())
    EmptyL -> Maybe ((ThreadId, MVar ()), LockQ)
    forall a. Maybe a
    Nothing
                  (LockKind
    wk,MVar ()
    mblock) :< LockQ
    qOut -> ((ThreadId, MVar ()), LockQ) -> Maybe ((ThreadId, MVar ()), LockQ)
    forall a. a -> Maybe a
    Just ((LockKind -> ThreadId
    unWK LockKind
    wk,MVar ()
    mblock),LockQ
    qOut) -- unWK safe
        [MVar ()] -> (MVar () -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [MVar ()]
    mblocks (\MVar ()
    mblock -> MVar () -> () -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar ()
    mblock ())
        (TMap, Maybe ((ThreadId, MVar ()), LockQ))
    -> IO (TMap, Maybe ((ThreadId, MVar ()), LockQ))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TMap
    rcs,Maybe ((ThreadId, MVar ()), LockQ)
    qr)
       where
        isReader :: (LockKind, b) -> Bool
    isReader (ReaderKind {},b
    _) = Bool
    True
        isReader (LockKind, b)
    _ = Bool
    False

    -- Six cases below:
    -- Lock is Free
    -- I already have write lock
    -- Someone else has write lock, leads to mblock
    -- I alread have read lock
    -- Someone else has read lock, no pending write lock
    -- Someone else has read lock, there is a pending write lock, leads to mblock

    -- | Any thread may call acquireRead (even ones holding write locks).  This read lock may be
    -- acquired multiple times, requiring an identical number of releaseRead calls.
    --
    -- All previous calls to acquireWrite by other threads will have succeeded and been released (or
    -- interrupted) before this acquireRead will return.
    --
    -- The best way to use acquireRead is to use withRead instead to ensure releaseRead will be called
    -- exactly once.
    --
    -- This may block and be safely interrupted.  If interrupted then the RWLock will be left unchanged.
    acquireRead :: RWLock -> IO ()
    acquireRead :: RWLock -> IO ()
    acquireRead (RWL MVar LockUser
    rwlVar) = IO () -> IO ()
    forall a. IO a -> IO a
    mask_ (IO () -> IO ())
    -> ((LockUser -> IO (LockUser, IO ())) -> IO ())
    -> (LockUser -> IO (LockUser, IO ()))
    -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO (IO ()) -> IO ()
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (IO (IO ()) -> IO ())
    -> ((LockUser -> IO (LockUser, IO ())) -> IO (IO ()))
    -> (LockUser -> IO (LockUser, IO ()))
    -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MVar LockUser -> (LockUser -> IO (LockUser, IO ())) -> IO (IO ())
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar MVar LockUser
    rwlVar ((LockUser -> IO (LockUser, IO ())) -> IO ())
    -> (LockUser -> IO (LockUser, IO ())) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \ LockUser
    rwd -> do
      me <- IO ThreadId
    myThreadId
      let safeBlock MVar a
    mblock = (MVar a -> IO a
    forall a. MVar a -> IO a
    readMVar MVar a
    mblock) IO a -> IO (Either RWLockException ()) -> IO a
    forall a b. IO a -> IO b -> IO a
    `onException` (Bool -> ThreadId -> MVar LockUser -> IO (Either RWLockException ())
    releaseRead' Bool
    True ThreadId
    me MVar LockUser
    rwlVar)
      case rwd of
        LockUser
    FreeLock ->
          (LockUser, IO ()) -> IO (LockUser, IO ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( Readers { readerCounts :: TMap
    readerCounts=ThreadId -> Int -> TMap
    forall k a. k -> a -> Map k a
    Map.singleton ThreadId
    me Int
    1, queueR :: Maybe ((ThreadId, MVar ()), LockQ)
    queueR=Maybe ((ThreadId, MVar ()), LockQ)
    forall a. Maybe a
    Nothing }
                 , () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return () )

        w :: LockUser
    w@(Writer { writerID :: LockUser -> ThreadId
    writerID=ThreadId
    it, readerCount :: LockUser -> Int
    readerCount=Int
    rc, queue :: LockUser -> LockQ
    queue=LockQ
    q }) | ThreadId
    it ThreadId -> ThreadId -> Bool
    forall a. Eq a => a -> a -> Bool
    == ThreadId
    me -> do
          rc' <- Int -> IO Int
    forall a. a -> IO a
    evaluate (Int -> IO Int) -> Int -> IO Int
    forall a b. (a -> b) -> a -> b
    $ Int -> Int
    forall a. Enum a => a -> a
    succ Int
    rc
          return ( w { readerCount=rc' }
                 , return () )

        {- ditto -}                                         | Bool
    otherwise -> do
          (q',mblock) <- LockQ -> ThreadId -> IO (LockQ, MVar ())
    enterQueueR LockQ
    q ThreadId
    me
          return ( w { queue = q' }
                 , safeBlock mblock )

        r :: LockUser
    r@(Readers { readerCounts :: LockUser -> TMap
    readerCounts=TMap
    rcs }) | Just Int
    rc <- ThreadId -> TMap -> Maybe Int
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup ThreadId
    me TMap
    rcs -> do
          rc' <- Int -> IO Int
    forall a. a -> IO a
    evaluate (Int -> IO Int) -> Int -> IO Int
    forall a b. (a -> b) -> a -> b
    $ Int -> Int
    forall a. Enum a => a -> a
    succ Int
    rc
          rcs' <- evaluate $ Map.insert me rc' rcs
          return ( r { readerCounts=rcs' }
                 , return () )

        r :: LockUser
    r@(Readers { readerCounts :: LockUser -> TMap
    readerCounts=TMap
    rcs, queueR :: LockUser -> Maybe ((ThreadId, MVar ()), LockQ)
    queueR=Maybe ((ThreadId, MVar ()), LockQ)
    Nothing }) -> do
          rcs' <- TMap -> IO TMap
    forall a. a -> IO a
    evaluate (TMap -> IO TMap) -> TMap -> IO TMap
    forall a b. (a -> b) -> a -> b
    $ ThreadId -> Int -> TMap -> TMap
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert ThreadId
    me Int
    1 TMap
    rcs
          return ( r { readerCounts=rcs' }
                 , return () )

        r :: LockUser
    r@(Readers { queueR :: LockUser -> Maybe ((ThreadId, MVar ()), LockQ)
    queueR=Just ((ThreadId, MVar ())
    w,LockQ
    q) }) -> do
          (q',mblock) <- LockQ -> ThreadId -> IO (LockQ, MVar ())
    enterQueueR LockQ
    q ThreadId
    me
          return ( r { queueR=Just (w,q') }
                 , safeBlock mblock )
     where
      -- Merge adjacent readers when adding to right end of LockQ
      enterQueueR :: LockQ -> ThreadId -> IO (LockQ,MVar ())
      enterQueueR :: LockQ -> ThreadId -> IO (LockQ, MVar ())
    enterQueueR LockQ
    qIn ThreadId
    me = do
        case LockQ -> ViewR (LockKind, MVar ())
    forall a. Seq a -> ViewR a
    Seq.viewr LockQ
    qIn of
          LockQ
    pre :> (ReaderKind TSet
    rcs,MVar ()
    mblock) -> do
            rcs' <- TSet -> IO TSet
    addMe TSet
    rcs
            return (pre |> (ReaderKind rcs', mblock),mblock)
          ViewR (LockKind, MVar ())
    _ -> do
            mblock <- IO (MVar ())
    forall a. IO (MVar a)
    newEmptyMVar
            return (qIn |> (ReaderKind (Set.singleton me),mblock), mblock)
       where
        -- Paranoid check of design assertion, TODO: remove check
        addMe :: TSet -> IO TSet
        addMe :: TSet -> IO TSet
    addMe TSet
    rcs | ThreadId -> TSet -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member ThreadId
    me TSet
    rcs = String -> IO TSet
    forall a. HasCallStack => String -> a
    error (String -> ThreadId -> String
    forall x. Show x => String -> x -> String
    imp String
    "enterQueueR.addMe when already in set" ThreadId
    me)
                  | Bool
    otherwise = TSet -> IO TSet
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ThreadId -> TSet -> TSet
    forall a. Ord a => a -> Set a -> Set a
    Set.insert ThreadId
    me TSet
    rcs)

    -- Five cases.
    -- This is not exported.  This has uninterruptibleMask_.  It is used to restore read locks released
    -- during acquireWrite when acquireWrite is called while holding read locks.  If this acquireWrite
    -- upgrade is going well then this thread holds the Writer lock and acquireReadPriority is identical
    -- to acquireRead.  If this acquireWrite gets interrupted then acquireReadPriority will to obtain
    -- the read lock or put itself at the front of the queue if another thread holds the write lock.
    acquireReadPriority :: RWLock -> IO ()
    acquireReadPriority :: RWLock -> IO ()
    acquireReadPriority (RWL MVar LockUser
    rwlVar) = IO () -> IO ()
    forall a. IO a -> IO a
    uninterruptibleMask_ (IO () -> IO ())
    -> ((LockUser -> IO (LockUser, IO ())) -> IO ())
    -> (LockUser -> IO (LockUser, IO ()))
    -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO (IO ()) -> IO ()
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (IO (IO ()) -> IO ())
    -> ((LockUser -> IO (LockUser, IO ())) -> IO (IO ()))
    -> (LockUser -> IO (LockUser, IO ()))
    -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MVar LockUser -> (LockUser -> IO (LockUser, IO ())) -> IO (IO ())
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar MVar LockUser
    rwlVar ((LockUser -> IO (LockUser, IO ())) -> IO ())
    -> (LockUser -> IO (LockUser, IO ())) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \ LockUser
    rwd -> do
      me <- IO ThreadId
    myThreadId
      let safeBlock MVar a
    mblock = (MVar a -> IO a
    forall a. MVar a -> IO a
    readMVar MVar a
    mblock) IO a -> IO (Either RWLockException ()) -> IO a
    forall a b. IO a -> IO b -> IO a
    `onException` (Bool -> ThreadId -> MVar LockUser -> IO (Either RWLockException ())
    releaseRead' Bool
    True ThreadId
    me MVar LockUser
    rwlVar)
      case rwd of
        LockUser
    FreeLock ->
          (LockUser, IO ()) -> IO (LockUser, IO ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( Readers { readerCounts :: TMap
    readerCounts=ThreadId -> Int -> TMap
    forall k a. k -> a -> Map k a
    Map.singleton ThreadId
    me Int
    1, queueR :: Maybe ((ThreadId, MVar ()), LockQ)
    queueR=Maybe ((ThreadId, MVar ()), LockQ)
    forall a. Maybe a
    Nothing }
                 , () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return () )

        w :: LockUser
    w@(Writer { writerID :: LockUser -> ThreadId
    writerID=ThreadId
    it, readerCount :: LockUser -> Int
    readerCount=Int
    rc, queue :: LockUser -> LockQ
    queue=LockQ
    q }) | ThreadId
    it ThreadId -> ThreadId -> Bool
    forall a. Eq a => a -> a -> Bool
    == ThreadId
    me -> do
          rc' <- Int -> IO Int
    forall a. a -> IO a
    evaluate (Int -> IO Int) -> Int -> IO Int
    forall a b. (a -> b) -> a -> b
    $ Int -> Int
    forall a. Enum a => a -> a
    succ Int
    rc
          return ( w { readerCount=rc' }
                 , return () )
                                                            | Bool
    otherwise -> do
          (q',mblock) <- ThreadId -> LockQ -> IO (LockQ, MVar ())
    enterQueueL ThreadId
    me LockQ
    q
          return ( w { queue = q' }
                 , safeBlock mblock )

        r :: LockUser
    r@(Readers { readerCounts :: LockUser -> TMap
    readerCounts=TMap
    rcs }) -> do
          case ThreadId -> TMap -> Maybe Int
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup ThreadId
    me TMap
    rcs of
            Just Int
    rc -> do
              rc' <- Int -> IO Int
    forall a. a -> IO a
    evaluate (Int -> IO Int) -> Int -> IO Int
    forall a b. (a -> b) -> a -> b
    $ Int -> Int
    forall a. Enum a => a -> a
    succ Int
    rc
              rcs' <- evaluate $ Map.insert me rc' rcs
              return ( r { readerCounts=rcs' }
                     , return () )

            Maybe Int
    Nothing -> do
              rcs' <- TMap -> IO TMap
    forall a. a -> IO a
    evaluate (TMap -> IO TMap) -> TMap -> IO TMap
    forall a b. (a -> b) -> a -> b
    $ ThreadId -> Int -> TMap -> TMap
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert ThreadId
    me Int
    1 TMap
    rcs
              return ( r { readerCounts=rcs' }
                     , return () )
     where
      -- Merge adjacent readers when adding to right end of LockQ
      enterQueueL :: ThreadId -> LockQ -> IO (LockQ,MVar ())
      enterQueueL :: ThreadId -> LockQ -> IO (LockQ, MVar ())
    enterQueueL ThreadId
    me LockQ
    qIn = do
        case LockQ -> ViewL (LockKind, MVar ())
    forall a. Seq a -> ViewL a
    Seq.viewl LockQ
    qIn of
          (ReaderKind TSet
    rcs,MVar ()
    mblock) :< LockQ
    post -> do
            rcs' <- TSet -> IO TSet
    addMe TSet
    rcs
            return ((ReaderKind rcs', mblock) <| post,mblock)
          ViewL (LockKind, MVar ())
    _ -> do
            mblock <- IO (MVar ())
    forall a. IO (MVar a)
    newEmptyMVar
            return ((ReaderKind (Set.singleton me),mblock) <| qIn , mblock)
       where
        -- Paranoid check of design assertion, TODO: remove check
        addMe :: TSet -> IO TSet
        addMe :: TSet -> IO TSet
    addMe TSet
    rcs | ThreadId -> TSet -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member ThreadId
    me TSet
    rcs = String -> IO TSet
    forall a. HasCallStack => String -> a
    error (String -> ThreadId -> String
    forall x. Show x => String -> x -> String
    imp String
    "enterQueueL.addMe when already in set" ThreadId
    me)
                  | Bool
    otherwise = TSet -> IO TSet
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ThreadId -> TSet -> TSet
    forall a. Ord a => a -> Set a -> Set a
    Set.insert ThreadId
    me TSet
    rcs)

    -- Six cases below:
    -- Lock is Free
    -- I already have write lock
    -- Someone else has write lock, leads to waiting
    -- I already have read lock
    -- Someone else has read lock, there is no pending write lock, wait
    -- Someone else has read lock, there is a pending write lock, wait

    -- | Any thread may call acquireWrite (even ones holding read locks, but see below for interrupted
    -- behavior).  This write lock may be acquired multiple times, requiring an identical number of
    -- releaseWrite calls.
    --
    -- All previous calls to acquireRead by other threads will have succeeded and been released (or
    -- interrupted) before this acquireWrite will return.
    --
    -- The best way to use acquireWrite is to use withWrite instead to ensure releaseWrite will be
    -- called exactly once.
    --
    -- This may block and usually be safely interrupted.  If interrupted then the RWLock will be left
    -- unchanged.  The exception to being able to interrupted when this blocks is very subtle: if this
    -- thread holds read locks and calls acquireWrite then it will release those read locks and go to
    -- the back of the queue to acquire the write lock (it does not get to skip the queue).  While
    -- blocking waiting for the write lock to be available this thread may be interrupted.  If not
    -- interrupted then the write lock will eventually be acquired, followed by re-acquiring the
    -- original number of read locks.  But if acquireWrite is interrupted after releasing read locks
    -- then it MUST restore those read locks on the way out.  To do this the internal error handler will
    -- use 'uninterruptibleMask_' and a special version of acquireRead that skips to the front of the
    -- queue; when the current lock state is a reader this works instantly but when the current lock
    -- state is a writer this thread will block in an UNINTERRUPTIBLE state until the current writer is
    -- finished.  Once this other writer is finished the error handler will obtain the read locks it
    -- needs to allow the error propagation to continue.
    acquireWrite :: RWLock -> IO ()
    acquireWrite :: RWLock -> IO ()
    acquireWrite rwl :: RWLock
    rwl@(RWL MVar LockUser
    rwlVar) = IO () -> IO ()
    forall a. IO a -> IO a
    mask_ (IO () -> IO ())
    -> ((LockUser -> IO (LockUser, IO ())) -> IO ())
    -> (LockUser -> IO (LockUser, IO ()))
    -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO (IO ()) -> IO ()
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (IO (IO ()) -> IO ())
    -> ((LockUser -> IO (LockUser, IO ())) -> IO (IO ()))
    -> (LockUser -> IO (LockUser, IO ()))
    -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MVar LockUser -> (LockUser -> IO (LockUser, IO ())) -> IO (IO ())
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar MVar LockUser
    rwlVar ((LockUser -> IO (LockUser, IO ())) -> IO ())
    -> (LockUser -> IO (LockUser, IO ())) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \ LockUser
    rwd -> do
      me <- IO ThreadId
    myThreadId
      let safeBlock MVar a
    mblock = (MVar a -> IO a
    forall a. MVar a -> IO a
    takeMVar MVar a
    mblock) IO a -> IO (Either RWLockException ()) -> IO a
    forall a b. IO a -> IO b -> IO a
    `onException` (Bool -> ThreadId -> MVar LockUser -> IO (Either RWLockException ())
    releaseWrite' Bool
    True ThreadId
    me MVar LockUser
    rwlVar)
      case rwd of
        LockUser
    FreeLock ->
          (LockUser, IO ()) -> IO (LockUser, IO ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( Writer { writerID :: ThreadId
    writerID=ThreadId
    me, writerCount :: Int
    writerCount=Int
    1, readerCount :: Int
    readerCount=Int
    0, queue :: LockQ
    queue=LockQ
    forall a. Seq a
    Seq.empty }
                 , () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return () )

        w :: LockUser
    w@(Writer { writerID :: LockUser -> ThreadId
    writerID=ThreadId
    it, writerCount :: LockUser -> Int
    writerCount=Int
    wc, queue :: LockUser -> LockQ
    queue=LockQ
    q }) | ThreadId
    itThreadId -> ThreadId -> Bool
    forall a. Eq a => a -> a -> Bool
    ==ThreadId
    me ->
          (LockUser, IO ()) -> IO (LockUser, IO ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( LockUser
    w { writerCount=(succ wc) }
                 , () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return () )

        {-ditto-}                                           | Bool
    otherwise -> do
          mblock <- IO (MVar ())
    forall a. IO (MVar a)
    newEmptyMVar
          q' <- evaluate $ q |> (WriterKind me,mblock)
          return ( w { queue=q' }
                 , safeBlock mblock )

        Readers { readerCounts :: LockUser -> TMap
    readerCounts=TMap
    rcs } | Just Int
    rc <- ThreadId -> TMap -> Maybe Int
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup ThreadId
    me TMap
    rcs -> do
          (LockUser, IO ()) -> IO (LockUser, IO ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( LockUser
    rwd
                 , Int -> IO () -> IO ()
    forall a. Int -> IO a -> IO a
    withoutReads Int
    rc (RWLock -> IO ()
    acquireWrite RWLock
    rwl) )

        r :: LockUser
    r@(Readers { queueR :: LockUser -> Maybe ((ThreadId, MVar ()), LockQ)
    queueR=Maybe ((ThreadId, MVar ()), LockQ)
    Nothing }) -> do
          mblock <- IO (MVar ())
    forall a. IO (MVar a)
    newEmptyMVar
          let qr = ((ThreadId, MVar ()), Seq a) -> Maybe ((ThreadId, MVar ()), Seq a)
    forall a. a -> Maybe a
    Just ((ThreadId
    me,MVar ()
    mblock),Seq a
    forall a. Seq a
    Seq.empty)
          return ( r { queueR=qr }
                 , safeBlock mblock )

        r :: LockUser
    r@(Readers { queueR :: LockUser -> Maybe ((ThreadId, MVar ()), LockQ)
    queueR=Just ((ThreadId, MVar ())
    w,LockQ
    q) }) -> do
          mblock <- IO (MVar ())
    forall a. IO (MVar a)
    newEmptyMVar
          q' <- evaluate $ q |> (WriterKind me,mblock)
          return ( r { queueR=Just (w,q') }
                 , safeBlock mblock )
     where
      withoutReads :: Int -> IO a -> IO a
      withoutReads :: forall a. Int -> IO a -> IO a
    withoutReads Int
    n IO a
    x = ((IO a -> IO a) -> (IO a -> IO a) -> IO a -> IO a)
    -> (IO a -> IO a) -> [IO a -> IO a] -> IO a -> IO a
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (IO a -> IO a) -> (IO a -> IO a) -> IO a -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.) IO a -> IO a
    forall a. a -> a
    id (Int -> (IO a -> IO a) -> [IO a -> IO a]
    forall a. Int -> a -> [a]
    replicate Int
    n IO a -> IO a
    forall a. IO a -> IO a
    withoutRead) (IO a -> IO a) -> IO a -> IO a
    forall a b. (a -> b) -> a -> b
    $ IO a
    x
      withoutRead :: IO a -> IO a
      withoutRead :: forall a. IO a -> IO a
    withoutRead = IO () -> IO () -> IO a -> IO a
    forall a b c. IO a -> IO b -> IO c -> IO c
    bracket_ (RWLock -> IO (Either RWLockException ())
    releaseRead RWLock
    rwl IO (Either RWLockException ())
    -> (Either RWLockException () -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (RWLockException -> IO ())
    -> (() -> IO ()) -> Either RWLockException () -> IO ()
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either RWLockException -> IO ()
    forall a e. (HasCallStack, Exception e) => e -> a
    throw () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return) (RWLock -> IO ()
    acquireReadPriority RWLock
    rwl)

    -- format impossible error strings to include standard description prefix
    imp :: Show x => String -> x -> String
    imp :: forall x. Show x => String -> x -> String
    imp String
    s x
    x = String
    "FairRWLock impossible error: "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    sString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    " : "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++x -> String
    forall a. Show a => a -> String
    show x
    x

    {-

    subtle bug #1:

    When converting from a read lock holding rc > 0 read locks to also holding a write lock, I first wrote:

    replicateM_ rc (releaseRead rwl >>= either throw return)
    acquireWrite rwl
    replicateM_ rc (acquireRead rwl)

    Imagine there are rc copies of withRead wrapped around the above:
    withRead = liftA2 bracket_ acquireRead (releaseRead >=> either throw return)

    Then the acquireWrite blocks and gets interrupted.
    The releaseReads in the withRead will see a strange situation (not locked!) and call throw.

    What is the answer? reverse the bracket for the release/acquire? Hmm..

    -}