关于并发性：Haskell中并发通道的严格评估技术


Strict evaluation techniques for concurrent channels in Haskell

我在玩弄haskell线程，我遇到了一个问题，就是如何通过一个通道来传递延迟评估的值。例如，使用n个工作线程和1个输出线程，工作线程将通信未计算的工作，而输出线程最终将为它们完成工作。

我已经在各种文档中阅读过这个问题，并看到了各种解决方案，但是我只找到了一个有效的解决方案，而其余的则没有。下面是一些代码，其中工作线程启动一些计算可能需要很长时间。我按降序启动线程，这样第一个线程将占用最长的时间，而后面的线程将提前完成。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
import Control.Concurrent (forkIO)
import Control.Concurrent.Chan   -- .Strict
import Control.Concurrent.MVar
import Control.Exception (finally, evaluate)
import Control.Monad (forM_)
import Control.Parallel.Strategies (using, rdeepseq)

main = (>>=) newChan $ (>>=) (newMVar []) . run

run :: Chan (Maybe String) -> MVar [MVar ()] -> IO ()
run logCh statVars = do
  logV <- spawn1 readWriteLoop
  say"START"
  forM_ [18,17..10] $ spawn . busyWork
  await
  writeChan logCh Nothing -- poison the logger
  takeMVar logV
  putStrLn"DONE"
  where
    say mesg = force mesg >>= writeChan logCh . Just

    force s = mapM evaluate s  -- works
--    force s = return $ s `using` rdeepseq  -- no difference
--    force s = return s -- no-op; try this with strict channel

    busyWork = say . show . sum . filter odd . enumFromTo 2 . embiggen
    embiggen i = i*i*i*i*i

    readWriteLoop = readChan logCh >>= writeReadLoop
    writeReadLoop Nothing = return ()
    writeReadLoop (Just mesg) = putStrLn mesg >> readWriteLoop

    spawn1 action = do
      v <- newEmptyMVar
      forkIO $ action `finally` putMVar v ()
      return v

    spawn action = do
      v <- spawn1 action
      modifyMVar statVars $ \vs -> return (v:vs, ())

    await = do
      vs <- modifyMVar statVars $ \vs -> return ([], vs)
      mapM_ takeMVar vs

使用大多数技术，结果按生成的顺序报告；即，首先是最长运行的计算。我将其解释为输出线程正在执行所有工作：

1
2
3
4
5
6
7
8
9
10
11
12
-- results in order spawned (longest-running first = broken)
START
892616806655
503999185040
274877906943
144162977343
72313663743
34464808608
15479341055
6484436675
2499999999
DONE

号

我想答案应该是严格的渠道，但他们不起作用。我理解字符串的whnf是不够的，因为这只会强制使用最外面的构造函数(字符串的第一个字符为nil或cons)。rdeepseq应该是完全评估的，但没有什么区别。我发现唯一有效的方法是在字符串中的所有字符上映射Control.Exception.evaluate :: a -> IO a。(参见代码中的force函数注释，了解几种不同的选项。)下面是Control.Exception.evaluate的结果：

1
2
3
4
5
6
7
8
9
10
11
12
-- results in order finished (shortest-running first = correct)
START
2499999999
6484436675
15479341055
34464808608
72313663743
144162977343
274877906943
503999185040
892616806655
DONE

那么，为什么不通过严格的渠道或rdeepseq来产生这个结果呢？还有其他技术吗？我是否误解了为什么第一个结果会被打破？

这里有两个问题。

第一次尝试(使用显式rnf)不起作用的原因是，通过使用return，您创建了一个thunk，在对其进行评估时对其进行完全评估，但thunk本身尚未进行评估。注意，评估类型为a -> IO a：返回IO中的值意味着evaluate可以强制排序：

1
2
return (error"foo")   >> return 1 == return 1
evaluate (error"foo") >> return 1 == error"foo"

结果是，此代码：

1
force s = evaluate $ s `using` rdeepseq

号

将起作用(与中一样，具有与mapM_ evaluate s相同的行为)。

使用严格通道的情况有点棘手，但我相信这是由于严格并发中的一个bug造成的。昂贵的计算实际上是在工作线程上运行的，但它对您没有太大帮助(您可以通过在字符串中隐藏一些异步异常并查看异常出现在哪个线程上来明确检查这一点)。

虫子是什么？让我们来看一下严格的writeChan的代码：

1
2
3
4
5
6
writeChan :: NFData a => Chan a -> a -> IO ()
writeChan (Chan _read write) val = do
  new_hole <- newEmptyMVar
  modifyMVar_ write $ \old_hole -> do
    putMVar old_hole $! ChItem val new_hole
    return new_hole

我们看到在评估thunk之前，modifyMVar_被调用在write上。操作顺序如下：

  • 输入writeChan。
  • 我们takeMVar write(阻止任何其他想要写入频道的人)
  • 我们评估了昂贵的雷电
  • 我们把昂贵的雷声放在频道上
  • 我们用了cx1〔11〕，把其他所有的线都解开了。

    • 对于evaluate变体，您不会看到这种行为，因为它们在获取锁之前执行评估。

    我将发送有关此问题的Don mail，看看他是否同意此行为属于次优行为。

    唐同意这种行为是次优的。我们正在开发一个补丁。

    相关讨论