Haskell快速并发队列

时间:2015-01-14 00:23:35

标签: haskell concurrency profiling stm haskell-pipes

问题

您好!我正在编写一个日志库,我很乐意创建一个在单独的线程中运行的记录器,而所有应用程序线程都只是向它发送消息。我想为这个问题找到性能最佳的解决方案。我在这里需要简单的unboud队列。

途径

我已经创建了一些测试来查看可用解决方案的执行情况,我在这里得到了非常奇怪的结果。我根据以下内容测试了4个实现(下面提供的源代码):

  1. pipes-concurrency
  2. Control.Concurrent.Chan
  3. Control.Concurrent.Chan.Unagi
  4. MVar based as described in the book "Parallel and Concurrent Programming in Haskell"请注意,此技术为我们提供了容量为1的有限队列 - 它仅用于测试
  5. 测试

    以下是用于测试的源代码:

    {-# LANGUAGE NoMonomorphismRestriction #-}
    
    import Control.Concurrent (threadDelay)
    import Control.Monad (forever)
    import Pipes
    import qualified Pipes.Concurrent as Pipes
    import Control.Applicative
    import Control.Monad (replicateM_)
    import System.Environment (getArgs)
    
    import Control.Concurrent.Chan
    import Control.Concurrent (forkIO)
    import qualified Control.Concurrent.Chan.Unagi as U
    import Control.Concurrent.MVar
    import Criterion.Main
    
    data Event = Msg String | Status | Quit deriving (Show)
    
    ----------------------------------------------------------------------
    -- Pipes
    ----------------------------------------------------------------------
    
    pipesLogMsg = yield (Msg "hello")
    pipesManyLogs num = replicateM_ num pipesLogMsg
    
    pipesAddProducer num o = Pipes.forkIO $ do runEffect $ (pipesManyLogs num) >-> Pipes.toOutput o
                                               Pipes.performGC
    
    pipesHandler max = loop 0
      where
        loop mnum = do
            if mnum == max
                then lift $ pure ()
                else do event <- await
                        case event of
                            Msg _  -> loop (mnum + 1)
                            Status -> (lift $ putStrLn (show mnum)) *> loop mnum
                            Quit   -> return ()
    
    ----------------------------------------------------------------------
    -- Chan
    ----------------------------------------------------------------------
    
    chanAddProducer num ch = forkIO $ chanManyLogs num ch
    chanManyLogs num ch = replicateM_ num (writeChan ch (Msg "hello"))
    chanHandler ch max = handlerIO (readChan ch) max
    
    ----------------------------------------------------------------------
    -- Unagi-Chan
    ----------------------------------------------------------------------
    
    uchanAddProducer num ch = forkIO $ uchanManyLogs num ch
    uchanManyLogs num ch = replicateM_ num (U.writeChan ch (Msg "hello"))
    uchanHandler ch max = handlerIO (U.readChan ch) max
    
    ----------------------------------------------------------------------
    -- MVars
    ----------------------------------------------------------------------
    
    mvarAddProducer num m = forkIO $ mvarManyLogs num m
    mvarManyLogs num m = replicateM_ num (putMVar m (Msg "hello"))
    mvarHandler m max = handlerIO (takeMVar m) max
    
    ----------------------------------------------------------------------
    -- Utils
    ----------------------------------------------------------------------
    
    handlerIO f max = loop 0 where
        loop mnum = do
            if mnum == max 
                then pure ()
                else do event <- f
                        case event of
                             Msg _  -> loop (mnum + 1)
                             Status -> putStrLn (show mnum) *> loop mnum
                             Quit   -> return ()
    
    ----------------------------------------------------------------------
    -- Main
    ----------------------------------------------------------------------
    
    main = defaultMain [
          bench "pipes" $ nfIO $ do
            (output, input) <- Pipes.spawn Pipes.Unbounded
            replicateM_ prodNum (pipesAddProducer msgNum output)
            runEffect $ Pipes.fromInput input >-> pipesHandler totalMsg
        , bench "Chan" $ nfIO $ do
            ch <- newChan
            replicateM_ prodNum (chanAddProducer msgNum ch)
            chanHandler ch totalMsg
        , bench "Unagi-Chan" $ nfIO $ do
            (inCh, outCh) <- U.newChan
            replicateM_ prodNum (uchanAddProducer msgNum inCh)
            uchanHandler outCh totalMsg
        , bench "MVar" $ nfIO $ do
            m <- newEmptyMVar
            replicateM_ prodNum (mvarAddProducer msgNum m)
            mvarHandler m totalMsg
        ]
      where
        prodNum  = 20
        msgNum   = 1000
        totalMsg = msgNum * prodNum
    

    您可以使用ghc -O2 Main.hs进行编译,然后运行它。 测试创建了20个消息生成器,每个消息生成器生成1000000条消息。

    结果

    benchmarking pipes
    time                 46.68 ms   (46.19 ms .. 47.31 ms)
                         0.999 R²   (0.999 R² .. 1.000 R²)
    mean                 47.59 ms   (47.20 ms .. 47.95 ms)
    std dev              708.3 μs   (558.4 μs .. 906.1 μs)
    
    benchmarking Chan
    time                 4.252 ms   (4.171 ms .. 4.351 ms)
                         0.995 R²   (0.991 R² .. 0.998 R²)
    mean                 4.233 ms   (4.154 ms .. 4.314 ms)
    std dev              244.8 μs   (186.3 μs .. 333.5 μs)
    variance introduced by outliers: 35% (moderately inflated)
    
    benchmarking Unagi-Chan
    time                 1.209 ms   (1.198 ms .. 1.224 ms)
                         0.996 R²   (0.993 R² .. 0.999 R²)
    mean                 1.267 ms   (1.244 ms .. 1.308 ms)
    std dev              102.4 μs   (61.70 μs .. 169.3 μs)
    variance introduced by outliers: 62% (severely inflated)
    
    benchmarking MVar
    time                 1.746 ms   (1.714 ms .. 1.774 ms)
                         0.997 R²   (0.995 R² .. 0.998 R²)
    mean                 1.716 ms   (1.694 ms .. 1.739 ms)
    std dev              73.99 μs   (65.32 μs .. 85.48 μs)
    variance introduced by outliers: 29% (moderately inflated)
    

    问题

    我很想问你为什么管道并发版本执行得如此之慢以及为什么它比基于chan的速度慢得多。我非常惊讶,MVar是所有版本中速度最快的 - 有人可以说更多,为什么我们得到这个结果,我们能不能做得更好?

2 个答案:

答案 0 :(得分:17)

所以我可以给你一些关于ChanTQueuepipes-concurrency在这里内部使用)的分析的一些概述,这些分析推动了{{{{ 1}}。我不确定它是否会回答你的问题。我建议在进行基准测试时分叉不同的队列并玩各种变化,以便真正了解正在发生的事情。

unagi-chan看起来像:

Chan

它是data Chan a = Chan (MVar (Stream a)) -- pointer to "head", where we read from (MVar (Stream a)) -- pointer to "tail", where values written to type Stream a = MVar (ChItem a) data ChItem a = ChItem a (Stream a) 的链接列表。 MVar类型中的两个MVar分别作为指向列表当前头尾的指针。这就是写的样子:

Chan

在1处,写入者在写入端锁定,在2处,我们的项目writeChan :: Chan a -> a -> IO () writeChan (Chan _ writeVar) val = do new_hole <- newEmptyMVar mask_ $ do old_hole <- takeMVar writeVar -- [1] putMVar old_hole (ChItem val new_hole) -- [2] putMVar writeVar new_hole -- [3] 可供读者使用,而在3处,写入端被解锁为其他编写者。

这实际上在单一消费者/单一生产者场景中表现相当不错(参见the graph here),因为读写不会发生争执。但是,一旦你有多个并发作家,你就会遇到麻烦:

  • 当另一位作家在2时击中1的作家将阻止并被取消安排(我能够测量上下文切换的最快速度是~150ns(相当快);可能有情况它慢得多的地方)。所以当你让许多作家竞争时 您基本上是通过调度程序进行大型往返,进入a的等待队列,然后最终写入完成。

  • 当作家在2时被取消安排(因为它超时)时,它会保持锁定状态,并且不允许任何写入完成,直到它可以重新安排为止;当我们超额订阅时,即当我们的线程/核心比率很高时,这就变成了一个问题。

最后,使用MVar - 每个项目需要在分配方面有一些开销,更重要的是,当我们积累许多可变对象时,我们可能会导致很多GC压力。

TQUEUE

MVar非常棒,因为TQueue可以简单地推断其正确性。它是一个功能性的队列式队列,STM包括简单地读取编写器堆栈,使用我们的元素并将其写回:

write

如果在data TQueue a = TQueue (TVar [a]) (TVar [a]) writeTQueue :: TQueue a -> a -> STM () writeTQueue (TQueue _ write) a = do listend <- readTVar write -- a transaction with a consistent writeTVar write (a:listend) -- view of memory 将其新堆栈写回之后,另一个交错写入执行相同操作,则将重试其中一个写入。随着更多writeTQueue被交错,争用的影响变得更加严重。然而,性能降低的速度比writeTQueue慢得多,因为只有一个Chan操作可以使竞争writeTVar无效,并且事务非常小(只是读取和{{{} 1}})。

阅读通过&#34; dequeuing&#34;来自写入侧的堆栈,将其反转,并将反向堆栈存储在其自己的变量中,以便于&#34;弹出&#34; (总共这给了我们摊销O(1)推和弹)

writeTQueue

读者对作者有一个对称的温和争用问题。在一般情况下,读者和作者不会争辩,但是当读者堆栈耗尽时,读者正在与其他读者和作者竞争。我怀疑如果您预先加载了(:)有足够的值,然后启动了4个读者和4个编写器,您可能会导致活锁,因为反向努力在下一次写入之前完成。值得注意的是,与readTQueue :: TQueue a -> STM a readTQueue (TQueue read write) = do xs <- readTVar read case xs of (x:xs') -> do writeTVar read xs' return x [] -> do ys <- readTVar write case ys of [] -> retry _ -> case reverse ys of [] -> error "readTQueue" (z:zs) -> do writeTVar write [] writeTVar read zs return z 不同,对许多读者等待的TQueue的写入会同时唤醒它们(这可能或多或少有效,具体取决于场景)。

我怀疑你在测试中看不到MVar的许多弱点;主要是你看到了写争用的中等影响以及大量分配和GC大量可变对象的开销。

鳗鱼瓒

TVar首先设计用于处理争用。它在概念上非常简单,但实现有一些复杂性

TQueue

读取和写入队列的两侧共享unagi-chan,它们协调传递值(从编写器到读取器)和阻塞指示(从读取器到写入器),读取和写入端各自具有独立的原子计数器。写作如下:

  1. 编写器调用写计数器上的原子data ChanEnd a = ChanEnd AtomicCounter (IORef (Int , Stream a)) data Stream a = Stream (Array (Cell a)) (IORef (Maybe (Stream a))) data Cell a = Empty | Written a | Blocking (MVar a) 以接收与其(单个)读取器协调的唯一索引

  2. 作者找到其单元格并执行CAS Stream

  3. 如果成功退出,则会看到读者已击败它并阻止(或继续阻止),因此它会执行incrCounter并退出。

  4. 阅读以类似且明显的方式运作。

    第一个创新是使争用点成为在争用下不会降级的原子操作(如CAS /重试循环或类似Chan的锁)。基于简单的基准测试和实验,fetch-and-add primop, exposed by the atomic-primops library效果最佳。

    然后在2中,读者和作者只需要执行一次比较和交换(读者的快速路径是简单的非原子读取)来完成协调。

    因此,为了让Written a变好,我们

    • 使用fetch-and-add来处理争用点

    • 使用无锁技术,这样当我们超额订阅时,在不合适的时间进行计划的线程不会阻止其他线程的进度(被阻止的作者最多可能阻止读者&#34;分配& #34;由计数器提供给它;请注意(\Blocking v)-> putMVar v a)文档中的异常异常,并注意unagi-chan此处有更好的语义)

    • 使用数组来存储我们的元素,这些元素具有更好的局部性(但见下文),每个元素的开销更低,并且对GC的压力更小

    最后一点注意事项。使用数组:并发写入数组通常是一个不好的扩展思路,因为你会导致很多缓存一致性流量,因为缓存行在你的编写器线程中来回无效。一般术语是&#34;虚假共享&#34;。但是,我可以想到的替代设计也存在缓存方面的优势和缺点,这些设计可以划分写入或其他内容;我已经尝试过这一点,但目前还没有任何结论。

    我们合法地关注错误共享的一个地方是我们的计数器,我们对齐并填充到64字节;这确实出现在基准测试中,唯一的缺点是增加了内存使用量。

答案 1 :(得分:5)

如果我不得不猜测为什么pipes-concurrency执行得更差,那是因为每个读写都包含在STM事务中,而其他库使用更有效的低级并发原语。