If an STM transaction fails and retries, does the call to writeTChan
get re-executed so that you end up with two writes, or does the STM only actually perform the write if the transaction commits? i.e., is this solution to the sleeping barber problem valid, or might a customer get two haircuts if the transaction in enterShop
fails the first time?
import Control.Monad
import Control.Concurrent
import Control.Concurrent.STM
import System.Random
import Text.Printf
runBarber :: TChan Int -> TVar Int -> IO ()
runBarber haircutRequestChan seatsLeftVar = forever $ do
customerId <- atomically $ readTChan haircutRequestChan
atomically $ do
seatsLeft <- readTVar seatsLeftVar
writeTVar seatsLeftVar $ seatsLeft + 1
putStrLn $ printf "%d started cutting" customerId
delay <- randomRIO (1,700)
threadDelay delay
putStrLn $ printf "%d finished cutting" customerId
enterShop :: TChan Int -> TVar Int -> Int -> IO ()
enterShop haircutRequestChan seatsLeftVar customerId = do
putStrLn $ printf "%d entering shop" customerId
hasEmptySeat <- atomically $ do
seatsLeft <- readTVar seatsLeftVar
let hasEmptySeat = seatsLeft > 0
when hasEmptySeat $ do
writeTVar seatsLeftVar $ seatsLeft - 1
writeTChan haircutRequestChan customerId
return hasEmptySeat
when (not hasEmptySeat) $ do
putStrLn $ printf "%d turned away" customerId
main = do
seatsLeftVar <- newTVarIO 3
haircutRequestChan <- newTChanIO
forkIO $ runBarber haircutRequestChan seatsLeftVar
forM_ [1..20] $ \customerId -> do
delay <- randomRIO (1,3)
threadDelay delay
forkIO $ enterShop haircutRequestChan seatsLeftVar customerId
UPDATE
I didn't notice until after the fact that the above hairRequestChan
doesn't have to be part of the transaction anyway. I can use a regular Chan
and do the writeChan
in an if
statement after the atomically
block in enterShop
. But making that improvement destroys the whole reason for asking the question, so I'll leave it as-is here.
TChan
operations are performed when a transaction is committed, just like other STM operations, so you'll always end up with a single write, no matter how many times your transaction is retried. They'd be kind of useless otherwise.
To convince yourself, try this example:
import Control.Concurrent
import Control.Concurrent.STM
import Control.Concurrent.STM.TChan
main = do
ch <- atomically newTChan
forkIO $ reader ch >>= putStrLn
writer ch
reader = atomically . readTChan
writer ch = atomically $ writeTChan ch "hi!" >> retry
This will throw a exception complaining that the transaction is blocked indefinitely. If writeTChan
caused a write to happen before the transaction was committed, the program would print "hi!" before throwing that exception.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With