使用TVar時如何等待M_完成？

Question

我正在編寫一個函數，我使用forM_處理列表，並將結果附加到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

如果我用-threaded編譯它，結果總是為空的。 怎么可能等待線程完成？ 我不能使用MVar或Async 。 我必須使用TVar或其他基於TVar數據結構來解決這個問題

Answer 1

慣用的解決方案是使用TMVar ：

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

但如果您真的只允許使用TVar ，您可以使用TVar Bool模擬TMVar () ：

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

在引擎蓋下， TMVar a只是一個TVar (Maybe a) （所以TMVar () ~ TVar (Maybe ()) ~ TVar Bool ）帶有takeTMVar做一個readTVar和retry ，所以上面兩個解決方案在操作上是完全等效的。