Multithreading 使用TVar时，如何等待表单完成？

我正在编写一个函数，其中我使用

表单

处理一个列表，并将结果附加到

TVar

列表中：

import Control.Concurrent.STM
import Control.Concurrent.STM.TVar
import Control.Concurrent (forkIO)
import Control.Monad (forM_)

insert :: a -> [a] -> [a]
insert = (:) -- stub

my_func_c :: (a -> a) -> [a] -> IO [a]
my_func_c my_function arr = do

    res_var <- atomically $ newTVar ([]::[a])

    forkIO $ forM_ arr $ \x -> atomically $ do
        let y = id $! my_function x
        modifyTVar res_var (insert y)

    atomically $ readTVar res_var

import Control.Concurrent.STM
导入控制.Concurrent.STM.TVar
导入控制。并发（forkIO）
导入控制.Monad（表单)
插入：：a->[a]->[a]
insert=（：）--存根
my_func_c:：（a->a）->[a]->IO[a]
我的函数我的函数arr=do
res_var原子级$do
让y=id$！my_函数x
修改后的剩余价值（插入y）
原子$readTVar res_var

---

如果我使用

-threaded

编译它，结果总是空的。如何才能等待线程完成？我不能使用

MVar

或

Async

。我必须使用

TVar

或其他基于

TVar

的数据结构来解决此问题。惯用的解决方案是使用：

---

在引擎盖下，（所以

TMVar（）

~

TVar（可能（））

~

TVar Bool

）与，因此上述两种解决方案在操作上完全等效。

为什么在每个表单函数调用中都不需要

writeTVar finished True

？为什么它在

表单

之外？关键是，当您完全完成时，即在计算完所有结果后，您

writeTVar finished True

/

putTMVar finished

。请注意，如果在

表单

中，所有元素都在一个单独的线程中处理，那么这也会起作用（我假设您希望在真正的应用程序中这样做）

my_func_c :: (a -> a) -> [a] -> IO [a]
my_func_c my_function arr = do
    res_var <- atomically $ newTVar []
    finished <- atomically $ newEmptyTMVar

    forkIO $ do
        forM_ arr $ \x -> atomically $ do
            let y = id $! my_function x
            modifyTVar res_var (insert y)
        atomically $ putTMVar finished ()

    atomically $ takeTMVar finished >> readTVar res_var

my_func_c :: (a -> a) -> [a] -> IO [a]
my_func_c my_function arr = do
    res_var <- atomically $ newTVar []
    finished <- atomically $ newTVar False

    forkIO $ do
        forM_ arr $ \x -> atomically $ do
            let y = id $! my_function x
            modifyTVar res_var (insert y)
        atomically $ writeTVar finished True

    atomically $ waitTVar finished >> readTVar res_var

waitTVar :: TVar Bool -> STM ()
waitTVar tv = do
    finished <- readTVar tv
    unless finished retry