Faster timeout but is it correct?

Bas van Dijk v.dijk.bas at
Wed Feb 16 20:26:04 CET 2011

I realized that the previous timeout had problems when called in a
masked thread. What happens is that the call to killThread will block
because it can't throw the KillThread exception to the timeout thread
because that thread is masked. I have to use unsafeUnmask to always
unmask the timeout thread. Note that, for some reason, using
forkIOUnmasked ... is much slower than using unsafeUnmask $ forkIO
.... Any idea why?

import GHC.IO (unsafeUnmask)

imeout :: 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 <- unsafeUnmask $ forkIO $
                   threadDelay n >> throwTo myTid timeoutEx
          (restore (fmap Just f) >>= \mb -> killThread tid >> return mb)
            `catch` \e ->
                case fromException e of
                  Just timeoutEx' | timeoutEx' == timeoutEx -> return Nothing
                  _ -> killThread tid >> throwIO e

For some reason this is slightly slower than the previous version
which used restore instead of unsafeUnmask. However it's still 13
times faster than the original.

The patch and benchmarks attached to the ticket are updated. Hopefully
this is the last change I had to make so I can stop spamming.



More information about the Libraries mailing list