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, 23 months ago)
  • Control/Concurrent.hs

    From bd2ac7926a3da267ff2f1799dab8655d519d77fb Mon Sep 17 00:00:00 2001
    From: Bas van Dijk <v.dijk.bas@gmail.com>
    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