<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html>
<head>
<!-- Generated by HsColour, http://code.haskell.org/~malcolm/hscolour/ -->
<title>src/Control/Concurrent/FairRWLock.hs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
<pre><a name="line-1"></a><span class='hs-comment'>{-# LANGUAGE DeriveDataTypeable, PatternGuards #-}</span>
<a name="line-2"></a><span class='hs-comment'>{-| Provides a fair RWLock, similar to one from Java, which is itself documented at
<a name="line-3"></a> <<a href="http://download.oracle.com/javase/7/docs/api/java/util/concurrent/locks/ReentrantReadWriteLock.html">http://download.oracle.com/javase/7/docs/api/java/util/concurrent/locks/ReentrantReadWriteLock.html</a>>
<a name="line-4"></a>
<a name="line-5"></a> There are complicated policy choices that have to be made. The policy choices here are different
<a name="line-6"></a>from the ones for the RWLock in concurrent-extras.
<a name="line-7"></a>
<a name="line-8"></a> The 'FairRWLock' may be in a free unlocked state, it may be in a read locked state, or it may be a
<a name="line-9"></a>write locked state. Many running threads may hold the read lock and execute concurrently. Only one
<a name="line-10"></a>running thread may hold the write lock. The scheduling is a fair FIFO queue that avoids starvation.
<a name="line-11"></a>
<a name="line-12"></a> When in the read lock state the first 'acquireWrite' will block, and subsequent 'acquireRead' and
<a name="line-13"></a>'acquireWrite' will queue in order. When in the write locked state all other threads trying to
<a name="line-14"></a>'acquireWrite' or 'acquireRead' will queue in order.
<a name="line-15"></a>
<a name="line-16"></a> 'FairRWLock' allows recursive write locks, and it allows recursive read locks, and it allows the
<a name="line-17"></a>write lock holding thread to acquire read locks. When the current writer also holds read locks and
<a name="line-18"></a>then releases its last write lock it will immediately convert to the read locked state (and other
<a name="line-19"></a>waiting readers may join it). When a reader acquires a write lock it will (1) release all its read
<a name="line-20"></a>locks, (2) wait to acquire the write lock, (3) retake the same number of read locks released in (1).
<a name="line-21"></a>
<a name="line-22"></a> The preferred way to use this API is sticking to 'new', 'withRead', and 'withWrite'.
<a name="line-23"></a>
<a name="line-24"></a> No sequence of calling acquire on a single RWLock should lead to deadlock. Exceptions, espcially
<a name="line-25"></a>from 'killThread', do not break 'withRead' or 'withWrite'. The 'withRead' and 'withWrite' ensure
<a name="line-26"></a>all locks get released when exiting due to an exception.
<a name="line-27"></a>
<a name="line-28"></a> The readers and writers are always identified by their 'ThreadId'. Each thread that calls
<a name="line-29"></a>'acquireRead' must later call 'releaseRead' from the same thread. Each thread that calls
<a name="line-30"></a>'acquireWrite' must later call 'releaseWrite' from the same thread. The main way to misuse a
<a name="line-31"></a>FairRWLock is to call a release without having called an acquire. This is reported in the (Left
<a name="line-32"></a>error) outcomes from 'releaseRead' and 'releaseWrite'. Only if the 'FairRWLock' has a bug and finds
<a name="line-33"></a>itself in an impossible state then it will throw an error.
<a name="line-34"></a>
<a name="line-35"></a>-}</span>
<a name="line-36"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Concurrent</span><span class='hs-varop'>.</span><span class='hs-conid'>FairRWLock</span>
<a name="line-37"></a> <span class='hs-layout'>(</span> <span class='hs-conid'>RWLock</span><span class='hs-layout'>,</span> <span class='hs-conid'>RWLockException</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>RWLockExceptionKind</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-conid'>FRW</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-conid'>LockKind</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-conid'>TMap</span><span class='hs-layout'>,</span><span class='hs-conid'>TSet</span>
<a name="line-38"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>new</span>
<a name="line-39"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>withRead</span><span class='hs-layout'>,</span> <span class='hs-varid'>withWrite</span>
<a name="line-40"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>acquireRead</span><span class='hs-layout'>,</span> <span class='hs-varid'>acquireWrite</span>
<a name="line-41"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>releaseRead</span><span class='hs-layout'>,</span> <span class='hs-varid'>releaseWrite</span>
<a name="line-42"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>peekLock</span><span class='hs-layout'>,</span> <span class='hs-varid'>checkLock</span>
<a name="line-43"></a> <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-44"></a>
<a name="line-45"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Applicative</span><span class='hs-layout'>(</span><span class='hs-varid'>liftA2</span><span class='hs-layout'>)</span>
<a name="line-46"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Concurrent</span>
<a name="line-47"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Exception</span><span class='hs-layout'>(</span><span class='hs-conid'>Exception</span><span class='hs-layout'>,</span><span class='hs-varid'>bracket_</span><span class='hs-layout'>,</span><span class='hs-varid'>onException</span><span class='hs-layout'>,</span><span class='hs-varid'>evaluate</span><span class='hs-layout'>,</span><span class='hs-varid'>uninterruptibleMask_</span><span class='hs-layout'>,</span><span class='hs-varid'>mask_</span><span class='hs-layout'>,</span><span class='hs-varid'>throw</span><span class='hs-layout'>)</span>
<a name="line-48"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span><span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varop'>>=></span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-varid'>join</span><span class='hs-layout'>,</span><span class='hs-varid'>forM_</span><span class='hs-layout'>)</span>
<a name="line-49"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Sequence</span><span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varop'><|</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-layout'>(</span><span class='hs-varop'>|></span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-layout'>(</span><span class='hs-varop'>><</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-conid'>Seq</span><span class='hs-layout'>,</span><span class='hs-conid'>ViewL</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-conid'>ViewR</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-50"></a><span class='hs-keyword'>import</span> <span class='hs-keyword'>qualified</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Sequence</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>Seq</span><span class='hs-layout'>(</span><span class='hs-varid'>empty</span><span class='hs-layout'>,</span><span class='hs-varid'>viewl</span><span class='hs-layout'>,</span><span class='hs-varid'>viewr</span><span class='hs-layout'>,</span><span class='hs-varid'>breakl</span><span class='hs-layout'>,</span><span class='hs-varid'>spanl</span><span class='hs-layout'>)</span>
<a name="line-51"></a><span class='hs-keyword'>import</span> <span class='hs-keyword'>qualified</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Foldable</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>F</span><span class='hs-layout'>(</span><span class='hs-varid'>toList</span><span class='hs-layout'>)</span>
<a name="line-52"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Map</span><span class='hs-layout'>(</span><span class='hs-conid'>Map</span><span class='hs-layout'>)</span>
<a name="line-53"></a><span class='hs-keyword'>import</span> <span class='hs-keyword'>qualified</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Map</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>Map</span>
<a name="line-54"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Set</span><span class='hs-layout'>(</span><span class='hs-conid'>Set</span><span class='hs-layout'>)</span>
<a name="line-55"></a><span class='hs-keyword'>import</span> <span class='hs-keyword'>qualified</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Set</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>Set</span>
<a name="line-56"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Typeable</span><span class='hs-layout'>(</span><span class='hs-conid'>Typeable</span><span class='hs-layout'>)</span>
<a name="line-57"></a>
<a name="line-58"></a><a name="TMap"></a><span class='hs-comment'>-- Try to make most impossible data states unrepresentable</span>
<a name="line-59"></a><a name="TMap"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>TMap</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Map</span> <span class='hs-conid'>ThreadId</span> <span class='hs-conid'>Int</span> <span class='hs-comment'>-- nonempty, all values > 0</span>
<a name="line-60"></a><a name="TSet"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>TSet</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Set</span> <span class='hs-conid'>ThreadId</span> <span class='hs-comment'>-- nonempty</span>
<a name="line-61"></a>
<a name="line-62"></a><a name="LockKind"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>LockKind</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ReaderKind</span> <span class='hs-layout'>{</span> <span class='hs-varid'>unRK</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TSet</span> <span class='hs-layout'>}</span>
<a name="line-63"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>WriterKind</span> <span class='hs-layout'>{</span> <span class='hs-varid'>unWK</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ThreadId</span> <span class='hs-layout'>}</span>
<a name="line-64"></a> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Eq</span><span class='hs-layout'>,</span><span class='hs-conid'>Ord</span><span class='hs-layout'>,</span><span class='hs-conid'>Show</span><span class='hs-layout'>)</span>
<a name="line-65"></a>
<a name="line-66"></a><a name="LockQ"></a><span class='hs-comment'>-- LockQ may be empty</span>
<a name="line-67"></a><a name="LockQ"></a><span class='hs-comment'>-- No duplicate ThreadIds in LockKinds</span>
<a name="line-68"></a><a name="LockQ"></a><span class='hs-comment'>-- MVar () will be created empty, released once with putMVar</span>
<a name="line-69"></a><a name="LockQ"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>LockQ</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Seq</span> <span class='hs-layout'>(</span><span class='hs-conid'>LockKind</span><span class='hs-layout'>,</span><span class='hs-conid'>MVar</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span>
<a name="line-70"></a>
<a name="line-71"></a><a name="LockUser"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>LockUser</span> <span class='hs-keyglyph'>=</span>
<a name="line-72"></a> <span class='hs-conid'>FreeLock</span>
<a name="line-73"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Readers</span> <span class='hs-layout'>{</span> <span class='hs-varid'>readerCounts</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TMap</span> <span class='hs-comment'>-- re-entrant count of reader locks held be each thread</span>
<a name="line-74"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>queueR</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Maybe</span> <span class='hs-layout'>(</span> <span class='hs-layout'>(</span><span class='hs-conid'>ThreadId</span><span class='hs-layout'>,</span><span class='hs-conid'>MVar</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- empty or queue with leading Writer</span>
<a name="line-75"></a> <span class='hs-layout'>,</span> <span class='hs-conid'>LockQ</span> <span class='hs-layout'>)</span>
<a name="line-76"></a> <span class='hs-layout'>}</span>
<a name="line-77"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Writer</span> <span class='hs-layout'>{</span> <span class='hs-varid'>writerID</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ThreadId</span>
<a name="line-78"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>writerCount</span> <span class='hs-comment'>-- re-entrant writer locks held by writerID, at least 1</span>
<a name="line-79"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>readerCount</span> <span class='hs-keyglyph'>::</span> <span class='hs-varop'>!</span><span class='hs-conid'>Int</span> <span class='hs-comment'>-- re-entrant reader locks held by writerID, at least 0</span>
<a name="line-80"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>queue</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>LockQ</span> <span class='hs-layout'>}</span>
<a name="line-81"></a> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Eq</span><span class='hs-layout'>,</span><span class='hs-conid'>Typeable</span><span class='hs-layout'>)</span>
<a name="line-82"></a>
<a name="line-83"></a>
<a name="line-84"></a><a name="RWLock"></a><span class='hs-comment'>-- | Opaque type of the fair RWLock.</span>
<a name="line-85"></a><a name="RWLock"></a><span class='hs-keyword'>newtype</span> <span class='hs-conid'>RWLock</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>RWL</span> <span class='hs-layout'>(</span><span class='hs-conid'>MVar</span> <span class='hs-conid'>LockUser</span><span class='hs-layout'>)</span>
<a name="line-86"></a>
<a name="line-87"></a><a name="RWLockException"></a><span class='hs-comment'>-- | Exception type thrown or returned by this module. \"Impossible\" conditions get the error thrown</span>
<a name="line-88"></a><a name="RWLockException"></a><span class='hs-comment'>-- and usage problems get the error returned.</span>
<a name="line-89"></a><a name="RWLockException"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>RWLockException</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>RWLockException</span> <span class='hs-conid'>ThreadId</span> <span class='hs-conid'>RWLockExceptionKind</span> <span class='hs-conid'>String</span>
<a name="line-90"></a> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Show</span><span class='hs-layout'>,</span><span class='hs-conid'>Typeable</span><span class='hs-layout'>)</span>
<a name="line-91"></a>
<a name="line-92"></a><a name="RWLockExceptionKind"></a><span class='hs-comment'>-- | Operation in which error arose, </span>
<a name="line-93"></a><a name="RWLockExceptionKind"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>RWLockExceptionKind</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>RWLock'acquireWrite</span> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>RWLock'releaseWrite</span>
<a name="line-94"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>RWLock'acquireRead</span> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>RWLock'releaseRead</span>
<a name="line-95"></a> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Show</span><span class='hs-layout'>,</span><span class='hs-conid'>Typeable</span><span class='hs-layout'>)</span>
<a name="line-96"></a>
<a name="line-97"></a><a name="instance%20String%20-%3e%20x%20-%3e%20IO%20a%20impossible%20s%20x%20=%20throw%20(RWLockException%20me%20(if%20abandon%20then%20RWLock'acquireRead%20else%20RWLock'releaseRead)%20(imp%20s%20x))%20err%20::%20Show%20x%20=%3e%20String%20-%3e%20x%20-%3e%20IO%20(LockUser,Either%20RWLockException%20())%20err%20s%20x%20=%20return%20.%20((,)%20rwd)%20.%20Left%20$%20(RWLockException%20me%20(if%20abandon%20then%20RWLock'acquireRead%20else%20RWLock'releaseRead)%20(s++%22%20:%20%22++show%20x))%20ret%20::%20LockUser%20-%3e%20IO%20(LockUser,Either%20RWLockException%20())%20ret%20x%20=%20return%20(x,Right%20())%20--%20if%20there%20is%20a%20bug%20then%20dropReader%20may%20find%20an%20impossible%20situation%20when%20abandoning%20a%20thread,%20and%20throw%20an%20error%20dropReader%20::%20LockQ%20-%3e%20IO%20LockQ%20dropReader%20q%20=%20do%20let%20inR%20(ReaderKind%20rcs,_)%20=%20Set.member%20me%20rcs%20inR%20_%20=%20False%20(pre,myselfPost)%20=%20Seq.breakl%20inR%20q%20case%20Seq.viewl%20myselfPost%20of%20EmptyL%20-%3e%20impossible%20%22failure%20to%20abandon%20acquireRead,%20RWLock%20locked%20by%20other%20thread(s)%20and%20this%20thread%20is%20not%20in%20queue%22%20me%20(myself,mblock)%20:%3c%20post%20-%3e%20do%20let%20rcs'%20=%20Set.delete%20me%20(unRK%20myself)%20--%20safe%20unRK%20call%20evaluate%20$%20if%20Set.null%20rcs'%20then%20pre%20%3e%3c%20post%20else%20pre%20%3e%3c%20((ReaderKind%20rcs',mblock)%20%3c%7c%20post)%20case%20rwd%20of%20FreeLock%20%7c%20abandon%20-%3e%20%7b-%201%20-%7d%20impossible%20%22acquireRead%20interrupted%20with%20unlocked%20RWLock%22%20me%20%7c%20otherwise%20-%3e%20%7b-%202%20-%7d%20err%20%22cannot%20releaseRead%20lock%20from%20unlocked%20RWLock%22%20me%20w@(Writer%20%7b%20writerID=it,%20readerCount=rc,%20queue=q%20%7d)%20%7c%20it==me%20-%3e%20do%20case%20rc%20of%200%20%7c%20abandon%20-%3e%20%7b-%203%20-%7d%20impossible%20%22acquireRead%20interrupted%20with%20write%20lock%20but%20not%20read%20lock%22%20(me,it)%20%7c%20otherwise%20-%3e%20%7b-%204%20-%7d%20err%20%22releaseRead%20when%20holding%20write%20lock%20but%20not%20read%20lock%22%20(me,it)%20_%20-%3e%20do%20%7b-%205%20-%7d%20rc'%20%3c-%20evaluate%20$%20pred%20rc%20ret%20(w%20%7b%20readerCount=rc'%20%7d)%20%7b-ditto-%7d%20%7c%20abandon%20-%3e%20do%20%7b-%206%20-%7d%20q'%20%3c-%20dropReader%20q%20ret%20(w%20%7b%20queue=q'%20%7d)%20%7b-ditto-%7d%20%7c%20otherwise%20-%3e%20%7b-%207%20-%7d%20err%20%22releaseRead%20called%20when%20not%20read%20locked%20%22%20me%20r@(Readers%20%7b%20readerCounts=rcs,queueR=qR%20%7d)%20-%3e%20case%20Map.lookup%20me%20rcs%20of%20Just%201%20-%3e%20do%20let%20rcs'%20=%20Map.delete%20me%20rcs%20if%20Map.null%20rcs'%20then%20case%20qR%20of%20Nothing%20-%3e%20%7b-%208%20-%7d%20ret%20FreeLock%20Just%20((wid,mblock),q)%20-%3e%20do%20%7b-%209%20-%7d%20putMVar%20mblock%20()%20ret%20(Writer%20%7b%20writerID=wid,%20writerCount=1,%20readerCount=0,%20queue=q%20%7d)%20else%20ret%20(r%20%7b%20readerCounts=rcs'%20%7d)%20%7b-%2010%20-%7d%20Just%20rc%20-%3e%20do%20%7b-%2011%20-%7d%20rc'%20%3c-%20evaluate%20$%20pred%20rc%20rcs'%20%3c-%20evaluate%20$%20Map.insert%20me%20rc'%20rcs%20ret%20(r%20%7b%20readerCounts=rcs'%20%7d)%20Nothing%20%7c%20abandon%20-%3e%20case%20qR%20of%20Nothing%20-%3e%20%7b-%2012%20-%7d%20impossible%20%22acquireRead%20interrupted%20not%20holding%20lock%20and%20with%20no%20queue%22%20(me,rcs)%20Just%20(w,q)%20-%3e%20%7b-%2013%20-%7d%20do%20q'%20%3c-%20dropReader%20q%20ret%20(r%20%7b%20queueR%20=%20Just%20(w,q')%20%7d)%20%7b-ditto-%7d%20%7c%20otherwise%20-%3e%20%7b-%2014%20-%7d%20err%20%22releaseRead%20called%20with%20read%20lock%20held%20by%20others%22%20(me,rcs)%20--%20%7c%20A%20thread%20that%20calls%20acquireWrite%20must%20later%20call%20releaseWrite%20once%20for%20each%20call%20to%20acquireWrite.%20--%20--%20If%20this%20thread%20has%20not%20previous%20called%20acquireWrite%20then%20releaseWrite%20will%20do%20nothing%20and%20return%20--%20a%20(Left%20error).%20--%20--%20This%20can%20block%20but%20cannot%20be%20interrupted.%20releaseWrite%20::%20RWLock%20-%3e%20IO%20(Either%20RWLockException%20())%20releaseWrite%20(RWL%20rwlVar)%20=%20mask_%20$%20do%20me%20%3c-%20myThreadId%20releaseWrite'%20False%20me%20rwlVar%20--%20False%20to%20indicate%20call%20is%20from%20releaseWrite%20--%20Nine%20non-impossible%20cases,%20plus%20one%20impossible%20case%20--%20Lock%20is%20Free%20--%20I%20have%20write%20lock,%20I%20only%20had%201%20write%20lock%20and%20no%20read%20locks,%20promote%20from%20LockQ%20--%20,%20I%20only%20had%201%20write%20lock%20and%20some%20read%20locks,%20convert%20me%20to%20reader%20and%20promote%20leading%20readers%20--%20,%20I%20have%20many%20write%20locks,%20just%20decrement%20the%20counter%20--%20Someone%20else%20has%20write%20lock,%20abandoning%20my%20acquireWrite%20--%20,%20releaseWrite%20called%20in%20error%20--%20Read%20lock%20held,%20releaseWrite%20called%20in%20error%20--%20,%20with%20no%20queue,%20abandoning%20acquireWrite%20is%20IMPOSSIBLE%20--%20,%20abandoning%20my%20leading%20acquireWrite%20--%20,%20abandoning%20my%20non-leading%20acquireWrite%20releaseWrite'%20::%20Bool%20-%3e%20ThreadId%20-%3e%20MVar%20LockUser%20-%3e%20IO%20(Either%20RWLockException%20())%20releaseWrite'%20abandon%20me%20rwlVar%20=%20uninterruptibleMask_%20.%20modifyMVar%20rwlVar%20$%20%5c%20rwd%20-%3e%20do%20let%20impossible%20::%20Show%20x%20=%3e%20String%20-%3e%20x%20-%3e%20IO%20a%20impossible%20s%20x%20=%20throw%20(RWLockException%20me%20(if%20abandon%20then%20RWLock'acquireWrite%20else%20RWLock'releaseWrite)%20(imp%20s%20x))%20err%20::%20Show%20x%20=%3e%20String%20-%3e%20x%20-%3e%20IO%20(LockUser,Either%20RWLockException%20())%20err%20s%20x%20=%20return%20.%20((,)%20rwd)%20.%20Left%20$%20(RWLockException%20me%20(if%20abandon%20then%20RWLock'acquireWrite%20else%20RWLock'releaseWrite)%20(s++%22%20:%20%22++show%20x))%20ret%20::%20LockUser%20-%3e%20IO%20(LockUser,Either%20RWLockException%20())%20ret%20x%20=%20return%20(x,Right%20())%20dropWriter%20::%20LockQ%20-%3e%20IO%20LockQ%20dropWriter%20q%20=%20do%20let%20inW%20(WriterKind%20it,_)%20=%20me==it%20inW%20_%20=%20False%20(pre,myselfPost)%20=%20Seq.breakl%20inW%20q%20case%20Seq.viewl%20myselfPost%20of%20EmptyL%20-%3e%20impossible%20%22failure%20to%20abandon%20acquireWrite,%20RWLock%20locked%20by%20other%20and%20not%20in%20queue%22%20me%20_%20:%3c%20post%20-%3e%20evaluate%20$%20pre%3e%3cpost%20case%20rwd%20of%20FreeLock%20%7c%20abandon%20-%3e%20impossible%20%22acquireWrite%20interrupted%20with%20unlocked%20RWLock%22%20me%20%7c%20otherwise%20-%3e%20err%20%22cannot%20releaseWrite%20lock%20from%20unlocked%20RWLock%22%20me%20w@(Writer%20%7b%20writerID=it,%20writerCount=wc,%20readerCount=rc,%20queue=q%20%7d)%20%7c%20it==me%20-%3e%20do%20case%20(wc,rc)%20of%20(1,0)%20-%3e%20ret%20=%3c%3c%20promote%20q%20--%20if%20abandon%20then%20this%20is%20the%20only%20valid%20case%20_%20%7c%20abandon%20-%3e%20impossible%20%22acquireWrite%20interrupted%20with%20write%20lock%20and%20bad%20RWLock%20state%22%20(me,it,wc,rc)%20(1,_)%20-%3e%20ret%20=%3c%3c%20promoteReader%20rc%20q%20(_,_)%20-%3e%20ret%20(w%20%7b%20writerCount=(pred%20wc)%20%7d)%20%7b-ditto-%7d%20%7c%20abandon%20-%3e%20do%20q'%20%3c-%20dropWriter%20q%20ret%20(w%20%7b%20queue=q'%20%7d)%20%7b-ditto-%7d%20%7c%20otherwise%20-%3e%20do%20err%20%22cannot%20releaseWrite%20when%20not%20not%20holding%20the%20write%20lock%22%20(me,it)%20Readers%20%7b%20readerCounts=rcs%7d%20%7c%20not%20abandon%20-%3e%20err%20%22cannot%20releaseWrite%20when%20RWLock%20is%20read%20locked%22%20(me,rcs)%20Readers%20%7b%20readerCounts=rcs,%20queueR=Nothing%20%7d%20-%3e%20impossible%20%22failure%20to%20abandon%20acquireWrite,%20RWLock%20read%20locked%20and%20no%20queue%22%20(me,rcs)%20r@(Readers%20%7b%20readerCounts=rcs,%20queueR=Just%20(w@(it,_),q)%20%7d)%20%7c%20it==me%20-%3e%20do%20(rcs'new,qr)%20%3c-%20splitReaders%20q%20ret%20(r%20%7b%20readerCounts=Map.union%20rcs%20rcs'new,%20queueR=qr%20%7d)%20%7b-%20ditto%20-%7d%20%7c%20otherwise%20-%3e%20do%20q'%20%3c-%20dropWriter%20q%20ret%20(r%20%7b%20queueR=Just%20(w,q')%20%7d)"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Exception</span> <span class='hs-conid'>RWLockException</span>
<a name="line-98"></a>
<a name="line-99"></a><a name="FRW"></a><span class='hs-comment'>-- | Observable state of holder(s) of lock(s). The W returns a pair of Ints where the first is number of</span>
<a name="line-100"></a><a name="FRW"></a><span class='hs-comment'>-- read locks (at least 0) and the second is the number of write locks held (at least 1). The R</span>
<a name="line-101"></a><a name="FRW"></a><span class='hs-comment'>-- returns a map from thread id to the number of read locks held (at least 1).</span>
<a name="line-102"></a><a name="FRW"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>FRW</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>F</span> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>R</span> <span class='hs-conid'>TMap</span> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>W</span> <span class='hs-layout'>(</span><span class='hs-conid'>ThreadId</span><span class='hs-layout'>,</span><span class='hs-layout'>(</span><span class='hs-conid'>Int</span><span class='hs-layout'>,</span><span class='hs-conid'>Int</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Show</span><span class='hs-layout'>)</span>
<a name="line-103"></a>
<a name="line-104"></a><a name="new"></a><span class='hs-comment'>-- | Create a new RWLock which starts in a free and unlocked state.</span>
<a name="line-105"></a><span class='hs-definition'>new</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>IO</span> <span class='hs-conid'>RWLock</span>
<a name="line-106"></a><span class='hs-definition'>new</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fmap</span> <span class='hs-conid'>RWL</span> <span class='hs-layout'>(</span><span class='hs-varid'>newMVar</span> <span class='hs-conid'>FreeLock</span><span class='hs-layout'>)</span>
<a name="line-107"></a>
<a name="line-108"></a><a name="withRead"></a><span class='hs-comment'>-- | This is by far the preferred way to acquire a read lock. This uses bracket_ to ensure</span>
<a name="line-109"></a><span class='hs-comment'>-- acquireRead and releaseRead are called correctly around the passed command.</span>
<a name="line-110"></a><span class='hs-comment'>--</span>
<a name="line-111"></a><span class='hs-comment'>-- This ought to ensure releaseRead will not return a (Left error), but if it does then this error</span>
<a name="line-112"></a><span class='hs-comment'>-- will be thrown.</span>
<a name="line-113"></a><span class='hs-comment'>--</span>
<a name="line-114"></a><span class='hs-comment'>-- This can block and be safely interrupted.</span>
<a name="line-115"></a><span class='hs-definition'>withRead</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RWLock</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-varid'>a</span>
<a name="line-116"></a><span class='hs-definition'>withRead</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>liftA2</span> <span class='hs-varid'>bracket_</span> <span class='hs-varid'>acquireRead</span> <span class='hs-layout'>(</span><span class='hs-varid'>releaseRead</span> <span class='hs-varop'>>=></span> <span class='hs-varid'>either</span> <span class='hs-varid'>throw</span> <span class='hs-varid'>return</span><span class='hs-layout'>)</span>
<a name="line-117"></a>
<a name="line-118"></a><a name="withWrite"></a><span class='hs-comment'>-- | This is by far the preferred way to acquire a write lock. This uses bracket_ to ensure</span>
<a name="line-119"></a><span class='hs-comment'>-- acquireWrite and releaseWrite are called correctly around the passed command.</span>
<a name="line-120"></a><span class='hs-comment'>--</span>
<a name="line-121"></a><span class='hs-comment'>-- This ought to ensure releaseWrite will not return a (Left error), but if it does then this error</span>
<a name="line-122"></a><span class='hs-comment'>-- will be thrown.</span>
<a name="line-123"></a><span class='hs-comment'>--</span>
<a name="line-124"></a><span class='hs-comment'>-- This can block and be safely interrupted.</span>
<a name="line-125"></a><span class='hs-definition'>withWrite</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RWLock</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-varid'>a</span>
<a name="line-126"></a><span class='hs-definition'>withWrite</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>liftA2</span> <span class='hs-varid'>bracket_</span> <span class='hs-varid'>acquireWrite</span> <span class='hs-layout'>(</span><span class='hs-varid'>releaseWrite</span> <span class='hs-varop'>>=></span> <span class='hs-varid'>either</span> <span class='hs-varid'>throw</span> <span class='hs-varid'>return</span><span class='hs-layout'>)</span>
<a name="line-127"></a>
<a name="line-128"></a><a name="peekLock"></a><span class='hs-comment'>-- | Observe which threads are holding the lock and which threads are waiting (in order). This is</span>
<a name="line-129"></a><span class='hs-comment'>-- particularly useful for writing tests.</span>
<a name="line-130"></a><span class='hs-definition'>peekLock</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RWLock</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-layout'>(</span><span class='hs-conid'>FRW</span><span class='hs-layout'>,</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>LockKind</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-131"></a><span class='hs-definition'>peekLock</span> <span class='hs-layout'>(</span><span class='hs-conid'>RWL</span> <span class='hs-varid'>rwlVar</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>withMVar</span> <span class='hs-varid'>rwlVar</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>rwd</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span>
<a name="line-132"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>rwd</span> <span class='hs-keyword'>of</span>
<a name="line-133"></a> <span class='hs-conid'>FreeLock</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>F</span><span class='hs-layout'>,</span><span class='hs-conid'>[]</span><span class='hs-layout'>)</span>
<a name="line-134"></a> <span class='hs-conid'>Readers</span> <span class='hs-layout'>{</span> <span class='hs-varid'>readerCounts</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>rcs</span><span class='hs-layout'>,</span> <span class='hs-varid'>queueR</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>qr</span> <span class='hs-layout'>}</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>R</span> <span class='hs-varid'>rcs</span><span class='hs-layout'>,</span><span class='hs-varid'>maybe</span> <span class='hs-conid'>[]</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>t</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-varid'>q</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>WriterKind</span> <span class='hs-varid'>t</span> <span class='hs-conop'>:</span> <span class='hs-varid'>map</span> <span class='hs-varid'>fst</span> <span class='hs-layout'>(</span><span class='hs-conid'>F</span><span class='hs-varop'>.</span><span class='hs-varid'>toList</span> <span class='hs-varid'>q</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>qr</span><span class='hs-layout'>)</span>
<a name="line-135"></a> <span class='hs-conid'>Writer</span> <span class='hs-layout'>{</span> <span class='hs-varid'>writerID</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>it</span><span class='hs-layout'>,</span> <span class='hs-varid'>writerCount</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>wc</span><span class='hs-layout'>,</span> <span class='hs-varid'>readerCount</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>rc</span><span class='hs-layout'>,</span> <span class='hs-varid'>queue</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>q</span> <span class='hs-layout'>}</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>W</span> <span class='hs-layout'>(</span><span class='hs-varid'>it</span><span class='hs-layout'>,</span><span class='hs-layout'>(</span><span class='hs-varid'>rc</span><span class='hs-layout'>,</span><span class='hs-varid'>wc</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>map</span> <span class='hs-varid'>fst</span> <span class='hs-layout'>(</span><span class='hs-conid'>F</span><span class='hs-varop'>.</span><span class='hs-varid'>toList</span> <span class='hs-varid'>q</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-136"></a>
<a name="line-137"></a><a name="checkLock"></a><span class='hs-comment'>-- | checkLocks return a pair of numbers, the first is the count of read locks this thread holds,</span>
<a name="line-138"></a><span class='hs-comment'>-- the second is the number of write locks that this thread holds. This may be useful for sanity</span>
<a name="line-139"></a><span class='hs-comment'>-- checking complex usage of RWLocks.</span>
<a name="line-140"></a><span class='hs-comment'>--</span>
<a name="line-141"></a><span class='hs-comment'>-- This may block and be safely interrupted.</span>
<a name="line-142"></a><span class='hs-definition'>checkLock</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RWLock</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-layout'>(</span><span class='hs-conid'>Int</span><span class='hs-layout'>,</span><span class='hs-conid'>Int</span><span class='hs-layout'>)</span>
<a name="line-143"></a><span class='hs-definition'>checkLock</span> <span class='hs-layout'>(</span><span class='hs-conid'>RWL</span> <span class='hs-varid'>rwlVar</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-144"></a> <span class='hs-varid'>me</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>myThreadId</span>
<a name="line-145"></a> <span class='hs-varid'>withMVar</span> <span class='hs-varid'>rwlVar</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>rwd</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span>
<a name="line-146"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>rwd</span> <span class='hs-keyword'>of</span>
<a name="line-147"></a> <span class='hs-conid'>FreeLock</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-num'>0</span><span class='hs-layout'>,</span><span class='hs-num'>0</span><span class='hs-layout'>)</span>
<a name="line-148"></a> <span class='hs-conid'>Readers</span> <span class='hs-layout'>{</span> <span class='hs-varid'>readerCounts</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>rcs</span> <span class='hs-layout'>}</span> <span class='hs-keyglyph'>-></span>
<a name="line-149"></a> <span class='hs-keyword'>case</span> <span class='hs-conid'>Map</span><span class='hs-varop'>.</span><span class='hs-varid'>lookup</span> <span class='hs-varid'>me</span> <span class='hs-varid'>rcs</span> <span class='hs-keyword'>of</span>
<a name="line-150"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-num'>0</span><span class='hs-layout'>,</span><span class='hs-num'>0</span><span class='hs-layout'>)</span>
<a name="line-151"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>rc</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>rc</span><span class='hs-layout'>,</span><span class='hs-num'>0</span><span class='hs-layout'>)</span>
<a name="line-152"></a> <span class='hs-conid'>Writer</span> <span class='hs-layout'>{</span> <span class='hs-varid'>writerID</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>it</span><span class='hs-layout'>,</span> <span class='hs-varid'>writerCount</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>wc</span><span class='hs-layout'>,</span> <span class='hs-varid'>readerCount</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>rc</span> <span class='hs-layout'>}</span> <span class='hs-keyglyph'>-></span>
<a name="line-153"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>it</span><span class='hs-varop'>==</span><span class='hs-varid'>me</span> <span class='hs-keyword'>then</span> <span class='hs-layout'>(</span><span class='hs-varid'>rc</span><span class='hs-layout'>,</span><span class='hs-varid'>wc</span><span class='hs-layout'>)</span> <span class='hs-keyword'>else</span> <span class='hs-layout'>(</span><span class='hs-num'>0</span><span class='hs-layout'>,</span><span class='hs-num'>0</span><span class='hs-layout'>)</span>
<a name="line-154"></a>
<a name="line-155"></a><a name="releaseRead"></a><span class='hs-comment'>-- | A thread that calls acquireRead must later call releaseRead once for each call to acquireRead.</span>
<a name="line-156"></a><span class='hs-comment'>--</span>
<a name="line-157"></a><span class='hs-comment'>-- If this thread has not previous called acquireRead then releaseRead will do nothing and return a</span>
<a name="line-158"></a><span class='hs-comment'>-- (Left error).</span>
<a name="line-159"></a><span class='hs-comment'>--</span>
<a name="line-160"></a><span class='hs-comment'>-- This can block but cannot be interrupted.</span>
<a name="line-161"></a><span class='hs-definition'>releaseRead</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RWLock</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-layout'>(</span><span class='hs-conid'>Either</span> <span class='hs-conid'>RWLockException</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span>
<a name="line-162"></a><span class='hs-definition'>releaseRead</span> <span class='hs-layout'>(</span><span class='hs-conid'>RWL</span> <span class='hs-varid'>rwlVar</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mask_</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-163"></a> <span class='hs-varid'>me</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>myThreadId</span>
<a name="line-164"></a> <span class='hs-varid'>releaseRead'</span> <span class='hs-conid'>False</span> <span class='hs-varid'>me</span> <span class='hs-varid'>rwlVar</span> <span class='hs-comment'>-- False to indicate call is from releaseRead</span>
<a name="line-165"></a>
<a name="line-166"></a><a name="releaseRead'"></a><span class='hs-comment'>-- The (abandon :: Bool) is False if called from releaseRead (from user API).</span>
<a name="line-167"></a><span class='hs-comment'>-- The (abandon :: Bool) is True if called as handler when acquireRead[Priority] interrupted by exception (internal use).</span>
<a name="line-168"></a><span class='hs-comment'>-- </span>
<a name="line-169"></a><span class='hs-comment'>-- There are 14 cases.</span>
<a name="line-170"></a><span class='hs-comment'>-- Four ERROR cases from misuse of releaseRead, Three IMPOSSIBLE cases (from interruptions), Seven normal cases:</span>
<a name="line-171"></a><span class='hs-comment'>-- Lock is Free, ERROR if releaseRead or IMPOSSIBLE if interrupted -- 1 and 2</span>
<a name="line-172"></a><span class='hs-comment'>-- I have write lock, I have no read lock, ERROR if releaseRead or IMPOSSIBLE if interrupted -- 3 and 4</span>
<a name="line-173"></a><span class='hs-comment'>-- , I have at least one read lock, just decrement the counter -- 5</span>
<a name="line-174"></a><span class='hs-comment'>-- Someone else has write lock, abandoning my acquireWrite -- 6</span>
<a name="line-175"></a><span class='hs-comment'>-- , releaseRead called in ERROR -- 7</span>
<a name="line-176"></a><span class='hs-comment'>-- Read lock held, I have 1 read lock, no other readers, change to FreeLock -- 8</span>
<a name="line-177"></a><span class='hs-comment'>-- , change to next Writer -- 9</span>
<a name="line-178"></a><span class='hs-comment'>-- , remove and leave to other readers -- 10</span>
<a name="line-179"></a><span class='hs-comment'>-- , I have more than one read lock, just decrement the counter -- 11</span>
<a name="line-180"></a><span class='hs-comment'>-- , I have no read lock, abandoning with no queue is IMPOSSIBLE -- 12</span>
<a name="line-181"></a><span class='hs-comment'>-- , abandoning from queue past next writer -- 13</span>
<a name="line-182"></a><span class='hs-comment'>-- , releaseRead called in ERROR -- 14</span>
<a name="line-183"></a><span class='hs-definition'>releaseRead'</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Bool</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>ThreadId</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MVar</span> <span class='hs-conid'>LockUser</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-layout'>(</span><span class='hs-conid'>Either</span> <span class='hs-conid'>RWLockException</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span>
<a name="line-184"></a><span class='hs-definition'>releaseRead'</span> <span class='hs-varid'>abandon</span> <span class='hs-varid'>me</span> <span class='hs-varid'>rwlVar</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>uninterruptibleMask_</span> <span class='hs-varop'>.</span> <span class='hs-varid'>modifyMVar</span> <span class='hs-varid'>rwlVar</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>rwd</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-185"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>impossible</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Show</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-varid'>a</span>
<a name="line-186"></a> <span class='hs-varid'>impossible</span> <span class='hs-varid'>s</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>throw</span>
<a name="line-187"></a> <span class='hs-layout'>(</span><span class='hs-conid'>RWLockException</span> <span class='hs-varid'>me</span> <span class='hs-layout'>(</span><span class='hs-keyword'>if</span> <span class='hs-varid'>abandon</span> <span class='hs-keyword'>then</span> <span class='hs-conid'>RWLock'acquireRead</span> <span class='hs-keyword'>else</span> <span class='hs-conid'>RWLock'releaseRead</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>imp</span> <span class='hs-varid'>s</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-188"></a> <span class='hs-varid'>err</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Show</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-layout'>(</span><span class='hs-conid'>LockUser</span><span class='hs-layout'>,</span><span class='hs-conid'>Either</span> <span class='hs-conid'>RWLockException</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span>
<a name="line-189"></a> <span class='hs-varid'>err</span> <span class='hs-varid'>s</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-varop'>.</span> <span class='hs-layout'>(</span><span class='hs-conid'>(,)</span> <span class='hs-varid'>rwd</span><span class='hs-layout'>)</span> <span class='hs-varop'>.</span> <span class='hs-conid'>Left</span> <span class='hs-varop'>$</span>
<a name="line-190"></a> <span class='hs-layout'>(</span><span class='hs-conid'>RWLockException</span> <span class='hs-varid'>me</span> <span class='hs-layout'>(</span><span class='hs-keyword'>if</span> <span class='hs-varid'>abandon</span> <span class='hs-keyword'>then</span> <span class='hs-conid'>RWLock'acquireRead</span> <span class='hs-keyword'>else</span> <span class='hs-conid'>RWLock'releaseRead</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>s</span><span class='hs-varop'>++</span><span class='hs-str'>" : "</span><span class='hs-varop'>++</span><span class='hs-varid'>show</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-191"></a> <span class='hs-varid'>ret</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>LockUser</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-layout'>(</span><span class='hs-conid'>LockUser</span><span class='hs-layout'>,</span><span class='hs-conid'>Either</span> <span class='hs-conid'>RWLockException</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span>
<a name="line-192"></a> <span class='hs-varid'>ret</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span><span class='hs-conid'>Right</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span>
<a name="line-193"></a>
<a name="line-194"></a> <span class='hs-comment'>-- if there is a bug then dropReader may find an impossible situation when abandoning a thread, and throw an error</span>
<a name="line-195"></a> <span class='hs-varid'>dropReader</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>LockQ</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>LockQ</span>
<a name="line-196"></a> <span class='hs-varid'>dropReader</span> <span class='hs-varid'>q</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-197"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>inR</span> <span class='hs-layout'>(</span><span class='hs-conid'>ReaderKind</span> <span class='hs-varid'>rcs</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Set</span><span class='hs-varop'>.</span><span class='hs-varid'>member</span> <span class='hs-varid'>me</span> <span class='hs-varid'>rcs</span>
<a name="line-198"></a> <span class='hs-varid'>inR</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-199"></a> <span class='hs-layout'>(</span><span class='hs-varid'>pre</span><span class='hs-layout'>,</span><span class='hs-varid'>myselfPost</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Seq</span><span class='hs-varop'>.</span><span class='hs-varid'>breakl</span> <span class='hs-varid'>inR</span> <span class='hs-varid'>q</span>
<a name="line-200"></a> <span class='hs-keyword'>case</span> <span class='hs-conid'>Seq</span><span class='hs-varop'>.</span><span class='hs-varid'>viewl</span> <span class='hs-varid'>myselfPost</span> <span class='hs-keyword'>of</span>
<a name="line-201"></a> <span class='hs-conid'>EmptyL</span> <span class='hs-keyglyph'>-></span>
<a name="line-202"></a> <span class='hs-varid'>impossible</span> <span class='hs-str'>"failure to abandon acquireRead, RWLock locked by other thread(s) and this thread is not in queue"</span> <span class='hs-varid'>me</span>
<a name="line-203"></a> <span class='hs-layout'>(</span><span class='hs-varid'>myself</span><span class='hs-layout'>,</span><span class='hs-varid'>mblock</span><span class='hs-layout'>)</span> <span class='hs-conop'>:<</span> <span class='hs-varid'>post</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-204"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>rcs'</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Set</span><span class='hs-varop'>.</span><span class='hs-varid'>delete</span> <span class='hs-varid'>me</span> <span class='hs-layout'>(</span><span class='hs-varid'>unRK</span> <span class='hs-varid'>myself</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- safe unRK call</span>
<a name="line-205"></a> <span class='hs-varid'>evaluate</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>if</span> <span class='hs-conid'>Set</span><span class='hs-varop'>.</span><span class='hs-varid'>null</span> <span class='hs-varid'>rcs'</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>pre</span> <span class='hs-varop'>><</span> <span class='hs-varid'>post</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>pre</span> <span class='hs-varop'>><</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-conid'>ReaderKind</span> <span class='hs-varid'>rcs'</span><span class='hs-layout'>,</span><span class='hs-varid'>mblock</span><span class='hs-layout'>)</span> <span class='hs-varop'><|</span> <span class='hs-varid'>post</span><span class='hs-layout'>)</span>
<a name="line-206"></a>
<a name="line-207"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>rwd</span> <span class='hs-keyword'>of</span>
<a name="line-208"></a> <span class='hs-conid'>FreeLock</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>abandon</span> <span class='hs-keyglyph'>-></span> <span class='hs-comment'>{- 1 -}</span>
<a name="line-209"></a> <span class='hs-varid'>impossible</span> <span class='hs-str'>"acquireRead interrupted with unlocked RWLock"</span> <span class='hs-varid'>me</span>
<a name="line-210"></a>
<a name="line-211"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>-></span> <span class='hs-comment'>{- 2 -}</span>
<a name="line-212"></a> <span class='hs-varid'>err</span> <span class='hs-str'>"cannot releaseRead lock from unlocked RWLock"</span> <span class='hs-varid'>me</span>
<a name="line-213"></a>
<a name="line-214"></a> <span class='hs-varid'>w</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Writer</span> <span class='hs-layout'>{</span> <span class='hs-varid'>writerID</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>it</span><span class='hs-layout'>,</span> <span class='hs-varid'>readerCount</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>rc</span><span class='hs-layout'>,</span> <span class='hs-varid'>queue</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>q</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>it</span><span class='hs-varop'>==</span><span class='hs-varid'>me</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-215"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>rc</span> <span class='hs-keyword'>of</span>
<a name="line-216"></a> <span class='hs-num'>0</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>abandon</span> <span class='hs-keyglyph'>-></span> <span class='hs-comment'>{- 3 -}</span>
<a name="line-217"></a> <span class='hs-varid'>impossible</span> <span class='hs-str'>"acquireRead interrupted with write lock but not read lock"</span> <span class='hs-layout'>(</span><span class='hs-varid'>me</span><span class='hs-layout'>,</span><span class='hs-varid'>it</span><span class='hs-layout'>)</span>
<a name="line-218"></a>
<a name="line-219"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>-></span> <span class='hs-comment'>{- 4 -}</span>
<a name="line-220"></a> <span class='hs-varid'>err</span> <span class='hs-str'>"releaseRead when holding write lock but not read lock"</span> <span class='hs-layout'>(</span><span class='hs-varid'>me</span><span class='hs-layout'>,</span><span class='hs-varid'>it</span><span class='hs-layout'>)</span>
<a name="line-221"></a>
<a name="line-222"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span> <span class='hs-comment'>{- 5 -}</span>
<a name="line-223"></a> <span class='hs-varid'>rc'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>evaluate</span> <span class='hs-varop'>$</span> <span class='hs-varid'>pred</span> <span class='hs-varid'>rc</span>
<a name="line-224"></a> <span class='hs-varid'>ret</span> <span class='hs-layout'>(</span><span class='hs-varid'>w</span> <span class='hs-layout'>{</span> <span class='hs-varid'>readerCount</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>rc'</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-225"></a>
<a name="line-226"></a> <span class='hs-comment'>{-ditto-}</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>abandon</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span> <span class='hs-comment'>{- 6 -}</span>
<a name="line-227"></a> <span class='hs-varid'>q'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dropReader</span> <span class='hs-varid'>q</span>
<a name="line-228"></a> <span class='hs-varid'>ret</span> <span class='hs-layout'>(</span><span class='hs-varid'>w</span> <span class='hs-layout'>{</span> <span class='hs-varid'>queue</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>q'</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-229"></a>
<a name="line-230"></a> <span class='hs-comment'>{-ditto-}</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>-></span> <span class='hs-comment'>{- 7 -}</span>
<a name="line-231"></a> <span class='hs-varid'>err</span> <span class='hs-str'>"releaseRead called when not read locked "</span> <span class='hs-varid'>me</span>
<a name="line-232"></a>
<a name="line-233"></a> <span class='hs-varid'>r</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Readers</span> <span class='hs-layout'>{</span> <span class='hs-varid'>readerCounts</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>rcs</span><span class='hs-layout'>,</span><span class='hs-varid'>queueR</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>qR</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-234"></a> <span class='hs-keyword'>case</span> <span class='hs-conid'>Map</span><span class='hs-varop'>.</span><span class='hs-varid'>lookup</span> <span class='hs-varid'>me</span> <span class='hs-varid'>rcs</span> <span class='hs-keyword'>of</span>
<a name="line-235"></a> <span class='hs-conid'>Just</span> <span class='hs-num'>1</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-236"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>rcs'</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Map</span><span class='hs-varop'>.</span><span class='hs-varid'>delete</span> <span class='hs-varid'>me</span> <span class='hs-varid'>rcs</span>
<a name="line-237"></a> <span class='hs-keyword'>if</span> <span class='hs-conid'>Map</span><span class='hs-varop'>.</span><span class='hs-varid'>null</span> <span class='hs-varid'>rcs'</span>
<a name="line-238"></a> <span class='hs-keyword'>then</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>qR</span> <span class='hs-keyword'>of</span>
<a name="line-239"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-comment'>{- 8 -}</span>
<a name="line-240"></a> <span class='hs-varid'>ret</span> <span class='hs-conid'>FreeLock</span>
<a name="line-241"></a>
<a name="line-242"></a> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>wid</span><span class='hs-layout'>,</span><span class='hs-varid'>mblock</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-varid'>q</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span> <span class='hs-comment'>{- 9 -}</span>
<a name="line-243"></a> <span class='hs-varid'>putMVar</span> <span class='hs-varid'>mblock</span> <span class='hs-conid'>()</span>
<a name="line-244"></a> <span class='hs-varid'>ret</span> <span class='hs-layout'>(</span><span class='hs-conid'>Writer</span> <span class='hs-layout'>{</span> <span class='hs-varid'>writerID</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>wid</span><span class='hs-layout'>,</span> <span class='hs-varid'>writerCount</span><span class='hs-keyglyph'>=</span><span class='hs-num'>1</span><span class='hs-layout'>,</span> <span class='hs-varid'>readerCount</span><span class='hs-keyglyph'>=</span><span class='hs-num'>0</span><span class='hs-layout'>,</span> <span class='hs-varid'>queue</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>q</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-245"></a>
<a name="line-246"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>ret</span> <span class='hs-layout'>(</span><span class='hs-varid'>r</span> <span class='hs-layout'>{</span> <span class='hs-varid'>readerCounts</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>rcs'</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-comment'>{- 10 -}</span>
<a name="line-247"></a>
<a name="line-248"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>rc</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span> <span class='hs-comment'>{- 11 -}</span>
<a name="line-249"></a> <span class='hs-varid'>rc'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>evaluate</span> <span class='hs-varop'>$</span> <span class='hs-varid'>pred</span> <span class='hs-varid'>rc</span>
<a name="line-250"></a> <span class='hs-varid'>rcs'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>evaluate</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Map</span><span class='hs-varop'>.</span><span class='hs-varid'>insert</span> <span class='hs-varid'>me</span> <span class='hs-varid'>rc'</span> <span class='hs-varid'>rcs</span>
<a name="line-251"></a> <span class='hs-varid'>ret</span> <span class='hs-layout'>(</span><span class='hs-varid'>r</span> <span class='hs-layout'>{</span> <span class='hs-varid'>readerCounts</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>rcs'</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-252"></a>
<a name="line-253"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>abandon</span> <span class='hs-keyglyph'>-></span>
<a name="line-254"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>qR</span> <span class='hs-keyword'>of</span>
<a name="line-255"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-comment'>{- 12 -}</span>
<a name="line-256"></a> <span class='hs-varid'>impossible</span> <span class='hs-str'>"acquireRead interrupted not holding lock and with no queue"</span> <span class='hs-layout'>(</span><span class='hs-varid'>me</span><span class='hs-layout'>,</span><span class='hs-varid'>rcs</span><span class='hs-layout'>)</span>
<a name="line-257"></a>
<a name="line-258"></a> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>w</span><span class='hs-layout'>,</span><span class='hs-varid'>q</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-comment'>{- 13 -}</span> <span class='hs-keyword'>do</span>
<a name="line-259"></a> <span class='hs-varid'>q'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dropReader</span> <span class='hs-varid'>q</span>
<a name="line-260"></a> <span class='hs-varid'>ret</span> <span class='hs-layout'>(</span><span class='hs-varid'>r</span> <span class='hs-layout'>{</span> <span class='hs-varid'>queueR</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>w</span><span class='hs-layout'>,</span><span class='hs-varid'>q'</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-261"></a>
<a name="line-262"></a> <span class='hs-comment'>{-ditto-}</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>-></span> <span class='hs-comment'>{- 14 -}</span>
<a name="line-263"></a> <span class='hs-varid'>err</span> <span class='hs-str'>"releaseRead called with read lock held by others"</span> <span class='hs-layout'>(</span><span class='hs-varid'>me</span><span class='hs-layout'>,</span><span class='hs-varid'>rcs</span><span class='hs-layout'>)</span>
<a name="line-264"></a>
<a name="line-265"></a><a name="releaseWrite"></a><span class='hs-comment'>-- | A thread that calls acquireWrite must later call releaseWrite once for each call to acquireWrite.</span>
<a name="line-266"></a><span class='hs-comment'>--</span>
<a name="line-267"></a><span class='hs-comment'>-- If this thread has not previous called acquireWrite then releaseWrite will do nothing and return</span>
<a name="line-268"></a><span class='hs-comment'>-- a (Left error).</span>
<a name="line-269"></a><span class='hs-comment'>--</span>
<a name="line-270"></a><span class='hs-comment'>-- This can block but cannot be interrupted.</span>
<a name="line-271"></a><span class='hs-definition'>releaseWrite</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RWLock</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-layout'>(</span><span class='hs-conid'>Either</span> <span class='hs-conid'>RWLockException</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span>
<a name="line-272"></a><span class='hs-definition'>releaseWrite</span> <span class='hs-layout'>(</span><span class='hs-conid'>RWL</span> <span class='hs-varid'>rwlVar</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mask_</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-273"></a> <span class='hs-varid'>me</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>myThreadId</span>
<a name="line-274"></a> <span class='hs-varid'>releaseWrite'</span> <span class='hs-conid'>False</span> <span class='hs-varid'>me</span> <span class='hs-varid'>rwlVar</span> <span class='hs-comment'>-- False to indicate call is from releaseWrite</span>
<a name="line-275"></a>
<a name="line-276"></a><a name="releaseWrite'"></a><span class='hs-comment'>-- Nine non-impossible cases, plus one impossible case</span>
<a name="line-277"></a><span class='hs-comment'>-- Lock is Free</span>
<a name="line-278"></a><span class='hs-comment'>-- I have write lock, I only had 1 write lock and no read locks, promote from LockQ</span>
<a name="line-279"></a><span class='hs-comment'>-- , I only had 1 write lock and some read locks, convert me to reader and promote leading readers</span>
<a name="line-280"></a><span class='hs-comment'>-- , I have many write locks, just decrement the counter</span>
<a name="line-281"></a><span class='hs-comment'>-- Someone else has write lock, abandoning my acquireWrite</span>
<a name="line-282"></a><span class='hs-comment'>-- , releaseWrite called in error</span>
<a name="line-283"></a><span class='hs-comment'>-- Read lock held, releaseWrite called in error</span>
<a name="line-284"></a><span class='hs-comment'>-- , with no queue, abandoning acquireWrite is IMPOSSIBLE</span>
<a name="line-285"></a><span class='hs-comment'>-- , abandoning my leading acquireWrite</span>
<a name="line-286"></a><span class='hs-comment'>-- , abandoning my non-leading acquireWrite</span>
<a name="line-287"></a><span class='hs-definition'>releaseWrite'</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Bool</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>ThreadId</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MVar</span> <span class='hs-conid'>LockUser</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-layout'>(</span><span class='hs-conid'>Either</span> <span class='hs-conid'>RWLockException</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span>
<a name="line-288"></a><span class='hs-definition'>releaseWrite'</span> <span class='hs-varid'>abandon</span> <span class='hs-varid'>me</span> <span class='hs-varid'>rwlVar</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>uninterruptibleMask_</span> <span class='hs-varop'>.</span> <span class='hs-varid'>modifyMVar</span> <span class='hs-varid'>rwlVar</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>rwd</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-289"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>impossible</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Show</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-varid'>a</span>
<a name="line-290"></a> <span class='hs-varid'>impossible</span> <span class='hs-varid'>s</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>throw</span>
<a name="line-291"></a> <span class='hs-layout'>(</span><span class='hs-conid'>RWLockException</span> <span class='hs-varid'>me</span> <span class='hs-layout'>(</span><span class='hs-keyword'>if</span> <span class='hs-varid'>abandon</span> <span class='hs-keyword'>then</span> <span class='hs-conid'>RWLock'acquireWrite</span> <span class='hs-keyword'>else</span> <span class='hs-conid'>RWLock'releaseWrite</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>imp</span> <span class='hs-varid'>s</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-292"></a> <span class='hs-varid'>err</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Show</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-layout'>(</span><span class='hs-conid'>LockUser</span><span class='hs-layout'>,</span><span class='hs-conid'>Either</span> <span class='hs-conid'>RWLockException</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span>
<a name="line-293"></a> <span class='hs-varid'>err</span> <span class='hs-varid'>s</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-varop'>.</span> <span class='hs-layout'>(</span><span class='hs-conid'>(,)</span> <span class='hs-varid'>rwd</span><span class='hs-layout'>)</span> <span class='hs-varop'>.</span> <span class='hs-conid'>Left</span> <span class='hs-varop'>$</span>
<a name="line-294"></a> <span class='hs-layout'>(</span><span class='hs-conid'>RWLockException</span> <span class='hs-varid'>me</span> <span class='hs-layout'>(</span><span class='hs-keyword'>if</span> <span class='hs-varid'>abandon</span> <span class='hs-keyword'>then</span> <span class='hs-conid'>RWLock'acquireWrite</span> <span class='hs-keyword'>else</span> <span class='hs-conid'>RWLock'releaseWrite</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>s</span><span class='hs-varop'>++</span><span class='hs-str'>" : "</span><span class='hs-varop'>++</span><span class='hs-varid'>show</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-295"></a> <span class='hs-varid'>ret</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>LockUser</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-layout'>(</span><span class='hs-conid'>LockUser</span><span class='hs-layout'>,</span><span class='hs-conid'>Either</span> <span class='hs-conid'>RWLockException</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span>
<a name="line-296"></a> <span class='hs-varid'>ret</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span><span class='hs-conid'>Right</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span>
<a name="line-297"></a>
<a name="line-298"></a> <span class='hs-varid'>dropWriter</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>LockQ</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>LockQ</span>
<a name="line-299"></a> <span class='hs-varid'>dropWriter</span> <span class='hs-varid'>q</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-300"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>inW</span> <span class='hs-layout'>(</span><span class='hs-conid'>WriterKind</span> <span class='hs-varid'>it</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>me</span><span class='hs-varop'>==</span><span class='hs-varid'>it</span>
<a name="line-301"></a> <span class='hs-varid'>inW</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-302"></a> <span class='hs-layout'>(</span><span class='hs-varid'>pre</span><span class='hs-layout'>,</span><span class='hs-varid'>myselfPost</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Seq</span><span class='hs-varop'>.</span><span class='hs-varid'>breakl</span> <span class='hs-varid'>inW</span> <span class='hs-varid'>q</span>
<a name="line-303"></a> <span class='hs-keyword'>case</span> <span class='hs-conid'>Seq</span><span class='hs-varop'>.</span><span class='hs-varid'>viewl</span> <span class='hs-varid'>myselfPost</span> <span class='hs-keyword'>of</span>
<a name="line-304"></a> <span class='hs-conid'>EmptyL</span> <span class='hs-keyglyph'>-></span>
<a name="line-305"></a> <span class='hs-varid'>impossible</span> <span class='hs-str'>"failure to abandon acquireWrite, RWLock locked by other and not in queue"</span> <span class='hs-varid'>me</span>
<a name="line-306"></a> <span class='hs-keyword'>_</span> <span class='hs-conop'>:<</span> <span class='hs-varid'>post</span> <span class='hs-keyglyph'>-></span>
<a name="line-307"></a> <span class='hs-varid'>evaluate</span> <span class='hs-varop'>$</span> <span class='hs-varid'>pre</span><span class='hs-varop'>><</span><span class='hs-varid'>post</span>
<a name="line-308"></a>
<a name="line-309"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>rwd</span> <span class='hs-keyword'>of</span>
<a name="line-310"></a> <span class='hs-conid'>FreeLock</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>abandon</span> <span class='hs-keyglyph'>-></span>
<a name="line-311"></a> <span class='hs-varid'>impossible</span> <span class='hs-str'>"acquireWrite interrupted with unlocked RWLock"</span> <span class='hs-varid'>me</span>
<a name="line-312"></a>
<a name="line-313"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>-></span>
<a name="line-314"></a> <span class='hs-varid'>err</span> <span class='hs-str'>"cannot releaseWrite lock from unlocked RWLock"</span> <span class='hs-varid'>me</span>
<a name="line-315"></a>
<a name="line-316"></a> <span class='hs-varid'>w</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Writer</span> <span class='hs-layout'>{</span> <span class='hs-varid'>writerID</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>it</span><span class='hs-layout'>,</span> <span class='hs-varid'>writerCount</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>wc</span><span class='hs-layout'>,</span> <span class='hs-varid'>readerCount</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>rc</span><span class='hs-layout'>,</span> <span class='hs-varid'>queue</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>q</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>it</span><span class='hs-varop'>==</span><span class='hs-varid'>me</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-317"></a> <span class='hs-keyword'>case</span> <span class='hs-layout'>(</span><span class='hs-varid'>wc</span><span class='hs-layout'>,</span><span class='hs-varid'>rc</span><span class='hs-layout'>)</span> <span class='hs-keyword'>of</span>
<a name="line-318"></a> <span class='hs-layout'>(</span><span class='hs-num'>1</span><span class='hs-layout'>,</span><span class='hs-num'>0</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>ret</span> <span class='hs-varop'>=<<</span> <span class='hs-varid'>promote</span> <span class='hs-varid'>q</span> <span class='hs-comment'>-- if abandon then this is the only valid case</span>
<a name="line-319"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>abandon</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>impossible</span> <span class='hs-str'>"acquireWrite interrupted with write lock and bad RWLock state"</span> <span class='hs-layout'>(</span><span class='hs-varid'>me</span><span class='hs-layout'>,</span><span class='hs-varid'>it</span><span class='hs-layout'>,</span><span class='hs-varid'>wc</span><span class='hs-layout'>,</span><span class='hs-varid'>rc</span><span class='hs-layout'>)</span>
<a name="line-320"></a> <span class='hs-layout'>(</span><span class='hs-num'>1</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>ret</span> <span class='hs-varop'>=<<</span> <span class='hs-varid'>promoteReader</span> <span class='hs-varid'>rc</span> <span class='hs-varid'>q</span>
<a name="line-321"></a> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>ret</span> <span class='hs-layout'>(</span><span class='hs-varid'>w</span> <span class='hs-layout'>{</span> <span class='hs-varid'>writerCount</span><span class='hs-keyglyph'>=</span><span class='hs-layout'>(</span><span class='hs-varid'>pred</span> <span class='hs-varid'>wc</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-322"></a>
<a name="line-323"></a> <span class='hs-comment'>{-ditto-}</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>abandon</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-324"></a> <span class='hs-varid'>q'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dropWriter</span> <span class='hs-varid'>q</span>
<a name="line-325"></a> <span class='hs-varid'>ret</span> <span class='hs-layout'>(</span><span class='hs-varid'>w</span> <span class='hs-layout'>{</span> <span class='hs-varid'>queue</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>q'</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-326"></a>
<a name="line-327"></a> <span class='hs-comment'>{-ditto-}</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-328"></a> <span class='hs-varid'>err</span> <span class='hs-str'>"cannot releaseWrite when not not holding the write lock"</span> <span class='hs-layout'>(</span><span class='hs-varid'>me</span><span class='hs-layout'>,</span><span class='hs-varid'>it</span><span class='hs-layout'>)</span>
<a name="line-329"></a>
<a name="line-330"></a> <span class='hs-conid'>Readers</span> <span class='hs-layout'>{</span> <span class='hs-varid'>readerCounts</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>rcs</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>not</span> <span class='hs-varid'>abandon</span> <span class='hs-keyglyph'>-></span>
<a name="line-331"></a> <span class='hs-varid'>err</span> <span class='hs-str'>"cannot releaseWrite when RWLock is read locked"</span> <span class='hs-layout'>(</span><span class='hs-varid'>me</span><span class='hs-layout'>,</span><span class='hs-varid'>rcs</span><span class='hs-layout'>)</span>
<a name="line-332"></a>
<a name="line-333"></a> <span class='hs-conid'>Readers</span> <span class='hs-layout'>{</span> <span class='hs-varid'>readerCounts</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>rcs</span><span class='hs-layout'>,</span> <span class='hs-varid'>queueR</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>Nothing</span> <span class='hs-layout'>}</span> <span class='hs-keyglyph'>-></span>
<a name="line-334"></a> <span class='hs-varid'>impossible</span> <span class='hs-str'>"failure to abandon acquireWrite, RWLock read locked and no queue"</span> <span class='hs-layout'>(</span><span class='hs-varid'>me</span><span class='hs-layout'>,</span><span class='hs-varid'>rcs</span><span class='hs-layout'>)</span>
<a name="line-335"></a>
<a name="line-336"></a> <span class='hs-varid'>r</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Readers</span> <span class='hs-layout'>{</span> <span class='hs-varid'>readerCounts</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>rcs</span><span class='hs-layout'>,</span> <span class='hs-varid'>queueR</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>w</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-varid'>it</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-varid'>q</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>it</span><span class='hs-varop'>==</span><span class='hs-varid'>me</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-337"></a> <span class='hs-layout'>(</span><span class='hs-varid'>rcs'new</span><span class='hs-layout'>,</span><span class='hs-varid'>qr</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>splitReaders</span> <span class='hs-varid'>q</span>
<a name="line-338"></a> <span class='hs-varid'>ret</span> <span class='hs-layout'>(</span><span class='hs-varid'>r</span> <span class='hs-layout'>{</span> <span class='hs-varid'>readerCounts</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>Map</span><span class='hs-varop'>.</span><span class='hs-varid'>union</span> <span class='hs-varid'>rcs</span> <span class='hs-varid'>rcs'new</span><span class='hs-layout'>,</span> <span class='hs-varid'>queueR</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>qr</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-339"></a>
<a name="line-340"></a> <span class='hs-comment'>{- ditto -}</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-341"></a> <span class='hs-varid'>q'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dropWriter</span> <span class='hs-varid'>q</span>
<a name="line-342"></a> <span class='hs-varid'>ret</span> <span class='hs-layout'>(</span><span class='hs-varid'>r</span> <span class='hs-layout'>{</span> <span class='hs-varid'>queueR</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>w</span><span class='hs-layout'>,</span><span class='hs-varid'>q'</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-343"></a>
<a name="line-344"></a> <span class='hs-keyword'>where</span>
<a name="line-345"></a> <span class='hs-comment'>-- | promote when converting from write lock straight to read lock</span>
<a name="line-346"></a> <span class='hs-varid'>promoteReader</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Int</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>LockQ</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>LockUser</span>
<a name="line-347"></a> <span class='hs-varid'>promoteReader</span> <span class='hs-varid'>rc</span> <span class='hs-varid'>q</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-348"></a> <span class='hs-layout'>(</span><span class='hs-varid'>rcs'new</span><span class='hs-layout'>,</span> <span class='hs-varid'>qr</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>splitReaders</span> <span class='hs-varid'>q</span>
<a name="line-349"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>rcs</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Map</span><span class='hs-varop'>.</span><span class='hs-varid'>insert</span> <span class='hs-varid'>me</span> <span class='hs-varid'>rc</span> <span class='hs-varid'>rcs'new</span>
<a name="line-350"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>Readers</span> <span class='hs-layout'>{</span> <span class='hs-varid'>readerCounts</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>rcs</span><span class='hs-layout'>,</span> <span class='hs-varid'>queueR</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>qr</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-351"></a>
<a name="line-352"></a> <span class='hs-comment'>-- | promote from releasing write lock</span>
<a name="line-353"></a> <span class='hs-varid'>promote</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>LockQ</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>LockUser</span>
<a name="line-354"></a> <span class='hs-varid'>promote</span> <span class='hs-varid'>qIn</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-355"></a> <span class='hs-keyword'>case</span> <span class='hs-conid'>Seq</span><span class='hs-varop'>.</span><span class='hs-varid'>viewl</span> <span class='hs-varid'>qIn</span> <span class='hs-keyword'>of</span>
<a name="line-356"></a> <span class='hs-conid'>EmptyL</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-conid'>FreeLock</span>
<a name="line-357"></a>
<a name="line-358"></a> <span class='hs-layout'>(</span><span class='hs-conid'>WriterKind</span> <span class='hs-varid'>it</span><span class='hs-layout'>,</span><span class='hs-varid'>mblock</span><span class='hs-layout'>)</span> <span class='hs-conop'>:<</span> <span class='hs-varid'>qOut</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-359"></a> <span class='hs-varid'>putMVar</span> <span class='hs-varid'>mblock</span> <span class='hs-conid'>()</span>
<a name="line-360"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>Writer</span> <span class='hs-layout'>{</span> <span class='hs-varid'>writerID</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>it</span><span class='hs-layout'>,</span> <span class='hs-varid'>writerCount</span><span class='hs-keyglyph'>=</span><span class='hs-num'>1</span><span class='hs-layout'>,</span> <span class='hs-varid'>readerCount</span><span class='hs-keyglyph'>=</span><span class='hs-num'>0</span><span class='hs-layout'>,</span> <span class='hs-varid'>queue</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>qOut</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-361"></a>
<a name="line-362"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-363"></a> <span class='hs-layout'>(</span><span class='hs-varid'>rcs</span><span class='hs-layout'>,</span><span class='hs-varid'>qr</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>splitReaders</span> <span class='hs-varid'>qIn</span>
<a name="line-364"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>Readers</span> <span class='hs-layout'>{</span> <span class='hs-varid'>readerCounts</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>rcs</span><span class='hs-layout'>,</span> <span class='hs-varid'>queueR</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>qr</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-365"></a>
<a name="line-366"></a> <span class='hs-comment'>-- | Merge (and wake) any and all readers on left end of LockQ, and return queueR value</span>
<a name="line-367"></a> <span class='hs-varid'>splitReaders</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>LockQ</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-layout'>(</span><span class='hs-conid'>TMap</span><span class='hs-layout'>,</span><span class='hs-conid'>Maybe</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-conid'>ThreadId</span><span class='hs-layout'>,</span><span class='hs-conid'>MVar</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-conid'>LockQ</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-368"></a> <span class='hs-varid'>splitReaders</span> <span class='hs-varid'>qIn</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-369"></a> <span class='hs-keyword'>let</span> <span class='hs-layout'>(</span><span class='hs-varid'>more'Readers</span><span class='hs-layout'>,</span><span class='hs-varid'>qTail</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Seq</span><span class='hs-varop'>.</span><span class='hs-varid'>spanl</span> <span class='hs-varid'>isReader</span> <span class='hs-varid'>qIn</span>
<a name="line-370"></a> <span class='hs-layout'>(</span><span class='hs-varid'>rks</span><span class='hs-layout'>,</span><span class='hs-varid'>mblocks</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unzip</span> <span class='hs-layout'>(</span><span class='hs-conid'>F</span><span class='hs-varop'>.</span><span class='hs-varid'>toList</span> <span class='hs-varid'>more'Readers</span><span class='hs-layout'>)</span>
<a name="line-371"></a> <span class='hs-varid'>rcs</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Map</span><span class='hs-varop'>.</span><span class='hs-varid'>fromDistinctAscList</span> <span class='hs-varop'>.</span> <span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>k</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>k</span><span class='hs-layout'>,</span><span class='hs-num'>1</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varop'>.</span> <span class='hs-conid'>F</span><span class='hs-varop'>.</span><span class='hs-varid'>toList</span> <span class='hs-varop'>.</span> <span class='hs-conid'>Set</span><span class='hs-varop'>.</span><span class='hs-varid'>unions</span> <span class='hs-varop'>.</span> <span class='hs-varid'>map</span> <span class='hs-varid'>unRK</span> <span class='hs-varop'>$</span> <span class='hs-varid'>rks</span>
<a name="line-372"></a> <span class='hs-varid'>qr</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-conid'>Seq</span><span class='hs-varop'>.</span><span class='hs-varid'>viewl</span> <span class='hs-varid'>qTail</span> <span class='hs-keyword'>of</span>
<a name="line-373"></a> <span class='hs-conid'>EmptyL</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Nothing</span>
<a name="line-374"></a> <span class='hs-layout'>(</span><span class='hs-varid'>wk</span><span class='hs-layout'>,</span><span class='hs-varid'>mblock</span><span class='hs-layout'>)</span> <span class='hs-conop'>:<</span> <span class='hs-varid'>qOut</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>unWK</span> <span class='hs-varid'>wk</span><span class='hs-layout'>,</span><span class='hs-varid'>mblock</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-varid'>qOut</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- unWK safe</span>
<a name="line-375"></a> <span class='hs-varid'>forM_</span> <span class='hs-varid'>mblocks</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>mblock</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>putMVar</span> <span class='hs-varid'>mblock</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span>
<a name="line-376"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>rcs</span><span class='hs-layout'>,</span><span class='hs-varid'>qr</span><span class='hs-layout'>)</span>
<a name="line-377"></a> <span class='hs-keyword'>where</span>
<a name="line-378"></a> <span class='hs-varid'>isReader</span> <span class='hs-layout'>(</span><span class='hs-conid'>ReaderKind</span> <span class='hs-layout'>{</span><span class='hs-layout'>}</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-379"></a> <span class='hs-varid'>isReader</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-380"></a>
<a name="line-381"></a><span class='hs-comment'>-- Six cases below:</span>
<a name="line-382"></a><span class='hs-comment'>-- Lock is Free</span>
<a name="line-383"></a><span class='hs-comment'>-- I already have write lock</span>
<a name="line-384"></a><span class='hs-comment'>-- Someone else has write lock, leads to mblock</span>
<a name="line-385"></a><span class='hs-comment'>-- I alread have read lock</span>
<a name="line-386"></a><span class='hs-comment'>-- Someone else has read lock, no pending write lock</span>
<a name="line-387"></a><span class='hs-comment'>-- Someone else has read lock, there is a pending write lock, leads to mblock</span>
<a name="line-388"></a>
<a name="line-389"></a><a name="acquireRead"></a><span class='hs-comment'>-- | Any thread may call acquireRead (even ones holding write locks). This read lock may be</span>
<a name="line-390"></a><span class='hs-comment'>-- acquired multiple times, requiring an identical number of releaseRead calls.</span>
<a name="line-391"></a><span class='hs-comment'>--</span>
<a name="line-392"></a><span class='hs-comment'>-- All previous calls to acquireWrite by other threads will have succeeded and been released (or</span>
<a name="line-393"></a><span class='hs-comment'>-- interrupted) before this acquireRead will return.</span>
<a name="line-394"></a><span class='hs-comment'>--</span>
<a name="line-395"></a><span class='hs-comment'>-- The best way to use acquireRead is to use withRead instead to ensure releaseRead will be called</span>
<a name="line-396"></a><span class='hs-comment'>-- exactly once.</span>
<a name="line-397"></a><span class='hs-comment'>--</span>
<a name="line-398"></a><span class='hs-comment'>-- This may block and be safely interrupted. If interrupted then the RWLock will be left unchanged.</span>
<a name="line-399"></a><span class='hs-definition'>acquireRead</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RWLock</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
<a name="line-400"></a><span class='hs-definition'>acquireRead</span> <span class='hs-layout'>(</span><span class='hs-conid'>RWL</span> <span class='hs-varid'>rwlVar</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mask_</span> <span class='hs-varop'>.</span> <span class='hs-varid'>join</span> <span class='hs-varop'>.</span> <span class='hs-varid'>modifyMVar</span> <span class='hs-varid'>rwlVar</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>rwd</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-401"></a> <span class='hs-varid'>me</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>myThreadId</span>
<a name="line-402"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>safeBlock</span> <span class='hs-varid'>mblock</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>readMVar</span> <span class='hs-varid'>mblock</span><span class='hs-layout'>)</span> <span class='hs-varop'>`onException`</span> <span class='hs-layout'>(</span><span class='hs-varid'>releaseRead'</span> <span class='hs-conid'>True</span> <span class='hs-varid'>me</span> <span class='hs-varid'>rwlVar</span><span class='hs-layout'>)</span>
<a name="line-403"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>rwd</span> <span class='hs-keyword'>of</span>
<a name="line-404"></a> <span class='hs-conid'>FreeLock</span> <span class='hs-keyglyph'>-></span>
<a name="line-405"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span> <span class='hs-conid'>Readers</span> <span class='hs-layout'>{</span> <span class='hs-varid'>readerCounts</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>Map</span><span class='hs-varop'>.</span><span class='hs-varid'>singleton</span> <span class='hs-varid'>me</span> <span class='hs-num'>1</span><span class='hs-layout'>,</span> <span class='hs-varid'>queueR</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>Nothing</span> <span class='hs-layout'>}</span>
<a name="line-406"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span> <span class='hs-layout'>)</span>
<a name="line-407"></a>
<a name="line-408"></a> <span class='hs-varid'>w</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Writer</span> <span class='hs-layout'>{</span> <span class='hs-varid'>writerID</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>it</span><span class='hs-layout'>,</span> <span class='hs-varid'>readerCount</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>rc</span><span class='hs-layout'>,</span> <span class='hs-varid'>queue</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>q</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>it</span> <span class='hs-varop'>==</span> <span class='hs-varid'>me</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-409"></a> <span class='hs-varid'>rc'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>evaluate</span> <span class='hs-varop'>$</span> <span class='hs-varid'>succ</span> <span class='hs-varid'>rc</span>
<a name="line-410"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span> <span class='hs-varid'>w</span> <span class='hs-layout'>{</span> <span class='hs-varid'>readerCount</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>rc'</span> <span class='hs-layout'>}</span>
<a name="line-411"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span> <span class='hs-layout'>)</span>
<a name="line-412"></a>
<a name="line-413"></a> <span class='hs-comment'>{- ditto -}</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-414"></a> <span class='hs-layout'>(</span><span class='hs-varid'>q'</span><span class='hs-layout'>,</span><span class='hs-varid'>mblock</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>enterQueueR</span> <span class='hs-varid'>q</span> <span class='hs-varid'>me</span>
<a name="line-415"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span> <span class='hs-varid'>w</span> <span class='hs-layout'>{</span> <span class='hs-varid'>queue</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>q'</span> <span class='hs-layout'>}</span>
<a name="line-416"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>safeBlock</span> <span class='hs-varid'>mblock</span> <span class='hs-layout'>)</span>
<a name="line-417"></a>
<a name="line-418"></a> <span class='hs-varid'>r</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Readers</span> <span class='hs-layout'>{</span> <span class='hs-varid'>readerCounts</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>rcs</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>rc</span> <span class='hs-keyglyph'><-</span> <span class='hs-conid'>Map</span><span class='hs-varop'>.</span><span class='hs-varid'>lookup</span> <span class='hs-varid'>me</span> <span class='hs-varid'>rcs</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-419"></a> <span class='hs-varid'>rc'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>evaluate</span> <span class='hs-varop'>$</span> <span class='hs-varid'>succ</span> <span class='hs-varid'>rc</span>
<a name="line-420"></a> <span class='hs-varid'>rcs'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>evaluate</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Map</span><span class='hs-varop'>.</span><span class='hs-varid'>insert</span> <span class='hs-varid'>me</span> <span class='hs-varid'>rc'</span> <span class='hs-varid'>rcs</span>
<a name="line-421"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span> <span class='hs-varid'>r</span> <span class='hs-layout'>{</span> <span class='hs-varid'>readerCounts</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>rcs'</span> <span class='hs-layout'>}</span>
<a name="line-422"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span> <span class='hs-layout'>)</span>
<a name="line-423"></a>
<a name="line-424"></a> <span class='hs-varid'>r</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Readers</span> <span class='hs-layout'>{</span> <span class='hs-varid'>readerCounts</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>rcs</span><span class='hs-layout'>,</span> <span class='hs-varid'>queueR</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>Nothing</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-425"></a> <span class='hs-varid'>rcs'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>evaluate</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Map</span><span class='hs-varop'>.</span><span class='hs-varid'>insert</span> <span class='hs-varid'>me</span> <span class='hs-num'>1</span> <span class='hs-varid'>rcs</span>
<a name="line-426"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span> <span class='hs-varid'>r</span> <span class='hs-layout'>{</span> <span class='hs-varid'>readerCounts</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>rcs'</span> <span class='hs-layout'>}</span>
<a name="line-427"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span> <span class='hs-layout'>)</span>
<a name="line-428"></a>
<a name="line-429"></a> <span class='hs-varid'>r</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Readers</span> <span class='hs-layout'>{</span> <span class='hs-varid'>queueR</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>w</span><span class='hs-layout'>,</span><span class='hs-varid'>q</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-430"></a> <span class='hs-layout'>(</span><span class='hs-varid'>q'</span><span class='hs-layout'>,</span><span class='hs-varid'>mblock</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>enterQueueR</span> <span class='hs-varid'>q</span> <span class='hs-varid'>me</span>
<a name="line-431"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span> <span class='hs-varid'>r</span> <span class='hs-layout'>{</span> <span class='hs-varid'>queueR</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>w</span><span class='hs-layout'>,</span><span class='hs-varid'>q'</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-432"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>safeBlock</span> <span class='hs-varid'>mblock</span> <span class='hs-layout'>)</span>
<a name="line-433"></a> <span class='hs-keyword'>where</span>
<a name="line-434"></a> <span class='hs-comment'>-- Merge adjacent readers when adding to right end of LockQ</span>
<a name="line-435"></a> <span class='hs-varid'>enterQueueR</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>LockQ</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>ThreadId</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-layout'>(</span><span class='hs-conid'>LockQ</span><span class='hs-layout'>,</span><span class='hs-conid'>MVar</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span>
<a name="line-436"></a> <span class='hs-varid'>enterQueueR</span> <span class='hs-varid'>qIn</span> <span class='hs-varid'>me</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-437"></a> <span class='hs-keyword'>case</span> <span class='hs-conid'>Seq</span><span class='hs-varop'>.</span><span class='hs-varid'>viewr</span> <span class='hs-varid'>qIn</span> <span class='hs-keyword'>of</span>
<a name="line-438"></a> <span class='hs-varid'>pre</span> <span class='hs-conop'>:></span> <span class='hs-layout'>(</span><span class='hs-conid'>ReaderKind</span> <span class='hs-varid'>rcs</span><span class='hs-layout'>,</span><span class='hs-varid'>mblock</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-439"></a> <span class='hs-varid'>rcs'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>addMe</span> <span class='hs-varid'>rcs</span>
<a name="line-440"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>pre</span> <span class='hs-varop'>|></span> <span class='hs-layout'>(</span><span class='hs-conid'>ReaderKind</span> <span class='hs-varid'>rcs'</span><span class='hs-layout'>,</span> <span class='hs-varid'>mblock</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-varid'>mblock</span><span class='hs-layout'>)</span>
<a name="line-441"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-442"></a> <span class='hs-varid'>mblock</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newEmptyMVar</span>
<a name="line-443"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>qIn</span> <span class='hs-varop'>|></span> <span class='hs-layout'>(</span><span class='hs-conid'>ReaderKind</span> <span class='hs-layout'>(</span><span class='hs-conid'>Set</span><span class='hs-varop'>.</span><span class='hs-varid'>singleton</span> <span class='hs-varid'>me</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-varid'>mblock</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>mblock</span><span class='hs-layout'>)</span>
<a name="line-444"></a> <span class='hs-keyword'>where</span>
<a name="line-445"></a> <span class='hs-comment'>-- Paranoid check of design assertion, TODO: remove check</span>
<a name="line-446"></a> <span class='hs-varid'>addMe</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TSet</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>TSet</span>
<a name="line-447"></a> <span class='hs-varid'>addMe</span> <span class='hs-varid'>rcs</span> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Set</span><span class='hs-varop'>.</span><span class='hs-varid'>member</span> <span class='hs-varid'>me</span> <span class='hs-varid'>rcs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>error</span> <span class='hs-layout'>(</span><span class='hs-varid'>imp</span> <span class='hs-str'>"enterQueueR.addMe when already in set"</span> <span class='hs-varid'>me</span><span class='hs-layout'>)</span>
<a name="line-448"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>Set</span><span class='hs-varop'>.</span><span class='hs-varid'>insert</span> <span class='hs-varid'>me</span> <span class='hs-varid'>rcs</span><span class='hs-layout'>)</span>
<a name="line-449"></a>
<a name="line-450"></a><a name="acquireReadPriority"></a><span class='hs-comment'>-- Five cases.</span>
<a name="line-451"></a><span class='hs-comment'>-- This is not exported. This has uninterruptibleMask_. It is used to restore read locks released</span>
<a name="line-452"></a><span class='hs-comment'>-- during acquireWrite when acquireWrite is called while holding read locks. If this acquireWrite</span>
<a name="line-453"></a><span class='hs-comment'>-- upgrade is going well then this thread holds the Writer lock and acquireReadPriority is identical</span>
<a name="line-454"></a><span class='hs-comment'>-- to acquireRead. If this acquireWrite gets interrupted then acquireReadPriority will to obtain</span>
<a name="line-455"></a><span class='hs-comment'>-- the read lock or put itself at the front of the queue if another thread holds the write lock.</span>
<a name="line-456"></a><span class='hs-definition'>acquireReadPriority</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RWLock</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
<a name="line-457"></a><span class='hs-definition'>acquireReadPriority</span> <span class='hs-layout'>(</span><span class='hs-conid'>RWL</span> <span class='hs-varid'>rwlVar</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>uninterruptibleMask_</span> <span class='hs-varop'>.</span> <span class='hs-varid'>join</span> <span class='hs-varop'>.</span> <span class='hs-varid'>modifyMVar</span> <span class='hs-varid'>rwlVar</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>rwd</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-458"></a> <span class='hs-varid'>me</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>myThreadId</span>
<a name="line-459"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>safeBlock</span> <span class='hs-varid'>mblock</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>readMVar</span> <span class='hs-varid'>mblock</span><span class='hs-layout'>)</span> <span class='hs-varop'>`onException`</span> <span class='hs-layout'>(</span><span class='hs-varid'>releaseRead'</span> <span class='hs-conid'>True</span> <span class='hs-varid'>me</span> <span class='hs-varid'>rwlVar</span><span class='hs-layout'>)</span>
<a name="line-460"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>rwd</span> <span class='hs-keyword'>of</span>
<a name="line-461"></a> <span class='hs-conid'>FreeLock</span> <span class='hs-keyglyph'>-></span>
<a name="line-462"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span> <span class='hs-conid'>Readers</span> <span class='hs-layout'>{</span> <span class='hs-varid'>readerCounts</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>Map</span><span class='hs-varop'>.</span><span class='hs-varid'>singleton</span> <span class='hs-varid'>me</span> <span class='hs-num'>1</span><span class='hs-layout'>,</span> <span class='hs-varid'>queueR</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>Nothing</span> <span class='hs-layout'>}</span>
<a name="line-463"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span> <span class='hs-layout'>)</span>
<a name="line-464"></a>
<a name="line-465"></a> <span class='hs-varid'>w</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Writer</span> <span class='hs-layout'>{</span> <span class='hs-varid'>writerID</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>it</span><span class='hs-layout'>,</span> <span class='hs-varid'>readerCount</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>rc</span><span class='hs-layout'>,</span> <span class='hs-varid'>queue</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>q</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>it</span> <span class='hs-varop'>==</span> <span class='hs-varid'>me</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-466"></a> <span class='hs-varid'>rc'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>evaluate</span> <span class='hs-varop'>$</span> <span class='hs-varid'>succ</span> <span class='hs-varid'>rc</span>
<a name="line-467"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span> <span class='hs-varid'>w</span> <span class='hs-layout'>{</span> <span class='hs-varid'>readerCount</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>rc'</span> <span class='hs-layout'>}</span>
<a name="line-468"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span> <span class='hs-layout'>)</span>
<a name="line-469"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-470"></a> <span class='hs-layout'>(</span><span class='hs-varid'>q'</span><span class='hs-layout'>,</span><span class='hs-varid'>mblock</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>enterQueueL</span> <span class='hs-varid'>me</span> <span class='hs-varid'>q</span>
<a name="line-471"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span> <span class='hs-varid'>w</span> <span class='hs-layout'>{</span> <span class='hs-varid'>queue</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>q'</span> <span class='hs-layout'>}</span>
<a name="line-472"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>safeBlock</span> <span class='hs-varid'>mblock</span> <span class='hs-layout'>)</span>
<a name="line-473"></a>
<a name="line-474"></a> <span class='hs-varid'>r</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Readers</span> <span class='hs-layout'>{</span> <span class='hs-varid'>readerCounts</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>rcs</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-475"></a> <span class='hs-keyword'>case</span> <span class='hs-conid'>Map</span><span class='hs-varop'>.</span><span class='hs-varid'>lookup</span> <span class='hs-varid'>me</span> <span class='hs-varid'>rcs</span> <span class='hs-keyword'>of</span>
<a name="line-476"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>rc</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-477"></a> <span class='hs-varid'>rc'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>evaluate</span> <span class='hs-varop'>$</span> <span class='hs-varid'>succ</span> <span class='hs-varid'>rc</span>
<a name="line-478"></a> <span class='hs-varid'>rcs'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>evaluate</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Map</span><span class='hs-varop'>.</span><span class='hs-varid'>insert</span> <span class='hs-varid'>me</span> <span class='hs-varid'>rc'</span> <span class='hs-varid'>rcs</span>
<a name="line-479"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span> <span class='hs-varid'>r</span> <span class='hs-layout'>{</span> <span class='hs-varid'>readerCounts</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>rcs'</span> <span class='hs-layout'>}</span>
<a name="line-480"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span> <span class='hs-layout'>)</span>
<a name="line-481"></a>
<a name="line-482"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-483"></a> <span class='hs-varid'>rcs'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>evaluate</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Map</span><span class='hs-varop'>.</span><span class='hs-varid'>insert</span> <span class='hs-varid'>me</span> <span class='hs-num'>1</span> <span class='hs-varid'>rcs</span>
<a name="line-484"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span> <span class='hs-varid'>r</span> <span class='hs-layout'>{</span> <span class='hs-varid'>readerCounts</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>rcs'</span> <span class='hs-layout'>}</span>
<a name="line-485"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span> <span class='hs-layout'>)</span>
<a name="line-486"></a> <span class='hs-keyword'>where</span>
<a name="line-487"></a> <span class='hs-comment'>-- Merge adjacent readers when adding to right end of LockQ</span>
<a name="line-488"></a> <span class='hs-varid'>enterQueueL</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ThreadId</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>LockQ</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-layout'>(</span><span class='hs-conid'>LockQ</span><span class='hs-layout'>,</span><span class='hs-conid'>MVar</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span>
<a name="line-489"></a> <span class='hs-varid'>enterQueueL</span> <span class='hs-varid'>me</span> <span class='hs-varid'>qIn</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-490"></a> <span class='hs-keyword'>case</span> <span class='hs-conid'>Seq</span><span class='hs-varop'>.</span><span class='hs-varid'>viewl</span> <span class='hs-varid'>qIn</span> <span class='hs-keyword'>of</span>
<a name="line-491"></a> <span class='hs-layout'>(</span><span class='hs-conid'>ReaderKind</span> <span class='hs-varid'>rcs</span><span class='hs-layout'>,</span><span class='hs-varid'>mblock</span><span class='hs-layout'>)</span> <span class='hs-conop'>:<</span> <span class='hs-varid'>post</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-492"></a> <span class='hs-varid'>rcs'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>addMe</span> <span class='hs-varid'>rcs</span>
<a name="line-493"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-conid'>ReaderKind</span> <span class='hs-varid'>rcs'</span><span class='hs-layout'>,</span> <span class='hs-varid'>mblock</span><span class='hs-layout'>)</span> <span class='hs-varop'><|</span> <span class='hs-varid'>post</span><span class='hs-layout'>,</span><span class='hs-varid'>mblock</span><span class='hs-layout'>)</span>
<a name="line-494"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-495"></a> <span class='hs-varid'>mblock</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newEmptyMVar</span>
<a name="line-496"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-conid'>ReaderKind</span> <span class='hs-layout'>(</span><span class='hs-conid'>Set</span><span class='hs-varop'>.</span><span class='hs-varid'>singleton</span> <span class='hs-varid'>me</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-varid'>mblock</span><span class='hs-layout'>)</span> <span class='hs-varop'><|</span> <span class='hs-varid'>qIn</span> <span class='hs-layout'>,</span> <span class='hs-varid'>mblock</span><span class='hs-layout'>)</span>
<a name="line-497"></a> <span class='hs-keyword'>where</span>
<a name="line-498"></a> <span class='hs-comment'>-- Paranoid check of design assertion, TODO: remove check</span>
<a name="line-499"></a> <span class='hs-varid'>addMe</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TSet</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>TSet</span>
<a name="line-500"></a> <span class='hs-varid'>addMe</span> <span class='hs-varid'>rcs</span> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Set</span><span class='hs-varop'>.</span><span class='hs-varid'>member</span> <span class='hs-varid'>me</span> <span class='hs-varid'>rcs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>error</span> <span class='hs-layout'>(</span><span class='hs-varid'>imp</span> <span class='hs-str'>"enterQueueL.addMe when already in set"</span> <span class='hs-varid'>me</span><span class='hs-layout'>)</span>
<a name="line-501"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>Set</span><span class='hs-varop'>.</span><span class='hs-varid'>insert</span> <span class='hs-varid'>me</span> <span class='hs-varid'>rcs</span><span class='hs-layout'>)</span>
<a name="line-502"></a>
<a name="line-503"></a><span class='hs-comment'>-- Six cases below:</span>
<a name="line-504"></a><span class='hs-comment'>-- Lock is Free</span>
<a name="line-505"></a><span class='hs-comment'>-- I already have write lock</span>
<a name="line-506"></a><span class='hs-comment'>-- Someone else has write lock, leads to waiting</span>
<a name="line-507"></a><span class='hs-comment'>-- I already have read lock</span>
<a name="line-508"></a><span class='hs-comment'>-- Someone else has read lock, there is no pending write lock, wait</span>
<a name="line-509"></a><span class='hs-comment'>-- Someone else has read lock, there is a pending write lock, wait</span>
<a name="line-510"></a>
<a name="line-511"></a><a name="acquireWrite"></a><span class='hs-comment'>-- | Any thread may call acquireWrite (even ones holding read locks, but see below for interrupted</span>
<a name="line-512"></a><span class='hs-comment'>-- behavior). This write lock may be acquired multiple times, requiring an identical number of</span>
<a name="line-513"></a><span class='hs-comment'>-- releaseWrite calls.</span>
<a name="line-514"></a><span class='hs-comment'>--</span>
<a name="line-515"></a><span class='hs-comment'>-- All previous calls to acquireRead by other threads will have succeeded and been released (or</span>
<a name="line-516"></a><span class='hs-comment'>-- interrupted) before this acquireWrite will return.</span>
<a name="line-517"></a><span class='hs-comment'>--</span>
<a name="line-518"></a><span class='hs-comment'>-- The best way to use acquireWrite is to use withWrite instead to ensure releaseWrite will be</span>
<a name="line-519"></a><span class='hs-comment'>-- called exactly once.</span>
<a name="line-520"></a><span class='hs-comment'>--</span>
<a name="line-521"></a><span class='hs-comment'>-- This may block and usually be safely interrupted. If interrupted then the RWLock will be left</span>
<a name="line-522"></a><span class='hs-comment'>-- unchanged. The exception to being able to interrupted when this blocks is very subtle: if this</span>
<a name="line-523"></a><span class='hs-comment'>-- thread holds read locks and calls acquireWrite then it will release those read locks and go to</span>
<a name="line-524"></a><span class='hs-comment'>-- the back of the queue to acquire the write lock (it does not get to skip the queue). While</span>
<a name="line-525"></a><span class='hs-comment'>-- blocking waiting for the write lock to be available this thread may be interrupted. If not</span>
<a name="line-526"></a><span class='hs-comment'>-- interrupted then the write lock will eventually be acquired, followed by re-acquiring the</span>
<a name="line-527"></a><span class='hs-comment'>-- original number of read locks. But if acquireWrite is interrupted after releasing read locks</span>
<a name="line-528"></a><span class='hs-comment'>-- then it MUST restore those read locks on the way out. To do this the internal error handler will</span>
<a name="line-529"></a><span class='hs-comment'>-- use 'uninterruptibleMask_' and a special version of acquireRead that skips to the front of the</span>
<a name="line-530"></a><span class='hs-comment'>-- queue; when the current lock state is a reader this works instantly but when the current lock</span>
<a name="line-531"></a><span class='hs-comment'>-- state is a writer this thread will block in an UNINTERRUPTIBLE state until the current writer is</span>
<a name="line-532"></a><span class='hs-comment'>-- finished. Once this other writer is finished the error handler will obtain the read locks it</span>
<a name="line-533"></a><span class='hs-comment'>-- needs to allow the error propagation to continue.</span>
<a name="line-534"></a><span class='hs-definition'>acquireWrite</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RWLock</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
<a name="line-535"></a><span class='hs-definition'>acquireWrite</span> <span class='hs-varid'>rwl</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>RWL</span> <span class='hs-varid'>rwlVar</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mask_</span> <span class='hs-varop'>.</span> <span class='hs-varid'>join</span> <span class='hs-varop'>.</span> <span class='hs-varid'>modifyMVar</span> <span class='hs-varid'>rwlVar</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>rwd</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-536"></a> <span class='hs-varid'>me</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>myThreadId</span>
<a name="line-537"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>safeBlock</span> <span class='hs-varid'>mblock</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>takeMVar</span> <span class='hs-varid'>mblock</span><span class='hs-layout'>)</span> <span class='hs-varop'>`onException`</span> <span class='hs-layout'>(</span><span class='hs-varid'>releaseWrite'</span> <span class='hs-conid'>True</span> <span class='hs-varid'>me</span> <span class='hs-varid'>rwlVar</span><span class='hs-layout'>)</span>
<a name="line-538"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>rwd</span> <span class='hs-keyword'>of</span>
<a name="line-539"></a> <span class='hs-conid'>FreeLock</span> <span class='hs-keyglyph'>-></span>
<a name="line-540"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span> <span class='hs-conid'>Writer</span> <span class='hs-layout'>{</span> <span class='hs-varid'>writerID</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>me</span><span class='hs-layout'>,</span> <span class='hs-varid'>writerCount</span><span class='hs-keyglyph'>=</span><span class='hs-num'>1</span><span class='hs-layout'>,</span> <span class='hs-varid'>readerCount</span><span class='hs-keyglyph'>=</span><span class='hs-num'>0</span><span class='hs-layout'>,</span> <span class='hs-varid'>queue</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>Seq</span><span class='hs-varop'>.</span><span class='hs-varid'>empty</span> <span class='hs-layout'>}</span>
<a name="line-541"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span> <span class='hs-layout'>)</span>
<a name="line-542"></a>
<a name="line-543"></a> <span class='hs-varid'>w</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Writer</span> <span class='hs-layout'>{</span> <span class='hs-varid'>writerID</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>it</span><span class='hs-layout'>,</span> <span class='hs-varid'>writerCount</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>wc</span><span class='hs-layout'>,</span> <span class='hs-varid'>queue</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>q</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>it</span><span class='hs-varop'>==</span><span class='hs-varid'>me</span> <span class='hs-keyglyph'>-></span>
<a name="line-544"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span> <span class='hs-varid'>w</span> <span class='hs-layout'>{</span> <span class='hs-varid'>writerCount</span><span class='hs-keyglyph'>=</span><span class='hs-layout'>(</span><span class='hs-varid'>succ</span> <span class='hs-varid'>wc</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-545"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span> <span class='hs-layout'>)</span>
<a name="line-546"></a>
<a name="line-547"></a> <span class='hs-comment'>{-ditto-}</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-548"></a> <span class='hs-varid'>mblock</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newEmptyMVar</span>
<a name="line-549"></a> <span class='hs-varid'>q'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>evaluate</span> <span class='hs-varop'>$</span> <span class='hs-varid'>q</span> <span class='hs-varop'>|></span> <span class='hs-layout'>(</span><span class='hs-conid'>WriterKind</span> <span class='hs-varid'>me</span><span class='hs-layout'>,</span><span class='hs-varid'>mblock</span><span class='hs-layout'>)</span>
<a name="line-550"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span> <span class='hs-varid'>w</span> <span class='hs-layout'>{</span> <span class='hs-varid'>queue</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>q'</span> <span class='hs-layout'>}</span>
<a name="line-551"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>safeBlock</span> <span class='hs-varid'>mblock</span> <span class='hs-layout'>)</span>
<a name="line-552"></a>
<a name="line-553"></a> <span class='hs-conid'>Readers</span> <span class='hs-layout'>{</span> <span class='hs-varid'>readerCounts</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>rcs</span> <span class='hs-layout'>}</span> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>rc</span> <span class='hs-keyglyph'><-</span> <span class='hs-conid'>Map</span><span class='hs-varop'>.</span><span class='hs-varid'>lookup</span> <span class='hs-varid'>me</span> <span class='hs-varid'>rcs</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-554"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span> <span class='hs-varid'>rwd</span>
<a name="line-555"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>withoutReads</span> <span class='hs-varid'>rc</span> <span class='hs-layout'>(</span><span class='hs-varid'>acquireWrite</span> <span class='hs-varid'>rwl</span><span class='hs-layout'>)</span> <span class='hs-layout'>)</span>
<a name="line-556"></a>
<a name="line-557"></a> <span class='hs-varid'>r</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Readers</span> <span class='hs-layout'>{</span> <span class='hs-varid'>queueR</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>Nothing</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-558"></a> <span class='hs-varid'>mblock</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newEmptyMVar</span>
<a name="line-559"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>qr</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>me</span><span class='hs-layout'>,</span><span class='hs-varid'>mblock</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-conid'>Seq</span><span class='hs-varop'>.</span><span class='hs-varid'>empty</span><span class='hs-layout'>)</span>
<a name="line-560"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span> <span class='hs-varid'>r</span> <span class='hs-layout'>{</span> <span class='hs-varid'>queueR</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>qr</span> <span class='hs-layout'>}</span>
<a name="line-561"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>safeBlock</span> <span class='hs-varid'>mblock</span> <span class='hs-layout'>)</span>
<a name="line-562"></a>
<a name="line-563"></a> <span class='hs-varid'>r</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Readers</span> <span class='hs-layout'>{</span> <span class='hs-varid'>queueR</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>w</span><span class='hs-layout'>,</span><span class='hs-varid'>q</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-564"></a> <span class='hs-varid'>mblock</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newEmptyMVar</span>
<a name="line-565"></a> <span class='hs-varid'>q'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>evaluate</span> <span class='hs-varop'>$</span> <span class='hs-varid'>q</span> <span class='hs-varop'>|></span> <span class='hs-layout'>(</span><span class='hs-conid'>WriterKind</span> <span class='hs-varid'>me</span><span class='hs-layout'>,</span><span class='hs-varid'>mblock</span><span class='hs-layout'>)</span>
<a name="line-566"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span> <span class='hs-varid'>r</span> <span class='hs-layout'>{</span> <span class='hs-varid'>queueR</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>w</span><span class='hs-layout'>,</span><span class='hs-varid'>q'</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-567"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>safeBlock</span> <span class='hs-varid'>mblock</span> <span class='hs-layout'>)</span>
<a name="line-568"></a> <span class='hs-keyword'>where</span>
<a name="line-569"></a> <span class='hs-varid'>withoutReads</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Int</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-varid'>a</span>
<a name="line-570"></a> <span class='hs-varid'>withoutReads</span> <span class='hs-varid'>n</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldr</span> <span class='hs-layout'>(</span><span class='hs-varop'>.</span><span class='hs-layout'>)</span> <span class='hs-varid'>id</span> <span class='hs-layout'>(</span><span class='hs-varid'>replicate</span> <span class='hs-varid'>n</span> <span class='hs-varid'>withoutRead</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-varid'>x</span>
<a name="line-571"></a> <span class='hs-varid'>withoutRead</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>IO</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-varid'>a</span>
<a name="line-572"></a> <span class='hs-varid'>withoutRead</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>bracket_</span> <span class='hs-layout'>(</span><span class='hs-varid'>releaseRead</span> <span class='hs-varid'>rwl</span> <span class='hs-varop'>>>=</span> <span class='hs-varid'>either</span> <span class='hs-varid'>throw</span> <span class='hs-varid'>return</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>acquireReadPriority</span> <span class='hs-varid'>rwl</span><span class='hs-layout'>)</span>
<a name="line-573"></a>
<a name="line-574"></a><a name="imp"></a><span class='hs-comment'>-- format impossible error strings to include standard description prefix</span>
<a name="line-575"></a><span class='hs-definition'>imp</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Show</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>String</span>
<a name="line-576"></a><span class='hs-definition'>imp</span> <span class='hs-varid'>s</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"FairRWLock impossible error: "</span><span class='hs-varop'>++</span><span class='hs-varid'>s</span><span class='hs-varop'>++</span><span class='hs-str'>" : "</span><span class='hs-varop'>++</span><span class='hs-varid'>show</span> <span class='hs-varid'>x</span>
<a name="line-577"></a>
<a name="line-578"></a><span class='hs-comment'>{-
<a name="line-579"></a>
<a name="line-580"></a>subtle bug #1:
<a name="line-581"></a>
<a name="line-582"></a>When converting from a read lock holding rc > 0 read locks to also holding a write lock, I first wrote:
<a name="line-583"></a>
<a name="line-584"></a>replicateM_ rc (releaseRead rwl >>= either throw return)
<a name="line-585"></a>acquireWrite rwl
<a name="line-586"></a>replicateM_ rc (acquireRead rwl)
<a name="line-587"></a>
<a name="line-588"></a>Imagine there are rc copies of withRead wrapped around the above:
<a name="line-589"></a>withRead = liftA2 bracket_ acquireRead (releaseRead >=> either throw return)
<a name="line-590"></a>
<a name="line-591"></a>Then the acquireWrite blocks and gets interrupted.
<a name="line-592"></a>The releaseReads in the withRead will see a strange situation (not locked!) and call throw.
<a name="line-593"></a>
<a name="line-594"></a>What is the answer? reverse the bracket for the release/acquire? Hmm..
<a name="line-595"></a>
<a name="line-596"></a>-}</span>
</pre></body>
</html>
