Haskell计算密集型线程阻塞所有其他线程

Question

我想编写一个程序，其主线程派生一个新线程进行计算，并等待一段时间来完成。如果子线程在给定时间内没有完成，则将其超时并终止。我有以下代码。

import Control.Concurrent

fibs :: Int -> Int 
fibs 0 = 0
fibs 1 = 1
fibs n = fibs (n-1) + fibs (n-2)

main = do 
    mvar  <- newEmptyMVar 
    tid   <- forkIO $ do
        threadDelay (1 * 1000 * 1000)
        putMVar mvar Nothing 
    tid'  <- forkIO $ do
        if fibs 1234 == 100
            then putStrLn "Incorrect answer" >> putMVar mvar (Just False)
            else putStrLn "Maybe correct answer" >> putMVar mvar (Just True)
    putStrLn "Waiting for result or timeout"
    result <- takeMVar mvar
    killThread tid
    killThread tid' 

我用ghc -O2 Test.hs和ghc -O2 -threaded Test.hs编译了上面的程序并运行了它，但是在两种情况下，该程序只是挂起而没有打印任何内容或退出。如果我在threadDelay (2 * 1000 * 1000)块之前将if添加到计算线程中，则该程序将按预期工作，并在一秒钟后完成，因为计时器线程能够填充mvar。

为什么线程无法按预期工作？

Answer 1

GHC在并发实现中使用了协作式和抢占式多任务混合处理。

在Haskell级别上，这似乎是抢占式的，因为线程不需要显式地屈服，并且似乎可以随时被运行时中断。但是在运行时级别，线程只要分配内存就“屈服”。由于几乎所有Haskell线程都在不断分配，因此通常效果很好。

但是，如果可以将特定的计算优化为非分配代码，则它可能在运行时级别变得不合作，因此在Haskell级别不可抢占。正如@Carl所指出的，实际上是-fomit-yields标志，-fomit-yields所隐含的标志允许这种情况发生：

-O2

告诉GHC在不执行分配时省略堆检查。尽管这将二进制大小提高了5％左右，但这也意味着在紧密的非分配循环中运行的线程不会及时被抢占。如果始终能够中断此类线程很重要，则应关闭此优化。如果需要保证可中断性，请考虑在关闭此优化的情况下重新编译所有库。

显然，在单线程运行时（没有-fomit-yields标志），这意味着一个线程可以完全耗尽所有其他线程。不太明显的是，即使使用-threaded进行编译并使用-threaded选项，也会发生相同的情况。问题在于，不合作的线程可能会耗尽运行时scheduler本身。如果在某个时候，不合作的线程是当前计划运行的唯一线程，它将变得不可中断，并且即使它们可以在其他O / S线程上运行，也永远不会重新运行调度程序以考虑调度其他线程。

[如果您只是想测试某些东西，请将+RTS -N的签名更改为fib。由于fib :: Integer -> Integer会导致分配，因此一切都会重新开始（无论是否使用Integer）。

如果您在real代码中遇到此问题，到目前为止，最简单的解决方案是@Carl建议的解决方案：如果您需要保证线程的可中断性，则应使用-threaded进行编译，这样可以使调度程序调用保持在非分配代码中。根据文档，这会增加二进制大小；我认为它也会带来一点性能损失。

或者，如果计算已经在-fno-omit-yields中，则在优化循环中显式IO可能是一个好方法。对于纯计算，您可以将其转换为IO和yield，尽管通常可以找到一种简单的方法来再次引入分配。在最现实的情况下，将有一种方法仅引入“很少” yield或分配-足以使线程再次响应，但不足以严重影响性能。 （例如，如果您有一些嵌套的递归循环，请yield或在最外面的循环中强制分配。）