import Control.Monad import Control.Exception (throwIO) import Control.Concurrent.ThreadUtil import DebugUtil main = do mvars <- sequence $ replicate 200 $ newEmptyMVar threads <- forM mvars $ forkIO . join . takeMVar let (normalquits,mvars1) = splitAt 20 mvars mapM_ (`putMVar` return ()) normalquits let (exceptionquits,mvars2) = splitAt 20 mvars1 mapM_ (`putMVar` throwIO (userError "oops")) exceptionquits let (throwtoexceptions,threads1) = splitAt 20 $ drop 40 threads mapM_ (`throwTo` userError "throwTo-oops") throwtoexceptions let (killed,threads2) = splitAt 20 threads1 mapM_ killThread killed threadDelay 1000000 report <- threadReport True sequence_ $ zipWith (\n s -> putStrLn $ unwords [show n,s]) [1..] $ lines report return ()