15 Software Transactional Memory: Deadlock-free concurrency

15.1 Overview

../code/STM2.hs

import Control.Concurrent
import Control.Concurrent.STM

-- With MVars we might model a bank transfer as follows:

type Balance = Int
type Account = MVar Balance

-- Withdrawing from the bank is a simple matter of taking the `MVar`
-- and putting back in the new balance.
withdraw :: Account -> Int -> IO ()
withdraw a m = do
  bal <- takeMVar a
  putMVar a (bal - m)

-- Depositing is even simpler: It's just a 'negative' withdrawal.
deposit :: Account -> Int -> IO ()
deposit a m = withdraw a (-m)


-- Transfering from one account to another reveals a few weaknesses
-- with the `MVar` model of concurrency. Let's take a look at a few
-- alternate implementations:

-- Transfering is just withdawing from one account and depositing it
-- into another:
transfer1 :: Account -> Account -> Int -> IO ()
transfer1 s d m = do
  withdraw s m
  deposit d m

-- The issue with the above is that in the 'space' between withdrawing
-- and depositing, we have an observable non-valid state.
--
-- This is because each action here is managing its resources (the accounts
-- that it uses) _separately_. So some other thread might see that the money
-- is no longer in the source account, _but also isn't in the destination
-- account_
--
-- One way of addressing this is by ensuring that we get control of all
-- the resources we do before we start modifying stuff:
transfer2 :: Account -> Account -> Int -> IO ()
transfer2 s d m = do
  sourceBal <- takeMVar s
  destBal   <- takeMVar d
  putMVar s (sourceBal - m)
  putMVar d (destBal + m)

-- This solution is inelegant for a few reasons:
--
-- * we aren't reusing the code we wrote for withdraw and deposit, 
--   code reuse is good!
-- * There's not the possibility of a deadlock: if transfers are
--   happening in both directions, two threads could be waiting
--   on each other forever :'(
-- * There's still an intermediate state that's visible, but it's
--   not the same level of problem as before, so while we no longer
--   have a completely invalid state that's visible it only partly
--   solves the problem

--------------------------------------------------------------------------------
---- STM: Concurrency via transactions
--------------------------------------------------------------------------------

-- Insteead of MVars, we can us a _different model of concurrency_ where instead
-- of managing access to resources via mutual-exclusion, threads can _attempt_
-- to use all the resources they'd like, but will promise to 'roll back' their
-- attempt if someone else has altered the state of the resources during the
-- attempt.
--
-- This idea comes to us from the database community, where you can try to
-- perform a large update of a database, but you won't "commit" that change
-- to the database if the underlying data changed while you were processing
-- your update.

-- Instead of `MVar`s, we have `TVar`s now.
--
-- `TVar`s do not have the same notion of 'empty' and 'full' that `MVar`s have,
-- which makes sense, this is a completely different notion of concurrency, we
-- aren't coordinating mutual exclusion on these variables.

type AccountSTM = TVar Balance

-- When we withdraw, we don't need to 'take' the `TVar`, we can just read
-- it. It isn't 'ours' other threads can feel free to read it as well. The
-- STM implementation just keeps a log of which `TVar`s we read from during
-- a transaction.
--
-- Now, when we `writeTVar`, we are attempting to change the world! Shouldn't
-- we make sure that _only we_ are able to do that change? Well, under the
-- `MVar` model, yes; but under the STM model, it's not our problem! It's the
-- problem of whoever is implementing the STM library. We can just do what we
-- want with the variables and the STM implementation will make sure that
-- invalidated transactions are unwound. It uses the log of which variables we
-- read from to do this, if some other thread has _changed_ the value of one of
-- the `TVar`s we read, we have to retry our transaction from the beginning.
--
withdrawSTM :: AccountSTM -> Int -> STM ()
withdrawSTM a m = do
  bal <- readTVar a
  writeTVar a (bal - m)

depositSTM :: AccountSTM -> Int -> STM ()
depositSTM a m = withdrawSTM a (-m)

-- Now, when we `transfer` it _is_ just the composition of the two things that
-- we have code for! Yay for code reuse. This new function is just one _larger_
-- transaction.
transferSTM :: AccountSTM -> AccountSTM -> Int -> STM ()
transferSTM s d m = do
  withdrawSTM s m
  depositSTM d m


getBalance :: AccountSTM -> STM Balance
getBalance a = readTVar a

-- To actually _run_ our transactions, we need the `atomically` function,
-- which will take an `STM a` computation and actually 'run it'. The
-- STM library is responsible for doing all of the conflict detection
-- and unwinding of invalidated transactions.
main = do
  acc  <- atomically (newTVar (200))
  acc2 <- atomically (newTVar (100))
  forkIO (atomically (transferSTM acc acc2 200))
  bal <- atomically (getBalance acc)
  print bal