Creighton Hogg wchogg at gmail.com
Thu Aug 17 15:48:51 EDT 2006

```Good afternoon Haskellers,

So I'm trying to understand how STM works, and wrote a quick 'eating
philosophers' example to see if I understood how it's supposed to work.
The problem is that while it executes, it doesn't appear to *do* anything.

Did I completely write things wrongheadedly or am I being bitten by
something more subtle?

Thanks.

import Control.Concurrent.STM
import Control.Concurrent
import Data.Array
import System.Random

think :: IO ()
think = do
ms <- randomRIO (20,1000)

data Philosopher = Philosopher {left::Bool,right::Bool,neighbors::(Int,Int)}
deriving Show

makeInitPhilosopher a = Philosopher {left=False,right=False,neighbors=a}

initPhilosophers = listArray (0,4)
(map makeInitPhilosopher [(1,4),(2,0),(3,1),(4,2),(0,3)])

main = do
z <- atomically \$ newTVar initPhilosophers
mapM_ (\x -> forkIO (loop x z 0 10000)) [0,1,2,3,4]

loop n tps c l | c > l = (atomically (readTVar tps)) >>= (\x -> print x)
| otherwise = do
think
atomically \$ eat n tps
loop n tps (c+1) l

eat :: Int -> TVar (Array Int Philosopher) -> STM ()
eat n tps = do
takeLeft n tps
takeRight n tps
releaseLeft n tps
releaseRight n tps

takeLeft :: Int -> TVar (Array Int Philosopher) -> STM ()
takeLeft n tps = do
let p = ps ! n
if right (ps ! (fst \$ neighbors p)) == False
then (writeTVar tps \$ ps // [(n,p{left=True})])
else retry

takeRight :: Int -> TVar (Array Int Philosopher) -> STM ()
takeRight n tps = do
let p = ps ! n
if left (ps ! (snd \$ neighbors p)) == False
then (writeTVar tps \$ ps // [(n,p{right=True})])
else retry

releaseLeft n tps = do
let p = ps ! n
writeTVar tps \$ ps // [(n,p{left=False})]

releaseRight n tps = do