Question

我目前正在运行未知数量的工人，这些工人产生未知数量的结果，如果新结果比之前更好，则将其放入MVar并打印。这发生在下面显示的printMaxResult函数中。

main = do
    startTime <- getCurrentTime

    -- Read problem
    numbers <-  parseList
    target <-  parseTargetNumber
    -- Create mvar to communicate
    mvar <- newEmptyMVar

    -- Start solving the actual problem
    -- The solve methods will write their results
    -- into the given mvar
    forkIO $ SimpleAdd.solve (Problem target numbers) mvar
    forkIO $ IncrementDecrement.solve (Problem target numbers) mvar incOps decOps

    -- Read the first result and use it to go into the "main loop"
    expr <- takeMVar mvar
    debugPrintExpr expr startTime

    printMaxResult mvar expr startTime

    return ()

-- Extracts a new result from the given mvar and compares
-- it with the previous result. If the new result has a
-- better score it remembers it and prints it.
printMaxResult :: MVar Expr -> Expr ->  UTCTime -> IO ()
printMaxResult mvar expr startTime = do
    newExpr <- takeMVar mvar
    if score newExpr > score expr
        then do
            debugPrintExpr newExpr startTime
            printMaxResult mvar newExpr startTime
        else
            printMaxResult mvar expr startTime

问题是，一旦完成所有线程，程序就会崩溃并出现以下异常：main: thread blocked indefinitely in an MVar operation。当然这条消息是正确的：MVar无法随时收到一些新的输入。

但我怎样才能优雅地处理这种情况呢？我可以处理该异常并执行“exit（0）”操作。我试图理解异常处理在Haskell中是如何工作的，但我真的无法理解它。

Answer 1

这正是pipes-concurrency旨在解决的问题：它允许您编写避免死锁的并发代码。

就像你提到的那样，写这样的东西似乎是不可能的，因为没有办法静态地知道将来可能不会使用MVar。 pipes-concurrency解决这个问题的方法是它使用代码检测并发通道，该代码检测通道的输入或输出端何时被垃圾收集。这允许它通知通道的对端退出并避免触发死锁。

我建议你阅读pipes-concurrency tutorial，这是非常详细的。 Termination上的第三部分与您刚才描述的问题特别相关，它解释了pipes-concurrency如何在所有上游编写器完成后让侦听器终止。

pipes-concurrency教程假设pipes库的基本知识，因此，如果您不熟悉pipes，那么您可能还需要阅读official pipes tutorial。

Answer 2

穷人的协议是让你的MVar携带两种信息：一种是新候选人的通知（可能会或者可能不会比你目前为止看到的最好的候选人更好），以及另一个是通知你的一个线程完成了候选人。所以你的两个解决线程可能如下所示：

solve mvar = do
    -- do some complicated work and report some candidates
    replicateM_ 3000 $ putMVar mvar (Just 42)
    -- when you're done, say so
    putMVar mvar Nothing

，您的调试线程如下所示：

printMaxResult mvar expr 0 startTime = return ()
printMaxResult mvar expr numRunning startTime = do
    v <- mvar
    case v of
        Nothing -> printMaxResult mvar expr (numRunning-1) startTime
        Just newExpr | score newExpr > score expr -> ...
                     | otherwise                  -> ...

所有工人完成后，优雅地终止

2 个答案: