X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Control%2FConcurrent.hs;h=3b7f784428e74c7dc88a4c9a33a3eefb7f4836bc;hb=1fa05e8e2f40273e8a7f7572220d21037284600b;hp=97be32145bfbca0a83aa0efe141d2e4a62fe52dc;hpb=7d090bf5e03ee22db47edfd73a0b542b32408704;p=haskell-directory.git

diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs
index 97be321..3b7f784 100644
--- a/Control/Concurrent.hs
+++ b/Control/Concurrent.hs
@@ -91,7 +91,8 @@ import Prelude
 import Control.Exception as Exception
 
 #ifdef __GLASGOW_HASKELL__
-import GHC.Conc
+import GHC.Conc		( ThreadId(..), myThreadId, killThread, yield,
+			  threadDelay, threadWaitRead, threadWaitWrite )
 import GHC.TopHandler   ( reportStackOverflow, reportError )
 import GHC.IOBase	( IO(..) )
 import GHC.IOBase	( unsafeInterleaveIO )
@@ -225,6 +226,7 @@ real_handler ex =
   case ex of
 	-- ignore thread GC and killThread exceptions:
 	BlockedOnDeadMVar            -> return ()
+	BlockedIndefinitely          -> return ()
 	AsyncException ThreadKilled  -> return ()
 
 	-- report all others:
@@ -476,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
@@ -488,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 $
 >     	...