Shared Transactional Memory

Haskell allows you to do imperative programming through its shared memory transactional system. Shared memory variables are created with newTVar(), read with readTVar(), and written with writeTVar(). Threads can be created with the forkIO() call.

You can wrap any combination of read/write/new inside an atomically() call, and it will safely execute concurrently with other threads.

The atomically() call has another nice benefit, it converts an STM to an IO. This allows us to print values obtained from the STM Monad.

Here's a small example of how to do some basic imperative programming with Haskell.

file: stmtest.hs
1 import Control.Concurrent.STM
2 
3 pr x = do
4     y <- atomically(readTVar x)
5     putStrLn(show(y))
6 
7 main = do
8     x <- atomically(newTVar 3)
9     pr x
10     atomically(writeTVar x 4)
11     pr x
12     atomically(writeTVar x 2)
13     pr x
> ghc --make stmtest.hs; ./stmtest
[1 of 1] Compiling Main             ( stmtest.hs, stmtest.o )
Linking stmtest ...
3
4
2

Building a Mutex with STM

The "retry" statement is key to making this code work. When it is encountered, the transaction unrolls and waits for one of the variables to change. When this happens it tries again.

file: mutex.hs
1 import Control.Concurrent
2 import Control.Concurrent.STM
3 
4 data Mutex = Locked | Unlocked
5 
6 newMutex = atomically(newTVar Unlocked)
7 
8 acquireMutex mut = atomically(do
9     val <- readTVar mut
10     case val of
11         Unlocked -> writeTVar mut Locked
12         Locked -> retry)
13 
14 releaseMutex mut = atomically(writeTVar mut Unlocked)
15 
16 threads mut counter n = doall [
17     forkIO(do
18         acquireMutex mut
19         id <- myThreadId
20         atomically(do
21             val <- readTVar counter
22             writeTVar counter (val-1))
23         putStrLn("I am thread "++show(id))
24         releaseMutex mut) | i <- [1..n]]
25 
26 doall [] = putStr ""
27 doall (a:b) = do
28     a
29     doall b
30 
31 main = let
32         n = 10
33     in
34         do
35             mut <- newMutex
36             counter <- atomically(newTVar n)
37 
38             -- start a group of n threads
39             threads  mut counter n
40 
41             -- block until all threads finish
42             atomically(do
43                 val <- readTVar counter
44                 case val of
45                     0 -> return val
46                     otherwise -> retry)
47             putStrLn("done")
> ghc --make mutex.hs; ./mutex
[1 of 1] Compiling Main             ( mutex.hs, mutex.o )
Linking mutex ...
I am thread ThreadId 2
I am thread ThreadId 3
I am thread ThreadId 4
I am thread ThreadId 5
I am thread ThreadId 6
I am thread ThreadId 7
I am thread ThreadId 8
I am thread ThreadId 9
I am thread ThreadId 10
done
prevnext