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

Reply via email to