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

23 Mar 2010


      On Tue, Mar 23, 2010 at 1:02 PM, Bas van Dijk  wrote:
...
On Tue, Mar 23, 2010 at 8:23 PM, David Leimbach  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-Concu...