@@ -68,6 +68,12 @@ waitForOneChild chan pendingRef = do
6868 tid <- liftIO $ atomically $ readTChan chan
6969 liftIO $ modifyIORef pendingRef $ filter (\x -> threadId x /= tid)
7070
71+-- | kill all the child threads associated with the continuation context
72+killChildren :: EventF -> IO ()
73+killChildren ctx = do
74+ ths <- readIORef (pendingThreads ctx)
75+ mapM_ (killThread . threadId) ths
76+
7177-- XXX this is not a real semaphore as it does not really block on wait,
7278-- instead it returns whether the value is zero or non-zero.
7379--
@@ -120,8 +126,8 @@ forkIt current proc = do
120126
121127 updatePendingThreads :: MonadIO m => EventF -> EventF -> m ()
122128 updatePendingThreads cur child = do
123− -- update the new thread first so that if it exited already reclaim finds
124− -- it in the list and does not panic.
129+ -- update the new thread first so that if it exited already reclaim
130+ -- finds it in the list and does not panic.
125131 liftIO $ modifyIORef (pendingThreads cur) $ (\ts -> child:ts)
126132 tryReclaimZombies (zombieChannel cur) (pendingThreads cur)
127133
@@ -142,9 +148,8 @@ forkIt current proc = do
142148
143149 beforeExit cur res = do
144150 case res of
145− Left _exc -> -- kill all child threads
151+ Left _exc -> liftIO $ killChildren cur
146152 -- propagate the exception to the parent
147− return ()
148153 Right _ -> -- collect the results?
149154 return ()
150155
@@ -321,13 +326,6 @@ react setHandler iob = AsyncT $ do
321326 put cont{event=Nothing}
322327 return $ unsafeCoerce j
323328
324−-- Need to propagate the exception via kill exception handler
325−-- | kill all the child threads associated with the continuation context
326−killChildren :: IORef [EventF] -> IO ()
327−killChildren pendingRef = do
328− ths <- readIORef pendingRef
329− mapM_ (killThread . threadId) ths
330−
331329------------------------------------------------------------------------------
332330-- Controlling thread quota
333331------------------------------------------------------------------------------