Reader-作者锁定 Haskell

Reader-Writer Lock in Haskell

我正在实现一个在内存中保存一些数据的网络应用程序。一些请求读取此数据进行处理,一些请求更新此数据。

在这种情况下,多个reader可以并发操作数据,但是写入者需要对内存中的数据进行独占访问。我想实现一个 reader-writer lock 来解决这个问题。我也想要公平性属性锁上的等待者是按照先进先出的顺序处理的,以避免读写饥饿。

Haskell 标准库似乎不提供此类功能。我发现 concurrency-extra 提供了此功能,但该库似乎无人维护(并在 LTS 3.22 之后从堆栈中删除)——我不清楚它的公平性属性。

我发现在标准 haskell 库和堆栈中没有 reader-writer lock 库有点令人惊讶 - reader-writer 模式不是在很多软件?还是 Haskell 中首选完全不同的(可能是无锁的)方法?

编辑:更准确地说是公平性属性,当一个写者被阻塞等待获取锁时,后续的读锁请求应该只有在writer 获取并释放写锁 - 类似于 MVar 的公平性 属性 - MVars have a FIFO property

reader-写锁很容易在 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 中的公平性(活性)。

我想可以在 MVars 之上实现一个类似的库,尽管那样会更复杂,尤其是如果我们想保证公平的话。

我很想避免使用 MVars 而是使用信号量,而是使用 QSem,这保证了 FIFO 语义。使用这些,可以在 Dijkstra 风格中实现 readers/writers。

确实concurrent-extradoesn't provide fairness.

正如 chi 所写,STM 中无法保证公平。但是我们可以在 IO 中使用 STM。想法是在chi的LockState中添加其他状态,表明reader无法获取锁:

data LockState = Writing | Reading Int | Waiting

那么writer应该先设置state为Waiting,然后等待所有reader释放锁。请注意,等待应在单独的 STM 事务中执行,这就是为什么我们不能保证 STM.

中的公平性

Here 是一个示例实现:它不在 Hackage 上,但您可以出售它(它是 BSD 许可的。)

实施已优化,可最大限度地减少唤醒。对于单个 TVar,当锁处于 Waiting 状态时,每个 reader 不必要的释放都会唤醒所有等待获取锁的 reader。所以我有两个 TVars,一个用于锁定状态,另一个用于 readers.

已添加:Here 是我与 IRC 用户 Cale 就读写锁实现的陷阱进行的有趣(且相当长)的讨论。

最佳解决方案取决于 readers/writers 关系,但我认为您可以仅使用 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 可以终止。

(stdout 输出和进入 FIFO 的处理顺序在此示例中不准确,但读取或结算的项目数显示真实顺序)