[project @ 2005-02-01 11:52:08 by malcolm]

[ghc-base.git] / Control / Concurrent.hs

diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs
index 02f74fb..8df665e 100644 (file)
--- a/Control/Concurrent.hs
+++ b/Control/Concurrent.hs
@@ -226,11 +226,12 @@ real_handler ex =
   case ex of
        -- ignore thread GC and killThread exceptions:
        BlockedOnDeadMVar            -> return ()
+       BlockedIndefinitely          -> return ()
        AsyncException ThreadKilled  -> return ()
 
        -- report all others:
-       AsyncException StackOverflow -> reportStackOverflow False
-       other       -> reportError False other
+       AsyncException StackOverflow -> reportStackOverflow
+       other       -> reportError other
 
 #endif /* __GLASGOW_HASKELL__ */
 
@@ -477,8 +478,8 @@ runInUnboundThread action = do
 
 >   myForkIO :: IO () -> IO (MVar ())
 >   myForkIO io = do
->     mvar \<- newEmptyMVar
->     forkIO (io \`finally\` putMVar mvar ())
+>     mvar <- newEmptyMVar
+>     forkIO (io `finally` putMVar mvar ())
 >     return mvar
 
       Note that we use 'finally' from the
@@ -489,25 +490,26 @@ runInUnboundThread action = do
       A better method is to keep a global list of all child
       threads which we should wait for at the end of the program:
 
->     children :: MVar [MVar ()]
->     children = unsafePerformIO (newMVar [])
->     
->     waitForChildren :: IO ()
->     waitForChildren = do
->      (mvar:mvars) \<- takeMVar children
->      putMVar children mvars
->      takeMVar mvar
->      waitForChildren
->     
->     forkChild :: IO () -> IO ()
->     forkChild io = do
->       mvar \<- newEmptyMVar
->       forkIO (p \`finally\` putMVar mvar ())
->       childs \<- takeMVar children
->       putMVar children (mvar:childs)
->     
->     later = flip finally
->     
+>    children :: MVar [MVar ()]
+>    children = unsafePerformIO (newMVar [])
+>    
+>    waitForChildren :: IO ()
+>    waitForChildren = do
+>      cs <- takeMVar children
+>      case cs of
+>        []   -> return ()
+>        m:ms -> do
+>          putMVar children ms
+>          takeMVar m
+>          waitForChildren
+>    
+>    forkChild :: IO () -> IO ()
+>    forkChild io = do
+>       mvar <- newEmptyMVar
+>       childs <- takeMVar children
+>       putMVar children (mvar:childs)
+>       forkIO (io `finally` putMVar mvar ())
+>
 >     main =
 >      later waitForChildren $
 >      ...