multithreading - 如何等待多个 `MVar` s？

Question

我想要一个功能

takeAnyMVar :: NonEmpty (MVar a) -> IO (MVar a, a)

等待多个 MVar s 同时返回第一个 MVar (及其值(value))变得可用。

特别是，它应该只导致 MVar 中的一个。输入列表中的 s 处于空状态，之前不是空的。

我有一个实现，但它既低效又不正确:

import Data.List.NonEmpty          -- from semigroups
import Control.Concurrent.Async    -- from async
import Control.Concurrent.MVar
import Control.Applicative
import Data.Foldable

takeAnyMVar :: NonEmpty (MVar a) -> IO (MVar a, a)
takeAnyMVar = runConcurrently . foldr1 (<|>) . fmap (Concurrently . takeMVar')
    where
        takeMVar' mvar = takeMVar mvar >>= \val -> return (mvar, val)

这是低效的，因为它必须为每个 MVar 启动一个新线程在列表中。

这是不正确的，因为多个线程可能会占用它们的 MVar并将其保留为空状态，然后才能被 (<|>) 取消。运算符(最后调用 race)。其中一个将成功并返回其结果，其他将丢弃其结果但留下他们的 MVar是空的。

在 Windows 上，有 WaitForMultipleObjects函数，它允许等待多个等待句柄。我怀疑在其他操作系统中也有类似的东西。

鉴于 MVar可能是根据 OS 原语实现的，应该可以使用上述语义编写函数。但也许您需要访问 MVar 的实现为了做到这一点。

这同样适用于 Chan , QSem , MSem ，以及其他并发原语。

Answer 1

如果您的函数是唯一的使用者(并且只在一个线程中运行)，我想在 base-4.8 中您可以使用 readMVar 在线程中，只清空 TVar正在返回，保持其他人不受影响。

正如@DanielWagner 所建议的，STM会简单得多。

import qualified Data.Foldable as F
import Data.List.NonEmpty
import Control.Concurrent.STM.TMVar
import Control.Monad
import Control.Monad.STM

takeAnyMVar :: NonEmpty (TMVar a) -> STM (TMVar a, a)
takeAnyMVar = F.foldr1 orElse . fmap (\t -> liftM ((,) t) $ takeTMVar t)

这里我们简单地尝试 takeTMVar每一个，结合 orElse .如果全部为空， STM将足够聪明，可以等到其中一个变满，然后重新启动事务。