Concurrency

Remarks#

Good resources for learning about concurrent and parallel programming in Haskell are:

• Parallel and Concurrent Programming in Haskell

• the Haskell Wiki

Spawning Threads with forkIO

Haskell supports many forms of concurrency and the most obvious being forking a thread using forkIO.

The function forkIO :: IO () -> IO ThreadId takes an IO action and returns its ThreadId, meanwhile the action will be run in the background.

We can demonstrate this quite succinctly using ghci:

Prelude Control.Concurrent> forkIO $ (print . sum) [1..100000000]
ThreadId 290
Prelude Control.Concurrent> forkIO $ print "hi!"
"hi!"
-- some time later....
Prelude Control.Concurrent> 50000005000000

Both actions will run in the background, and the second is almost guaranteed to finish before the last!

Communicating between Threads with MVar

It is very easy to pass information between threads using the MVar a type and its accompanying functions in Control.Concurrent:

• newEmptyMVar :: IO (MVar a) — creates a new MVar a
• newMVar :: a -> IO (MVar a) — creates a new MVar with the given value
• takeMVar :: MVar a -> IO a — retrieves the value from the given MVar, or blocks until one is available
• putMVar :: MVar a -> a -> IO () — puts the given value in the MVar, or blocks until it’s empty

Let’s sum the numbers from 1 to 100 million in a thread and wait on the result:

import Control.Concurrent
main = do
  m <- newEmptyMVar
  forkIO $ putMVar m $ sum [1..10000000]
  print =<< takeMVar m  -- takeMVar will block 'til m is non-empty!

A more complex demonstration might be to take user input and sum in the background while waiting for more input:

main2 = loop
  where 
    loop = do
        m <- newEmptyMVar
        n <- getLine
        putStrLn "Calculating. Please wait"
        -- In another thread, parse the user input and sum
        forkIO $ putMVar m $ sum [1..(read n :: Int)]
        -- In another thread, wait 'til the sum's complete then print it
        forkIO $ print =<< takeMVar m
        loop

As stated earlier, if you call takeMVar and the MVar is empty, it blocks until another thread puts something into the MVar, which could result in a Dining Philosophers Problem. The same thing happens with putMVar: if it’s full, it’ll block ‘til it’s empty!

Take the following function:

concurrent ma mb = do
  a <- takeMVar ma
  b <- takeMVar mb
  putMVar ma a
  putMVar mb b

We run the the two functions with some MVars

concurrent ma mb     -- new thread 1 
concurrent mb ma     -- new thread 2

What could happen is that:

1. Thread 1 reads ma and blocks ma
2. Thread 2 reads mb and thus blocks mb

Now Thread 1 cannot read mb as Thread 2 has blocked it, and Thread 2 cannot read ma as Thread 1 has blocked it. A classic deadlock!

Atomic Blocks with Software Transactional Memory

Another powerful & mature concurrency tool in Haskell is Software Transactional Memory, which allows for multiple threads to write to a single variable of type TVar a in an atomic manner.

TVar a is the main type associated with the STM monad and stands for transactional variable. They’re used much like MVar but within the STM monad through the following functions:

atomically :: STM a -> IO a

Perform a series of STM actions atomically.

readTVar :: TVar a -> STM a

Read the TVar’s value, e.g.:

value <- readTVar t

writeTVar :: TVar a -> a -> STM ()

Write a value to the given TVar.

t <- newTVar Nothing
writeTVar t (Just "Hello")

This example is taken from the Haskell Wiki:

import Control.Monad
import Control.Concurrent
import Control.Concurrent.STM
 
main = do 
  -- Initialise a new TVar
  shared <- atomically $ newTVar 0
  -- Read the value
  before <- atomRead shared
  putStrLn $ "Before: " ++ show before
  forkIO $ 25 `timesDo` (dispVar shared >> milliSleep 20)
  forkIO $ 10 `timesDo` (appV ((+) 2) shared >> milliSleep 50)
  forkIO $ 20 `timesDo` (appV pred shared >> milliSleep 25)
  milliSleep 800
  after <- atomRead shared
  putStrLn $ "After: " ++ show after
  where timesDo = replicateM_
       milliSleep = threadDelay . (*) 1000

atomRead = atomically . readTVar
dispVar x = atomRead x >>= print
appV fn x = atomically $ readTVar x >>= writeTVar x . fn