[Haskell-cafe] Timeouts that don't cause data growth.

[David Leimbach]

On Tue, Mar 23, 2010 at 1:02 PM, Bas van Dijk <v.dijk.bas at gmail.com> wrote:

> On Tue, Mar 23, 2010 at 8:23 PM, David Leimbach <leimy2k at gmail.com> wrote:
> > Is this just a problem of spawning too many forkIO resources that never
> > produce a result?
>
> It looks like it. Lets look at the implementation of timeout:
>
> timeout :: Int -> IO a -> IO (Maybe a)
> timeout n f
>    | n <  0    = fmap Just f
>    | n == 0    = return Nothing
>    | otherwise = do
>        pid <- myThreadId
>        ex  <- fmap Timeout newUnique
>        handleJust (\e -> if e == ex then Just () else Nothing)
>                   (\_ -> return Nothing)
>                   (bracket (forkIO (threadDelay n >> throwTo pid ex))
>                            (killThread)
>                            (\_ -> fmap Just f))
>
> We see a thread is forked that throws the Timeout exception to the
> current thread after n microseconds. However when the current thread
> finishes early this timeout thread will be killed. I assume that when
> a thread is killed it can be garbage collected. (However we have to
> watch out for [1]) So it's a big surprise to me that we're seeing this
> space-leak!
>
> Maybe you can file a bug report?
>

Seems like I should


>
> > 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"
>
> The original timeout obeys the following specification:
>
> "The design of this combinator was guided by the objective that
> timeout n f  should behave exactly the same as f as long as f doesn't
> time out. This means that f has the same myThreadId  it would have
> without the timeout wrapper. Any exceptions f might throw cancel the
> timeout and propagate further up. It also possible for f to receive
> exceptions thrown to it by another thread."
>
> They implement this by executing the action in the current thread.
> Yours executes the action in another thread.
>

True, but mine's not leaking space! ;-)  I think I can fix the action
running in the other thread issue.


>
> regards,
>
> Bas
>
> [1]
> http://haskell.org/ghc/docs/latest/html/libraries/base-4.2.0.0/Control-Concurrent.html#t%3AThreadId
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20100323/fc7fb831/attachment.html