On 16/02/2011 08:39, Bas van Dijk wrote:
timeout :: Int -> IO a -> IO (Maybe a)
timeout n f
| n< 0 = fmap Just f
| n == 0 = return Nothing
| otherwise = do
myTid<- myThreadId
timeoutEx<- fmap Timeout newUnique
uninterruptibleMask $ \restore -> do
tid<- restore $ forkIO $ threadDelay n>> throwTo myTid timeoutEx
let handle e = case fromException (e :: SomeException) of
Just timeoutEx' | timeoutEx' == timeoutEx
-> return Nothing
_ -> killThread tid>> throwIO e
mb<- restore (fmap Just f) `catch` handle
killThread tid
return mb
If nobody proves it incorrect I will make a patch for the base library.
uninterruptibleMask is quite unsavoury, I don't think we should use it
here. I can see why you used it though: the killThread in the main
thread will always win over the throwTo in the timeout thread, and that
lets you avoid the outer exception handler.
Hmm, it makes me uncomfortable, but I can't find any actual bugs. At
the very least it needs some careful commentary to explain how it works.
Cheers,
Simon
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe