Motivation

Let’s say, we have a computation-heavy function. And we want to see a partial result within the given time limit.

For instance, the following function \(f\) computes the sum of integers from \(1\) to \(2^n\) in a very naive way.

\[f(n) = \left(\sum_{i=1}^{2^n} i\right) \mod 1000000007\] 
import Data.List (foldl')

-- | Computation-heavy function.
f :: Int -> Int
f n = foldl' (\a x -> (a + x) `mod` 1000000007) 0 [1 .. 2 ^ n]

The running time should be exponential with respect to \(n\). I used Data.List.foldl' instead of foldl to avoid unwanted stack overflow.

Code

There are many third-party concurrent libraries available, but I wanted to stick to Haskell’s base library.

The following is the whole code.

import Control.Concurrent (forkIO, killThread, threadDelay)
import Control.Concurrent.MVar (newMVar, swapMVar, takeMVar)
import Control.Exception (evaluate)
import Data.List (foldl')

-- | Computation-heavy function.
f :: Int -> Int
f n = foldl' (\a x -> (a + x) `mod` 1000000007) 0 [1 .. 2 ^ n]

-- | Entry point of the program.
main :: IO ()
main = do
  -- Timeout in seconds
  let timeoutSec = 1

  -- Create a synchronized mutable variable.
  mvar <- newMVar (0, 0)

  -- Define a function.
  let compute i = do
        x <- evaluate (f i)
        putStrLn $ "Partial result: " ++ show (i, x)
        swapMVar mvar $! (i, x)
        compute $ i + 1

  -- Start a new thread.
  tid <- forkIO (compute 1)

  -- Wait and kill the thread.
  threadDelay $ timeoutSec * (10 ^ 6)
  killThread tid

  -- Get the final result.
  result <- takeMVar mvar

  -- Print out the result.
  putStrLn $ "====\nFinal Result: " ++ show result

Here are some comments.

  • Control.Concurrent.MVar, or a synchronized mutable variable, is a handy message box for shared variables. We can read, take, put, or swap the content.
  • System.Timeout has an API called timeout(), but I found it difficult to use for real applications. Instead, I employed threadDelay() to wait for a certain amount of time and then just kill the child thread.
  • The child process runs the compute function I defined above. It runs infinitely, incrementing the counter. The use of evaluate() is important because otherwise, you might put garbage to mvar.
  • The $! after swapMVar forces to evaluate the variables. Otherwise, takeMVar may take forever.

Example Output

$ runhaskell timeouts.hs
Partial result: (1,3)
Partial result: (2,10)
Partial result: (3,36)
Partial result: (4,136)
Partial result: (5,528)
Partial result: (6,2080)
Partial result: (7,8256)
Partial result: (8,32896)
Partial result: (9,131328)
Partial result: (10,524800)
Partial result: (11,2098176)
Partial result: (12,8390656)
Partial result: (13,33558528)
Partial result: (14,134225920)
Partial result: (15,536887296)
Partial result: (16,147516402)
Partial result: (17,590000072)
Partial result: (18,359869202)
Partial result: (19,439214657)
====
Final Result: (19,439214657)

When I set timeout to one second, my computer successfully computed up to \(n=19\).

References