使用MVars在Haskell中实现事件流

时间:2014-02-27 18:37:08

标签: javascript haskell concurrency

我想将以下JavaScript代码移植到Haskell:http://jsfiddle.net/mz68R/

这就是我的尝试:

import Control.Concurrent
import Data.IORef

type EventStream a = IORef [MVar a]

newEventStream :: IO (EventStream a)
newEventStream = newIORef []

setEvent :: EventStream a -> a -> IO ()
setEvent stream event = readIORef stream >>= mapM_ (`putMVar` event)

getEvent :: EventStream a -> (a -> IO b) -> IO ThreadId
getEvent stream listener = do
    event <- newEmptyMVar
    modifyIORef stream (++ [event])
    forkIO $ loop (takeMVar event >>= listener)

loop :: Monad m => m a -> m ()
loop a = a >> loop a

main = do
    fib <- newEventStream
    getEvent fib $ \(a, b) -> do
        print (a, b)
        setEvent fib (b, a + b)
    setEvent fib (0,1)

它部分按预期工作:它不会产生无限的Fibonacci数列表。它打印出不同数量的斐波那契数字:

aaditmshah@home:~$ runhaskell EventStream.hs
(0,1)
(1,1)
aaditmshah@home:~$ runhaskell EventStream.hs
(0,1)
(1,1)
(1,2)
(2,3)
(3,5)
aaditmshah@home:~$ runhaskell EventStream.hs
(0,1)
(1,1)
(1,2)
(2,3)
(3,5)
(5,8)
(8,13)
(13,21)
(21,34)
(34,55)
(55,89)
(89,144)
(144,233)
(233,377)
(377,610)
(610,987)
(987,1597)
(1597,2584)
(2584,4181)
(4181,6765)
(6765,10946)

我认为这个问题是由getEvent函数中的并发性引起的,但我不能指责它。如何重构代码以缓解此问题?

2 个答案:

答案 0 :(得分:5)

当您运行Haskell程序时,它会在主线程退出后立即退出。你有一些竞争条件:getEvent的子线程试图在进程退出之前完成尽可能多的工作。

一个简单的解决方法是添加import Control.Monad (forever)的导入行,然后在main的末尾运行:

forever $ threadDelay maxBound

这将导致主线程永远睡眠。更好的方法取决于实际应用的目的。

答案 1 :(得分:3)

替代迈克尔的答案,你可以使用async库,它体现了许多很好的并发模式。特别是我们有功能

async :: IO a -> IO (Async a)

在另一个线程中运行输入IO操作并立即返回Async - 包装的返回值。显然我们不能得到a,直到我们等待子进程完成足够长的时间,但是立即返回让我们在子进程的诞生和我们等待完成之间做了一些事情

-- | "Work".
work :: Int -> IO ()
work n = threadDelay (n * 10000)

do ret <- async $ do work 100 -- do some "work"
                     return True
   putStrLn "Not waiting on the child process yet; doing other work"
   work 5
   putStrLn "Now we wait"
   _ <- wait ret

这里的要点是你可以使用async启动主线程中的所有子线程,然后让它等待所有返回值,然后才允许它终止。

在你的情况下,你的孩子永远不会回来,所以这意味着主线程将会快乐地停止,直到你的程序被中断。