Software Transactional Memory

Locks are hard to get right: forget one and you have a race condition, take two in the wrong order and you have a deadlock. Software transactional memory (STM) replaces locks with transactions, like in a database: a block of reads and writes that happens all at once or not at all.

TVars and atomically

import Control.Concurrent.STM
import Control.Concurrent.Async (forConcurrently_)

transfer :: TVar Int -> TVar Int -> Int -> STM ()
transfer from to amount = do
  balance <- readTVar from
  check (balance >= amount)
  modifyTVar' from (subtract amount)
  modifyTVar' to (+ amount)

main :: IO ()
main = do
  alice <- newTVarIO 1000
  bob <- newTVarIO 1000
  forConcurrently_ [1 .. 100 :: Int] $ \i ->
    if even i
      then atomically (transfer alice bob 10)
      else atomically (transfer bob alice 5)
  a <- readTVarIO alice
  b <- readTVarIO bob
  print (a, b, a + b)

(750,1250,2000)

• A TVar is a transactional variable. Reads and writes happen in the STM monad, and atomically runs the transaction.
• If two transactions conflict, the runtime retries one of them automatically. The total is always 2000, no matter how the 100 threads interleave.
• check condition (built on retry) blocks the transaction until the condition becomes true — here, until the account has enough money. No condition variables, no polling.

Why STM can't go wrong the usual ways

The STM type only allows STM operations — you can't do I/O inside a transaction, because a transaction may be run several times. The type system enforces this. And transactions compose: two correct transactions combined in one atomically block are still correct, which is not true of lock-based code.

Choosing alternatives with orElse

import Control.Concurrent.STM

takeFrom :: TVar [String] -> STM String
takeFrom q = do
  items <- readTVar q
  case items of
    [] -> retry
    (x : xs) -> writeTVar q xs >> return x

main :: IO ()
main = do
  urgent <- newTVarIO []
  normal <- newTVarIO ["email", "report"]
  job1 <- atomically (takeFrom urgent `orElse` takeFrom normal)
  putStrLn job1
  atomically (modifyTVar' urgent (++ ["server down"]))
  job2 <- atomically (takeFrom urgent `orElse` takeFrom normal)
  putStrLn job2

email
server down

a orElse b tries a; if it would block (retry), it tries b instead.

Queues

import Control.Concurrent.STM
import Control.Concurrent.Async (concurrently_)
import Control.Monad (forM_, replicateM)

main :: IO ()
main = do
  q <- newTBQueueIO 2
  let producer = forM_ [1 .. 5 :: Int] $ \i -> atomically (writeTBQueue q i)
      consumer = do
        xs <- replicateM 5 (atomically (readTBQueue q))
        print xs
  concurrently_ producer consumer

[1,2,3,4,5]

A TBQueue holds at most 2 items here, so the producer waits whenever the consumer falls behind — built-in back-pressure.