Question

我在Data.Concurrent中看到两个函数mergeio和nmergeio，但我找不到它们如何工作的任何示例。

之前有没有人使用这些？我希望我可以使用它们来获得像“parMapM”这样的函数。

Answer 1

import Control.Concurrent (mergeIO, nmergeIO)

main = do
  xs <- mergeIO (map (*2) [1..10])
                (map (+3) [100..110])
  print xs

  xs <- nmergeIO [ map (\x->x*x) [1..10]
                 , map (\x->x+x) [1..10]
                 ]
  print $ maximum xs

输出：

[2,4,103,6,104,8,105,10,106,12,107,14,108,16,109,18,110,20,111,112,113]
100

内部顺序可能会有所不同，具体取决于每个线程投放结果的速度。

写parMapM有点棘手，但结果很好：

import Control.Applicative
import Control.Concurrent
import Control.Concurrent.STM
import Control.Exception
import Control.Monad
import Data.Word
import System.IO

import qualified Data.ByteString as BS

main :: IO ()
main = do
  xs <- parMapM (reverse . show) $ replicate 4 (readFromNet 5)
  print xs

我们会从/dev/urandom读取一个代表：

readFromNet :: Int -> IO [Word8]
readFromNet n = do
  h <- openFile "/dev/urandom" ReadMode 
  let go :: Int -> IO [Word8]
      go 0 = return []
      go remaining = do s <- BS.head <$> BS.hGet h 1
                        ss <- go (remaining-1)
                        return (s:ss)
  go n

最后的血腥位：

parMapM :: (a -> b) -> [IO [a]] -> IO [b]
parMapM f as = do
  kids <- newMVar []
  answers <- atomically $ newTVar []
  forM_ as $ \ a ->
    do mvar <- newEmptyMVar
       curkids <- takeMVar kids
       putMVar kids (mvar:curkids)
       let ax = do xs <- a
                   atomically $ do sofar <- readTVar answers
                                   writeTVar answers (sofar ++ xs)
       forkIO (ax `finally` putMVar mvar ())
  waitForChildren kids
  atomically $ map f <$> readTVar answers
  where
    waitForChildren kids = do ks <- takeMVar kids
                              case ks of
                                [] -> return ()
                                m:ms -> do
                                  putMVar kids ms
                                  takeMVar m
                                  waitForChildren kids

通过让孩子们将答案写到TVar，同时主线程等待孩子们表示他们的完成情况。

不幸的是，结果是“粗略的”，因为readFromNet不知道通信问题，所以我们一次从给定的线程中获取所有值。如果你不介意让他们弄脏手，你可以这样做，如下所示：

main :: IO ()
main = do
  let threads = 3
      nbytes  = 10
      total   = nbytes * threads
  byte <- newEmptyMVar
  let thr = forkIO $ readFromNetwork nbytes byte
      go 0 = return []
      go n = do b <- takeMVar byte
                bs <- go (n-1)
                return (b:bs)
  sequence_ $ replicate threads thr
  values <- map (reverse . show) <$> go total
  print values

然后工人看起来像

readFromNetwork :: Int -> MVar Word8 -> IO ()
readFromNetwork n var = do
  -- or something...
  h <- openFile "/dev/urandom" ReadMode 
  let go 0 = return ()
      go remaining = do s <- BS.hGet h 1
                        putMVar var (BS.head s)
                        go (remaining-1)
  go n

我如何使用Data.Concurrent.mergeIO？

1 个答案: