Timed iteration

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