[commit: base] master: add forkFinally (40d1be1)

[Simon Marlow]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/base

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/40d1be115d2a5a409e9b747c347cd909a9607c42

>---------------------------------------------------------------

commit 40d1be115d2a5a409e9b747c347cd909a9607c42
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Thu Jun 7 16:10:47 2012 +0100

    add forkFinally
    
    This is a more robust version of "forkIO (m `finally` k)", because it
    closes a window between thread creation and the finally where the
    thread can receive an async exception.  Useful for layers over threads
    that need to catch threads dying with absolute certainty.
    
    forkFinally :: IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
    forkFinally action and_then =
      mask $ \restore ->
        forkIO $ try (restore action) >>= and_then

>---------------------------------------------------------------

 Control/Concurrent.hs |   27 +++++++++++++++++++++++----
 1 files changed, 23 insertions(+), 4 deletions(-)

diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs
index 770d9c3..1bac565 100644
--- a/Control/Concurrent.hs
+++ b/Control/Concurrent.hs
@@ -36,6 +36,7 @@ module Control.Concurrent (
 
         forkIO,
 #ifdef __GLASGOW_HASKELL__
+        forkFinally,
         forkIOWithUnmask,
         killThread,
         throwTo,
@@ -205,6 +206,25 @@ Using Hugs, all I\/O operations and foreign calls will block all other
 Haskell threads.
 -}
 
+-- | fork a thread and call the supplied function when the thread is about
+-- to terminate, with an exception or a returned value.  The function is
+-- called with asynchronous exceptions masked.
+--
+-- > forkFinally action and_then =
+-- >   mask $ \restore ->
+-- >     forkIO $ try (restore action) >>= and_then
+--
+-- This function is useful for informing the parent when a child
+-- terminates, for example.
+--
+forkFinally :: IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
+forkFinally action and_then =
+  mask $ \restore ->
+    forkIO $ try (restore action) >>= and_then
+
+-- -----------------------------------------------------------------------------
+-- Merging streams
+
 #ifndef __HUGS__
 max_buff_size :: Int
 max_buff_size = 1
@@ -598,11 +618,10 @@ foreign import ccall safe "fdReady"
 >   myForkIO :: IO () -> IO (MVar ())
 >   myForkIO io = do
 >     mvar <- newEmptyMVar
->     forkIO (io `finally` putMVar mvar ())
+>     forkFinally io (\_ -> putMVar mvar ())
 >     return mvar
 
-      Note that we use 'finally' from the
-      "Control.Exception" module to make sure that the
+      Note that we use 'forkFinally' to make sure that the
       'MVar' is written to even if the thread dies or
       is killed for some reason.
 
@@ -627,7 +646,7 @@ foreign import ccall safe "fdReady"
 >        mvar <- newEmptyMVar
 >        childs <- takeMVar children
 >        putMVar children (mvar:childs)
->        forkIO (io `finally` putMVar mvar ())
+>        forkFinally io (\_ -> putMVar mvar ())
 >
 >     main =
 >       later waitForChildren $