我正在实现一个在内存中保存一些数据的网络应用程序。一些请求读取此数据进行处理，一些请求更新此数据。
在这种情况下，多个读取器可以同时对数据进行操作，但写入器需要独占访问内存中的数据。我想实现一个读写锁来解决这个问题。我还希望以 FIFO 顺序处理锁上的服务员以避免读取和写入饥饿的公平属性。
Haskell 标准库似乎没有提供这样的功能。我发现concurrency-extra提供了此功能，但该库似乎未维护（并在 LTS 3.22 之后从堆栈中删除） - 我不清楚它的公平性。
我发现在标准的 haskell 库和堆栈中没有读写器锁库有点令人惊讶——读写器模式在许多软件中不是很常见吗？或者在 Haskell 中是否有一种完全不同的（可能是无锁的）方法？
编辑：更准确地说，在公平属性上，当写入器被阻塞等待获取锁时，只有在写入器获取并释放写入锁之后才允许后续的读锁请求 - 类似于MVars 公平属性 - MVars 有一个 FIFO财产
读写锁很容易在 STM 之上实现。
data LockState = Writing | Reading Int
type Lock = TVar LockState
startReading :: Lock -> STM ()
startReading lock = do
s <- readTVar lock
case s of
Writing -> retry
Reading n -> writeTVar (Reading (succ n))
stopReading :: Lock -> STM ()
stopReading lock = do
s <- readTVar lock
case s of
Writing -> error "stopReading: lock in writing state?!"
Reading n -> writeTVar (Reading (pred n))
startWriting :: Lock -> STM ()
startWriting lock = do
s <- readTVar lock
case s of
Reading 0 -> writeTVar Writing
_ -> retry
stopWriting :: Lock -> STM ()
stopWriting lock = do
s <- readTVar lock
case s of
Writing -> writeTVar lock (Reading 0)
_ -> error "stopwriting: lock in non-writing state?!"
我对上述内容的主要担忧是 1）对我来说看起来有点矫枉过正，2）我们仍然无法保证 STM 中的公平性（活跃性）。
我想可以在 s 之上实现一个类似的库MVar，尽管这会更复杂，特别是如果我们想保证公平性。
我很想避免MVar使用 s 并改用信号量，而是使用QSem它来保证 FIFO 语义。使用这些，可以实现 Dijkstra 风格的读取器/写入器。
确实concurrent-extra 不提供公平。
正如chi所写，没有办法保证STM. 但是我们可以在IO使用STM. 这个想法是向 chi 中添加其他状态LockState，表明读取器无法获取锁：
data LockState = Writing | Reading Int | Waiting
然后 writer 应该首先将 state 设置为Waiting，然后等待所有 reader 释放锁。请注意，等待应该在单独的STM事务中执行，这就是为什么我们不能保证STM.
这是一个示例实现：它不在 Hackage 上，但您可以出售它（它是 BSD 许可的。）
该实现经过优化以最大限度地减少唤醒。使用 single TVar，当锁处于Waiting状态时，每个读取器不必要的释放都会唤醒所有等待获取锁的读取器。所以我有两个TVars，一个用于锁定状态，另一个用于读者数量。
补充：这是我与 IRC 用户Cale就读写锁实现的陷阱进行的有趣（且相当长）的讨论。
最好的解决方案取决于读者/作者的关系，但我认为你只能使用MVar.
让
import System.Clock
import Text.Printf
import Control.Monad
import Control.Concurrent
import Control.Concurrent.MVar
t__ :: Int -> String -> IO ()
t__ id msg = do
TimeSpec s n <- getTime Realtime
putStrLn $ printf "%3d.%-3d - %d %s" (s `mod` 1000) n id msg
reader :: MVar [Int] -> Int -> IO ()
reader mv id = do
t__ id $ "reader waiting"
xs <- readMVar mv
t__ id $ "reader working begin"
threadDelay (1 * 10^6)
t__ id $ "reader working ends, " ++ show (length xs) ++ " items"
writer :: MVar [Int] -> Int -> IO ()
writer mv id = do
t__ id $ "WRITER waiting"
xs <- takeMVar mv
t__ id $ "WRITER working begin"
threadDelay (3 * 10^6)
t__ id $ "WRITER working ends, " ++ show (1 + length xs) ++ " items"
putMVar mv (id: xs)
main = do
mv <- newMVar []
forM_ (take 10 $ zipWith (\f id -> forkIO (f mv id)) (cycle [reader, reader, reader, writer]) [1..]) $ \p -> do
threadDelay (10^5)
p
getLine
带输出
c:\tmp>mvar.exe +RTS -N20
486.306991300 - 1 reader waiting
486.306991300 - 1 reader working begin
486.416036100 - 2 reader waiting
486.416036100 - 2 reader working begin
486.525191000 - 3 reader waiting
486.525191000 - 3 reader working begin
486.634286500 - 4 WRITER waiting
486.634286500 - 4 WRITER working begin
486.743378400 - 5 reader waiting
486.852406800 - 6 reader waiting
486.961564300 - 7 reader waiting
487.070645900 - 8 WRITER waiting
487.179673900 - 9 reader waiting
487.288845100 - 10 reader waiting
487.320003300 - 1 reader working ends, 0 items
487.429028600 - 2 reader working ends, 0 items
487.538202000 - 3 reader working ends, 0 items
489.642147400 - 10 reader working begin
489.642147400 - 4 WRITER working ends, 1 items
489.642147400 - 5 reader working begin
489.642147400 - 6 reader working begin
489.642147400 - 7 reader working begin
489.642147400 - 8 WRITER working begin
489.642147400 - 9 reader working begin
490.655157400 - 10 reader working ends, 1 items
490.670730800 - 6 reader working ends, 1 items
490.670730800 - 7 reader working ends, 1 items
490.670730800 - 9 reader working ends, 1 items
490.686247400 - 5 reader working ends, 1 items
492.681178800 - 8 WRITER working ends, 2 items
阅读器 1、2 和 3 同时运行，当下4 WRITER working begin一个请求等待它时，1、2 和 3 可以终止。
（此示例中标准输出输出和进入 FIFO 的处理顺序不准确，但读取或结算的项目数显示真实顺序）