CODEWITHSUNDEEP
haskellparallel-processing
Marcus Riemer
Marcus Riemer

Reputation: 7728

Gracefully terminate once all workers are finished

I am currently running a unknown number of workers producing an unknown number of results which are put into an MVar and printed if the new result is better then the previous. This happens in the printMaxResult function shown below.

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

Problem is, that once all threads are finished the program crashes with the following exception: main: thread blocked indefinitely in an MVar operation. Of course that message is correct: There is no way that MVar will receive some new input anytime.

But how would I handle this condition gracefully? I would be fine with handling that exception and do "exit(0)" sort of operation. I tried to understand how exception handling works in Haskell but I cant really wrap my mind around it.

Upvotes: 0

Views: 116

Answers (2)

Daniel Wagner
Daniel Wagner

Reputation: 153212

The poor-man's protocol is to let your MVar carry two kinds of messages: one is notifications of new candidates (which may or may not be better than the best one you've seen so far), and the other is a notification that one of your threads is done producing candidates. So your two solving threads might look like this:

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

and your debugging thread looks like this:

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                  -> ...

Upvotes: 1

Gabriella Gonzalez
Gabriella Gonzalez

Reputation: 35099

This is exactly the sort of problem that pipes-concurrency was designed to solve: it lets you write concurrent code that avoids deadlocks.

Like you mentioned, it might seem impossible to write something like this, because there is no way to statically know that the MVar might not be used in the future. The way pipes-concurrency solves this problem is that it instruments concurrent channels with code that detects when either the input or output end of the channel is garbage collected. This allows it to notify the opposing end of the channel to quit and avoid triggering a deadlock.

I recommend that you read the pipes-concurrency tutorial, which is extraordinarily detailed. The third section on Termination is particularly relevant to the problem you just described and it explains how pipes-concurrency gets a listener to terminate when all the upstream writers are done.

The pipes-concurrency tutorial assumes basic knowledge of the pipes library, so if you are new to pipes then you may also want to read the official pipes tutorial.

Upvotes: 1

Related Questions