Изящно завершайся, когда все рабочие закончены

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. Конечно, это сообщение верное: MVA не получит какой-либо новый вход в любое время.

Но как бы я справился с этим состоянием изящно? Мне было бы хорошо справиться с этим исключением и выполнить операцию «exit (0)». Я попытался понять, как работает обработка исключений в Haskell, но я не могу обдумать ее.

Answer 1

Протокол бедного человека должен позволять вашим 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     -> ... 

Answer 2

Это именно та проблема, которую pipes-concurrency был разработан для решения: он позволяет писать параллельный код, который позволяет избежать взаимоблокировок.

Как вы уже упоминали, может показаться невозможным написать что-то подобное, потому что нет никакого способа статически знать, что MVar не может быть использован в будущем. Способ pipes-concurrency решает эту проблему, так это то, что он подключает параллельные каналы с кодом, который обнаруживает, что либо входной, либо выходной конец канала собирают мусор. Это позволяет ему уведомить противоположный конец канала о выходе и избежать срабатывания тупика.

Я рекомендую вам прочитать pipes-concurrency tutorial, который необычайно детализирован. Третий раздел на Termination особенно важен для проблемы, которую вы только что описали, и объясняет, как pipes-concurrency получает прослушиватель, чтобы прекратить работу, когда все вышеперечисленные авторы созданы.

pipes-concurrency учебник предполагает базовые знания pipes библиотеки, так что если вы новичок в pipes, то вы также можете прочитать official pipes tutorial.