On Fri, Aug 20, 1999 at 15:34:51 +0200, George Russell wrote:
> Einar Karlson, my predecessor, asked for daemonic forking as for Java.  In
> Java you have ordinary threads and daemonic threads; the process ends when
> only daemonic threads are still running.  The GHC team seem to have gone
> ahead and made all forked thread daemonic!  So can we have ordinary threads
> back please?  Still, daemonic threads are nice, and I wonder whether we
> should really have two fork functions, since I can't right now think of a
> way of synthesising one from the other.

How about this one :-)

\begin{code}
import Concurrent( forkIO, MVar, newEmptyMVar, putMVar, readMVar, yield )

main :: IO ()
main = do
    t1 <- forkChild (forever $ putChar 'a')
    t2 <- forkChild (forever $ putChar 'b')
    waitForChilds [t1, t2]
  where
    forever :: IO a -> IO a
    forever p = p >> yield >> forever p
\end{code}

\begin{code}
forkChild :: IO () -> IO (MVar ())
forkChild p = do
    mvar <- newEmptyMVar
    forkIO (p >> putMVar mvar ())
    return mvar

waitForChilds :: [MVar ()] -> IO ()
waitForChilds []     = return ()
waitForChilds (p:ps) = readMVar p >> waitForChilds ps
\end{code}



Cheers,
Michael
-- 
W*ndoze NT is faster...                                 CRASHING!

Reply via email to