[Haskell-cafe] Timeouts that don't cause data growth.
David Leimbach
leimy2k at gmail.com
Tue Mar 23 15:23:25 EDT 2010
Is this just a problem of spawning too many forkIO resources that never
produce a result?
I was thinking of trying something like the following in System.Timeout's
place:
> module Main where
> import Control.Concurrent.MVar
> import Control.Concurrent
> import Data.Maybe
> timeout :: Int -> IO a -> IO (Maybe a)
> timeout time action = do
> someMVar <- newEmptyMVar -- MVar is a Maybe
> timeoutThread <- forkIO $ nothingIzer time someMVar
> forkIO $ actionRunner action someMVar timeoutThread
> takeMVar someMVar >>= return
> where
> nothingIzer time mvar = threadDelay time >> putMVar mvar Nothing
> actionRunner action mvar timeoutThread = do
> res <- action
> killThread timeoutThread
> putMVar mvar $ Just res
> main :: IO ()
> main = do
> res <- timeout (5 * 10 ^ 6) (getLine >>= putStrLn)
> case res of
> Nothing -> putStrLn "Timeout"
> Just x -> putStrLn "Success"
On Tue, Mar 23, 2010 at 11:31 AM, Roel van Dijk <vandijk.roel at gmail.com>wrote:
> I tried a few things. First I added another timeout to main, so the
> program kills itself after a few seconds.
>
> doit :: IO (Maybe ())
> doit = timeout 12000000 $ {- yield >> -} return ()
>
> main :: IO ()
> main = do _ <- timeout 5000000 $ forever doit
> return ()
>
> This program failed to terminate. But when I compiled -with threaded
> and added a yield to doit, it worked (kinda). If the timeout in doit
> is not too long, like 200 milliseconds, the program has constant space
> usage. But when I increased the timeout in doit to 12 seconds I got a
> stack overflow.
>
> I'll investigate further when I have more time.
>
> Regards,
> Roel
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20100323/1ec10248/attachment.html
More information about the Haskell-Cafe
mailing list