Each block of code inside the
atomically function is a transaction. When you read and write
TVars within a transaction, you are shielded from the effects of any other threads that may also be messing with the variables concurrently.
In celebration of how transactional variables free us from a lot of messy concerns that usually complicate concurrent programming, here is a classic demonstration that simulates passing money around between bank accounts.
These are our standard imports from stm for working with mutable references.
import Control.Monad.STM import Control.Concurrent.STM.TVar
This demonstration will create a bunch of concurrent threads that perform actions at random.
import Control.Concurrent (forkIO, threadDelay)
We use the mwc-random library to generate random numbers.
import System.Random.MWC (createSystemRandom, uniformR)
We will store the list of accounts in a sequence to allow efficient lookups by index when selecting an account at random.
import qualified Data.Sequence as Seq import Control.Monad (forever) import Data.Foldable (asum, for_) import Data.Traversable (for)
= main do
First we initialize ten
TVars representing ten account balances.
<- accountList 1..10] $ \_ -> for [100 :: Integer)) atomically (newTVar (
The standard list type is great for looping over, but for any other access pattern we look to other data structures. Here we’ll want to look up accounts by their position in the list, so we’ll store them in a
randomAccount function uses
uniformR to generate a random list index, then uses
Seq.index to grab the account at that position.
let = Seq.fromList accountList accountSeq = randomAccount rng do <- uniformR (1, Seq.length accountSeq) rng i return (Seq.index accountSeq (i - 1))
Next we start many threads to create frantic account activity.
1..500] $ \_ -> for_ [$ forkIO do
Each thread has its own random number generator.
<- createSystemRandom rng
These threads run in an infinite loop; they will stop only when the program ends.
$ forever do
Between each iteration, a brief pause lasting somewhere between ten and fifty microseconds.
<- uniformR (10, 50) rng d threadDelay d
In each loop iteration, one transaction. Two accounts are chosen at random to be the sender and the recipient.
<- randomAccount rng sender <- randomAccount rng recipient <- amount do
The amount to transfer is also selected at random, a number between one and ten.
<- uniformR (1, 10) rng x return (toInteger (x :: Int))
Now we come to the interesting transaction.
$ atomically asum
First it reduces the sender’s balance by the transfer amount, then checks to make sure that this did not overdraw the account. If the new balance is below zero, the transaction is aborted.
do [ -> x - amount) modifyTVar' sender (\x >>= \x -> check (x >= 0) readTVar sender
Then it increases the recipient’s balance by the same amount.
-> x + amount) modifyTVar' recipient (\x
The alternative possibility, reached if the first transaction aborts, is to return without doing anything. (If we did not include this branch, then the thread would block until the transaction is able to run successfully.)
return () , ]
The final piece of the program is to make some observations of the program state so we can see what’s happening. We’ll repeat this four times, pausing for half of a second between each sample.
1..4] $ \_ -> for_ [do 500000 threadDelay
In a single transaction, we read all of the account balances.
<- atomically (for accountList readTVar) balances
Then we print the list of balances and their sum total.
putStrLn (show balances) putStrLn ("Total: " ++ show (sum balances))
Since the transactions are random, you’ll see a different result every time you run this program. But, no matter what:
- No account balance ever drops below zero.
- The total amount of money among the accounts remains at 1,000.
$ runhaskell transactions.hs [507,66,64,14,76,33,23,30,103,84] Total: 1000 [211,81,78,118,70,182,74,65,62,59] Total: 1000 [181,262,175,77,14,52,0,229,1,9] Total: 1000 [14,118,45,12,350,214,149,16,53,29]Total: 1000