並行Haskell。限制生產者的速度

Question

在Haskell的並行和並發編程中，Simon Marlow基於以下數據提供了一個Stream a ，以及一些生產者和消費者：

data IList a
  = Nil
  | Cons a (IVar (IList a))

type Stream a = IVar (IList a)

streamFromList :: NFData a => [a] -> Par (Stream a)
streamFromList xs = do
      var <- new
      fork $ loop xs var
      return var
    where
      loop [] var = put var Nil
      loop (x:xs) var = do
        tail <- new
        put var (Cons x tail)
        loop xs tail

后來，他提到了這種方法的缺點並提出了一個解決方案：

在我們之前的例子中，消費者比生產者更快。 相反，如果生產者比消費者更快，那么就沒有什么可以阻止生產者在消費者面前走很長的路並在內存中建立一個長的IList鏈。 這是不可取的，因為大型堆數據結構由於垃圾收集而產生開銷，因此我們可能希望對生產者進行速率限制以避免它過早地進行。 有一個技巧可以為流API添加一些自動速率限制。 它需要在IList類型中添加另一個構造函數：

 data IList a = Nil | Cons a (IVar (IList a)) | Fork (Par ()) (IList a) 

但是，他沒有完成這種方法：

我將把這個想法的其余部分作為練習讓你自己嘗試。 看看是否可以修改streamFromList ， streamFold和streamMap以合並Fork構造函數。 塊大小和fork距離應該是生成器的參數（ streamFromList和streamMap ）。

郵件列表上也提出了同樣的問題，但沒有人給出答案。

那么如何限制生產者的利率呢？

Answer 1

重要的部分在於loop功能：

  loop [] var = put var Nil
  loop (x:xs) var = do
    tail <- new
    put var (Cons x tail)
    loop xs tail

我們需要將fork距離f和塊大小c為參數：

  loop _ _ [] var = put var Nil
  loop 0 c (x:xs) var = -- see below
  loop f c (x:xs) var = do
    tail <- new
    put var (Cons x tail)
    loop (f-1) c xs tail

叉距在每次迭代中都會減少。 當前叉距離為零時我們需要做什么？ 我們提供了一個Fork op t ，其中op繼續生成列表：

  loop 0 c (x:xs) var = do
    tail <- new
    let op = loop c xs tail
    put var (Fork op (Cons x tail))

請注意，如果列表為空，我們不使用Fork 。 這是可能的，但有點傻，畢竟，沒有任何東西可以留下來。 現在更改streamFromList很簡單：

streamFromList :: NFData a => Int -> Int -> [a] -> Par (Stream a)
streamFromList f c xs = do
  var <- new                            
  fork $ loop f c xs var                 
  return var 

現在，為了使用它，我們需要在streamFold更改case ：

streamFold :: (a -> b -> a) -> a -> Stream b -> Par a
streamFold fn acc instrm = acc `seq` do
  ilst <- get instrm
  case ilst of
    Cons h t          -> streamFold fn (fn acc h) t
    Fork p (Cons h t) -> -- see below
    _                 -> return acc

請記住，我們在streamFromList不允許在Fork中使用空列表，但以防萬一我們通過通配符匹配它（和Nil ）。

如果遇到帶數據的Fork ，我們需要做什么？ 首先，我們需要使用fork來運行Par ()操作以傳播t ，然后我們就可以開始使用它了。 我們的最后一個案例是

    Fork p (Cons h t) -> fork p >> streamFold fn (fn acc h) t

streamMap是類似的。 只有在這種情況下，您才能在循環中再次使用其他參數，就像在streamFromList 。

Answer 2

我認為以下是一個有效的實現。

{-# LANGUAGE BangPatterns #-}

import Control.Monad.Par (IVar, Par, fork, get, new, put, put_, runPar)
import Control.DeepSeq   (NFData, rnf)

data IList a
  = Nil
  | Cons a (IVar (IList a))
  | Fork (Par ()) (IVar (IList a))

instance NFData a => NFData (IList a) where
  rnf Nil = ()
  rnf (Cons a b) = rnf a `seq` rnf b
  rnf (Fork a b) = rnf (runPar a) `seq` rnf b

type Stream a = IVar (IList a)

main :: IO ()
main = print $ sum (pipeline [1 .. 10000])

pipeline :: [Int] -> [Int]
pipeline list = runPar $ do
  strm <- streamFromList list 100 200
  xs   <- streamFold (\x y -> (y : x)) [] strm
  return (reverse xs)

streamFromList :: NFData a => [a] -> Int -> Int -> Par (Stream a)
streamFromList xs k n = do
    var <- new
    fork $ loop xs var k
    return var
  where
    loop [] var _ = put var Nil
    loop xs var 0 = do
      var' <- new
      put_ var (Fork (loop xs var' n) var')
    loop (x:xs) var i = do
      tail <- new
      put var (Cons x tail)
      loop xs tail (i - 1)

streamFold :: (a -> b -> a) -> a -> Stream b -> Par a
streamFold fn !acc strm = do
  ilst <- get strm
  case ilst of
    Nil      -> return acc
    Cons h t -> streamFold fn (fn acc h) t
    Fork p s -> fork p >> streamFold fn acc s

這里， streamFromList （生產者）值為流，而streamFold並行使用它們。 在第一個k值之后， streamFromList將一個Fork放入流中。 此Fork包含用於生成下一個n值的計算，以及可以從中消耗這些值的流。

在這一點上，如果消費者落后於生產者，他們就有機會迎頭趕上。 到達Fork ，它fork包含的生產者進行fork 。 同樣，生產者和消費者都可以並行進行，直到生產者在另一個n值之后，向流中添加另一個Fork並重復循環。