如何强制主线程等待其所有子线程在 Haskell 中完成答案

【问题标题】：How to force main thread to wait for all its child threads finish in Haskell如何强制主线程等待其所有子线程在 Haskell 中完成
【发布时间】：2015-01-27 11:21:09
【问题描述】：

在下面的 Haskell 代码中，如何强制主线程等待其所有子线程完成。

我无法使用 forkFinally，如此链接中“终止程序”部分所述：(http://hackage.haskell.org/package/base-4.7.0.2/docs/Control-Concurrent.html)。

使用 TMVar 时，我得到了想要的结果。但我想用 TVar 做到这一点。请帮忙。

module Main
where
import Control.Monad
import Control.Concurrent
import Control.Concurrent.STM

type TInt = TVar Int

transTest :: TInt -> Int -> IO ()
transTest n t = do 
    atomically $ do 
        t1 <- readTVar n                    
        doSomeJob t
        t2 <- readTVar n
        writeTVar n t

doSomeJob :: Int -> STM ()
doSomeJob t = do
    x <- newTVar 0
    let l = 10^6*t
    forM_ [1..l] (\i -> do 
        writeTVar x i )            

main :: IO ()
main = do
    n <- newTVarIO 0

    let v = 5
    forkIO (transTest n v)

    let v = 3
    forkIO (transTest n v)

    let v = 7
    forkIO (transTest n v)

    let v = 1
    forkIO (transTest n v)  


    r <- atomically $ readTVar n
    putStrLn("Last updated value = " ++ (show r))

【问题讨论】：

使用具有wait 的Control.Concurrent.Thread 包。无法等待标准Control.Concurrent 线程。如果你想使用它们，你需要一个单独的信号机制，并且每个线程都需要明确报告“我完成了”。见hackage.haskell.org/package/concurrent-extra-0.3/docs/…
能否提供一些示例链接？谢谢。
这个问题在 2007 年的 Haskell Cafe 线程中讨论过，您还可以在那里找到一些示例代码：(link)
@n.m.看起来该模块由于某种原因在 v-0.5 中消失了。

标签： multithreading haskell

【解决方案1】：

我过去所做的是为每个分叉线程创建一个小 MVar，然后使用forkFinally 分叉线程，这样在最后，每个线程都会将一个虚拟值放入 MVar（即我使用MVar 作为同步原语）。然后我可以在这些 MVar 上调用 takeMVar 等待。

我把它包装成一个小辅助函数：

forkThread :: IO () -> IO (MVar ())
forkThread proc = do
    handle <- newEmptyMVar
    _ <- forkFinally proc (\_ -> putMVar handle ())
    return handle

使用它，您的代码可以更改为类似

-- Fork four threads
threads <- forM [5, 3, 7, 1] (\v -> forkThread (transTest n v))

-- Wait for all of them
mapM_ takeMVar threads

然而，那是在我阅读 Simon Marlow 的（最优秀的）书“Haskell 中的并行和并发编程”之前，这本书让我意识到了 async 包。这个包提供了一个抽象，它不仅处理所有这些事情，所以你可以只写

-- Runs 'transTest n {5,3,7,1}' in parallel and waits for all threads
_ <- mapConcurrently (transTest n) [5, 3, 7, 1]

...它还处理诸如（异步）异常之类的事情。

【讨论】：

非常感谢。它很简单，确实非常有用。