
Einar Karttunen writes:
The difference was quite large in very concurrent situations when I did benchmarking earlier between my two implementations [...]
I see you point. It is obvious that an implementation with two forkIOs is probably slower than an implementation with one. I would love to implement timeout the way you did, but my problem is that it doesn't feel right to depend on Data.Typeable in Control.Concurrent. I don't want to define a new dynamic exception type in that module. One solution could be to move timeout to a different module. Do you have a suggestion? Where would you put your code? Arguably, a timeout implementation that depends on asynchronous exceptions could just as well expose the fact and signal timeouts with said asynchronous exception. In that case, the signature could be even simpler: data TimeoutError = TimeoutError deriving (Show, Typeable) type Microseconds = Int timeout :: Microseconds -> IO a -> IO a Assuming that a timeout is a rare event which most probably constitutes a fatal error condition for the I/O context, this function is more comfortable to use. The signature my implementation has right now, timeout :: Microseconds -> IO a -> IO (Maybe a) ..., forces the programmer to deal with a timeout condition in-place. My impression is that code reliability is furthered by making error conditions explicit, so I tend to prefer that kind of signature. It is not a strong preference, however. How do others feel about this topic? By the way, I have created Trac ticket #980 for this proposal. I have also had an interesting insight into the child thread problem. I took exception forwarding out of the code because the notion of child and parent threads felt insufficiently well defined. Just because a thread started another one, it doesn't mean that this particular thread is necessarily the correct error handler for the child thread. Now I realize: the thread responsible for handling the child thread's errors is the one who accesses the child's return value. This is one of the rare occasions where significant functionality can be added by making the code simpler. :-) type AsyncMVar a = MVar (Either Exception a) data Async a = Child ThreadId (AsyncMVar a) forkAsync' :: IO a -> AsyncMVar a -> IO (Async a) forkAsync' f mv = fmap (\p -> Child p mv) (forkIO f') where f' = block (try f >>= tryPutMVar mv >> return ()) forkAsync :: IO a -> IO (Async a) forkAsync f = newEmptyMVar >>= forkAsync' f throwToAsync :: Async a -> Exception -> IO () throwToAsync (Child pid _) = throwTo pid killAsync :: Async a -> IO () killAsync (Child pid _) = killThread pid isReadyAsync :: Async a -> IO Bool isReadyAsync (Child _ mv) = fmap not (isEmptyMVar mv) waitForAsync :: Async a -> IO a waitForAsync (Child _ sync) = fmap (either throw id) (readMVar sync) -- Run both computations in parallel and return the @a@ value -- of the computation that terminates first. An exception in -- either of the two computations aborts the entire parIO -- computation. parIO :: IO a -> IO a -> IO a parIO f g = do sync <- newEmptyMVar bracket (forkAsync' f sync) (killAsync) (\_ -> bracket (forkAsync' g sync) (killAsync) (waitForAsync)) type MicroSeconds = Int timeout :: MicroSeconds -> IO a -> IO (Maybe a) timeout n f | n < 0 = fmap Just f | n == 0 = return Nothing | otherwise = (fmap Just f) `parIO` (threadDelay n >> return Nothing) The need for "a" to be a Monoid is gone, and exceptions propagate nicely too. Peter