Timing out computations
(add my version of timeoutIterate)
Latest revision as of 06:22, 18 November 2006
A problem that frequently arises is that of constructing an IO action which terminates after a given period of time, regardless of whether it has finished the computation it was intended to perform. There are a variety of ways in which this can be accomplished.
One implementation for various efficient timeout combinators can be found in HAppS.Util.TimeOut (GPL licenced).
One way is to consider the more general problem of executing a number of competing actions in parallel, and returning the result of the first to be finished its task, an interesting problem in and of itself.
What we do is to create an initially empty
MVar, spawn threads for each of the competing computations, and have them all compete to execute their action and then put the result into the
MVar. In the main thread we try to take from the
MVar, which blocks until one of the threads completes its task. We then kill all of the threads, and return the winning result.
import Control.Concurrent compete :: [IO a] -> IO a compete actions = do mvar <- newEmptyMVar tids <- mapM (\action -> forkIO $ action >>= putMVar mvar) actions result <- takeMVar mvar mapM_ killThread tids return result
In order to implement the timeout, we just have two processes compete: the one to attempt, with its result wrapped in the
Just constructor, and one which waits the specified time (in microseconds) and then returns
timeout :: Int -> IO a -> IO (Maybe a) timeout usec action = compete [fmap Just action, threadDelay usec >> return Nothing]
A related problem is that of iterating a pure function for as many steps as possible until a given time limit passes, and returning the last computed result afterward. One can achieve this again using threads as follows:
import Control.Concurrent import Control.Exception timeoutIterate msec f x = do mvar <- newMVar x let loop = do x <- takeMVar mvar evaluate (f x) >>= putMVar mvar loop thread <- forkIO loop threadDelay msec u <- takeMVar mvar killThread thread return u
Without threads, using
getClockTime to check if enough time has passed, it looks like this:
import Control.Exception import System.Time getClockTimeMS = do (TOD s p) <- getClockTime return $ fromIntegral (s * 1000 + p `div` 10^6) timeoutIterate' msec f x = do t <- getClockTimeMS y <- evaluate (f x) t' <- getClockTimeMS timeoutIterate (msec - (t' - t)) f y
Note that in both cases, the use of evaluate is important to ensure that all of the evaluation actually occurs in the given timeframe and not lazily afterward.
(The above example doesn't seem likely to work, how about this instead:)
-- microseconds getClockTimeMS = do (TOD s p) <- getClockTime return $ fromIntegral (s * 1000000 + p `div` 10^6) timeoutIterate msec f x = do t <- getClockTimeMS timeoutIterate' (t + msec) f x timeoutIterate' fin f x = do t <- getClockTimeMS if t > fin then return x else do y <- evaluate (f x) t' <- getClockTimeMS timeoutIterate' fin f y