Sterling Clover wrote: > On Dec 27, 2008, at 9:02 AM, Bertram Felgenhauer wrote: >> In the above code, there is a small window between catching the >> ThreadKilled exception and throwing it again though, where other >> exceptions may creep in. The only way I see of fixing that is to use >> 'block' and 'unblock' directly. > > That certainly seems to do the trick for the simple example at least. One > way to reason about it better would be, instead of folding everything into > the race function, to simply modify ghc's bracket function to give us the > behavior we'd prefer (speaking of which, I recall there's something in the > works for 6.12 or so to improve rethrowing of asynchronous exceptions?) > > brackAsync before after thing = > block (do > a <- before > r <- catch > (unblock (thing a)) > (\_ -> after a >> myThreadId >>= killThread >> > brackAsync before after thing ) > after a > return r > ) > where threadKilled ThreadKilled = Just () > threadKilled _ = Nothing
This code turns any exception into ThreadKilled further down the stack. (\e -> do after a myThreadId >>= flip throwTo (e :: SomeException) ... might do the trick. My assumption was that anything but 'ThreadKilled' would be a real error. This isn't really true, I guess - thanks to throwTo, any exception could be asynchronous. If an exception is thrown, 'after a' is run again after the computation has resumed. That's why I did the cleanup within the 'catch'. But there's no reason why you couldn't do that as well: brackAsync before after thing = block $ do a <- before catch (unblock (thing a) >>= \r -> after a >> return r) $ \e -> do after a myThreadId >>= flip throwTo (e :: SomeException) brackAsync before after thing ) > This brackAsync just drops in to the previous code where bracket was and > appears to perform correctly. Right. 'race' should also unblock exceptions in the worker threads, withThread u v = brackAsync (forkIO (unblock u)) killThread (const v) but that's an independent change. > Further, if we place a trace after the > killThread, we se it gets executed once when the example is read (i.e. a > resumption) but it does not get executed if the (`seq` v) is removed from > the example So this gives me some hope that this is actually doing what > we'd like. I don't doubt it may have further kinks however. At least the GHC RTS has support for the hard part - unwinding the stack so that computations can be resumed seamlessly. I'm not sure which of the approaches I like better - it seems that we have a choice between turning async exceptions into sync ones or vice versa, and neither choice is strictly superior to the other. Enjoy, Bertram 'race' update: - Bugfix: Previously, only AsyncException-s would be caught. Use 'fromException' to select the ThreadKilled exception. - I tried using a custom 'SuspendException' type, but this resulted in 'test: SuspendException' messages on the console, while ThreadKilled is silently ignored... as documented: http://www.haskell.org/ghc/docs/latest/html/libraries/base/Control-Concurrent.html#v%3AforkIO (http://tinyurl.com/9t5pxs) - Tweak: Block exceptions while running 'cleanup' to avoid killing threads twice. - Trick: takeMVar is a blocking operation, so exceptions can be delivered while it's waiting - there's no need to use 'unblock' for this. In other words, unblock (takeMVar v) and takeMVar v are essentially equivalent for our purposes. race :: IO a -> IO a -> IO a race a b = block $ do v <- newEmptyMVar let t x = unblock (x >>= putMVar v) ta <- forkIO (t a) tb <- forkIO (t b) let cleanup = killThread ta >> killThread tb (do r <- takeMVar v; cleanup; return r) `catch` \e -> cleanup >> case fromException e of Just ThreadKilled -> do myThreadId >>= killThread unblock (race a b) _ -> throwIO e _______________________________________________ Glasgow-haskell-users mailing list Glasgow-haskell-users@haskell.org http://www.haskell.org/mailman/listinfo/glasgow-haskell-users