From: simonmar Date: Mon, 22 Nov 2004 10:16:42 +0000 (+0000) Subject: [project @ 2004-11-22 10:16:42 by simonmar] X-Git-Tag: nhc98-1-18-release~179 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=54fa1fd59bf04ce922840a6a55d9704a2cab273e;p=ghc-base.git [project @ 2004-11-22 10:16:42 by simonmar] Fix example code --- diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs index f3e0082..e820d17 100644 --- a/Control/Concurrent.hs +++ b/Control/Concurrent.hs @@ -478,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 @@ -490,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 +> forkIO (io `finally` putMVar mvar ()) +> childs <- takeMVar children +> putMVar children (mvar:childs) +> > main = > later waitForChildren $ > ...