Faster timeout but is it correct?

[Bas van Dijk]

Dear all,

I wrote a faster implementation for System.Timeout.timeout but wonder
whether it's correct. It would be great if someone can review the
code.

The implementation comes with a tiny Criterion benchmark:

darcs get http://bifunctor.homelinux.net/~bas/bench_timeouts/

On ghc-7.0.1 with -O2 the following benchmark, which always times out,
doesn't show a difference with the current timeout:

timeout 1 (threadDelay 1000000)

However the following benchmark, which never times out, shows nice
speedups for both a non-threaded and a threaded version:

timeout 1000000 (return ())

non-threaded: 3.6 faster
threaded: 10.8 faster

I suspect the reason why my timeout is faster is that I use only one
'catch' while the original uses two: handleJust and bracket. I have to
admit that my implementation is more complex and more fragile than the
original. That's why I'm not sure of it's correctness yet:

newtype Timeout = Timeout Unique deriving (Eq, Typeable)

instance Show Timeout where
    show _ = "<<timeout>>"

instance Exception Timeout

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.

Regards,

Bas