1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | 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 returnsOnce 0 = 1 returnsOnce _ = last [1..] main = timeoutIterate 100 returnsOnce 0 |