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