Faster timeout but is it correct?

[Simon Marlow]

On 17/02/2011 19:34, Bas van Dijk wrote:
> On 17 February 2011 13:09, Simon Marlow<marlowsd at gmail.com>  wrote:
>> uninterruptibleMask is quite unsavoury,
>
> Agreed, that's why I called this implementation "fragile" because it
> relies on the, not well known semantics, of interruptible operations.
>
>> I don't think we should use it here.
>
> I agree that it looks fishy. However the biggest part of the
> computation passed to uninterruptibleMask is running in the restored
> state. The only part that is running in uninterruptible masked state
> that may potentially block (and thus potentially deadlock) is the
> killThread in the exception handler. However since the timeout thread
> is running inside unsafeUnmask it is ensured that the ThreadKilled
> exception always gets thrown.
>
>> 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.
>
> Yes, and I think that the removal of the outer exception handler makes
> the code run so much faster.
>
>> 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.
>
> Good point, I will add a comment with an explanation how it works.
>
> My brother Roel had an interesting idea how to make the code run even
> faster by replacing the Unique with the ThreadId of the timeout
> thread. I implemented it and it now runs 19 times faster than the
> original compared to the 13 times faster of my previous version.
> Here's the new implementation:
>
> newtype Timeout = Timeout ThreadId 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
>          uninterruptibleMask $ \restore ->  do
>            tid<- unsafeUnmask $ forkIO $ do
>                      tid<- myThreadId
>                      threadDelay n
>                      throwTo myTid $ Timeout tid
>            (restore (fmap Just f)>>= \mb ->  killThread tid>>  return mb)
>              `catch` \e ->
>                  case fromException e of
>                    Just (Timeout tid') | tid' == tid ->  return Nothing
>                    _ ->  killThread tid>>  throwIO e
>
> It relies on ThreadIds being unique, but I believe this is the case
> because otherwise the throwTo operation will be nondeterministic,
> right?

(sorry for the late reply, just clearing my backlog)

This won't work in the case of nested timeouts, unless I'm mistaken.

Cheers,
	Simon