Ticket #6126: 0001-Fix-documentation-of-waiting-for-threads-in-Control..patch

File 0001-Fix-documentation-of-waiting-for-threads-in-Control..patch, 5.0 KB (added by basvandijk, 3 years ago)
  • Control/Concurrent.hs

    From bd2ac7926a3da267ff2f1799dab8655d519d77fb Mon Sep 17 00:00:00 2001
    From: Bas van Dijk <[email protected]>
    Date: Sun, 27 May 2012 11:49:51 +0200
    Subject: [PATCH] Fix documentation of waiting for threads in
     Control.Concurrent The previous documentation proposed a
     program that had the risk of dead-lock.
    
    ---
     Control/Concurrent.hs |  102 ++++++++++++++++++++++++++++++++-----------------
     1 file changed, 66 insertions(+), 36 deletions(-)
    
    diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs
    index 770d9c3..f2c6f2f 100644
    a b foreign import ccall safe "fdReady" 
    588588      time as the main thread (the terminology for this kind of
    589589      behaviour is \"daemonic threads\").
    590590
    591       If you want the program to wait for child threads to
     591      If you want the program to wait for a child thread to
    592592      finish before exiting, you need to program this yourself.  A
    593       simple mechanism is to have each child thread write to an
    594       'MVar' when it completes, and have the main
    595       thread wait on all the 'MVar's before
    596       exiting:
     593      simple mechanism is to have the child thread write to an
     594      'MVar' when it completes and let it return a computation
     595      that waits for (reads) the MVar. The main thread then has
     596      to execute the wait computation before exiting:
    597597
    598 >   myForkIO :: IO () -> IO (MVar ())
    599 >   myForkIO io = do
     598>   forkWait :: IO () -> IO (IO ())
     599>   forkWait io = do
    600600>     mvar <- newEmptyMVar
    601 >     forkIO (io `finally` putMVar mvar ())
    602 >     return mvar
    603 
    604       Note that we use 'finally' from the
    605       "Control.Exception" module to make sure that the
    606       'MVar' is written to even if the thread dies or
    607       is killed for some reason.
     601>     mask $ \restore -> do
     602>       _ <- forkIO $ do restore io `catch` ignore
     603>                        putMVar mvar ()
     604>       return $ readMVar mvar
     605>
     606>   ignore :: SomeException -> IO ()
     607>   ignore _ = return ()
     608
     609      Note that we 'mask' asynchronous exceptions before forking
     610      the new thread. This ensures we can always install an exception
     611      handler which will catch and ignore all exceptions.
     612      If we didn't use mask, an asynchronous exception could be thrown
     613      before we installed the exception handler causing the putMVar
     614      to not be executed and the returned readMVar computation
     615      to dead-lock.
     616
     617      Finally note that instead of 'readMVar' we could have used
     618      'takeMVar'. The latter, however, causes a dead-lock if the
     619      returned computation is executed twice.
     620
     621      The former could also be generalized to not just wait for the
     622      completion of a child thread but also return its final value
     623      (which could either be an exception or the value returned
     624      by the child thread):
     625
     626>   spawn :: IO a -> IO (IO a)
     627>   spawn io = do
     628>     mvar <- newEmptyMVar
     629>     mask $ \restore -> do
     630>       _ <- forkIO $ try (restore io) >>= putMVar mvar
     631>       return $ readMVar mvar >>= either throwSomeException return
     632>
     633>   throwSomeException :: SomeException -> IO a
     634>   throwSomeException = throwIO
    608635
    609       A better method is to keep a global list of all child
    610       threads which we should wait for at the end of the program:
     636      In order to wait for a group of threads to complete you can
     637      wait for a counter to reach 0. The counter counts the number
     638      of running threads and is incremented when a thread is forked
     639      and decremented when it completes:
    611640
    612 >    children :: MVar [MVar ()]
    613 >    children = unsafePerformIO (newMVar [])
     641>     newtype ThreadGroup = ThreadGroup (TVar Int)
    614642>   
    615 >    waitForChildren :: IO ()
    616 >    waitForChildren = do
    617 >      cs <- takeMVar children
    618 >      case cs of
    619 >        []   -> return ()
    620 >        m:ms -> do
    621 >           putMVar children ms
    622 >           takeMVar m
    623 >           waitForChildren
     643>     new :: IO ThreadGroup
     644>     new = ThreadGroup <$> newTVarIO 0
     645>
     646>     forkInGroup :: ThreadGroup -> IO () -> IO ThreadId
     647>     forkInGroup (ThreadGroup tvar) io =
     648>       mask $ \restore -> do
     649>         atomically $ modifyTVar tvar (+ 1)
     650>         forkIO $ do
     651>           restore io `catch` ignore
     652>           atomically $ modifyTVar tvar (subtract 1)
    624653>
    625 >    forkChild :: IO () -> IO ThreadId
    626 >    forkChild io = do
    627 >        mvar <- newEmptyMVar
    628 >        childs <- takeMVar children
    629 >        putMVar children (mvar:childs)
    630 >        forkIO (io `finally` putMVar mvar ())
     654>     modifyTVar :: TVar a -> (a -> a) -> STM ()
     655>     modifyTVar tvar f = do
     656>       x <- readTVar tvar
     657>       writeTVar tvar $! f x
    631658>
    632 >     main =
    633 >       later waitForChildren $
    634 >       ...
     659>     wait :: ThreadGroup -> IO ()
     660>     wait (ThreadGroup tvar) = atomically $ do
     661>       n <- readTVar tvar
     662>       when (n /= 0) retry
     663
     664      Of course, the previous approaches can be combined to suit your needs.
    635665
    636666      The main thread principle also applies to calls to Haskell from
    637667      outside, using @foreign export@.  When the @foreign export@ed