Good afternoon Haskellers,<br><br>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.<br>The problem is that while it executes, it doesn't appear to *do* anything.
<br><br>Did I completely write things wrongheadedly or am I being bitten by something more subtle?<br><br>Thanks.<br><br>import Control.Concurrent.STM<br>import Control.Concurrent<br>import Data.Array<br>import System.Random
<br><br>think :: IO ()<br>think = do<br>&nbsp; ms &lt;- randomRIO (20,1000)<br>&nbsp; threadDelay ms<br><br>data Philosopher = Philosopher {left::Bool,right::Bool,neighbors::(Int,Int)}<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; deriving Show<br><br>makeInitPhilosopher a = Philosopher {left=False,right=False,neighbors=a}
<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br><br>initPhilosophers = listArray (0,4) <br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (map makeInitPhilosopher [(1,4),(2,0),(3,1),(4,2),(0,3)])<br><br>main = do<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; z &lt;- atomically $ newTVar initPhilosophers
<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; mapM_ (\x -&gt; forkIO (loop x z 0 10000)) [0,1,2,3,4]<br><br>loop n tps c l | c &gt; l = (atomically (readTVar tps)) &gt;&gt;= (\x -&gt; print x)<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; | otherwise = do<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;&nbsp; think&nbsp; 
<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; atomically $ eat n tps<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; loop n tps (c+1) l<br><br>eat :: Int -&gt; TVar (Array Int Philosopher) -&gt; STM ()<br>eat n tps = do<br>
&nbsp; takeLeft n tps<br>&nbsp; takeRight n tps<br>&nbsp; releaseLeft n tps<br>&nbsp; releaseRight n tps<br><br>takeLeft :: Int -&gt; TVar (Array Int Philosopher) -&gt; STM ()<br>takeLeft n tps = do<br>&nbsp; ps &lt;- readTVar tps<br>&nbsp; let p = ps ! n
<br>&nbsp; if right (ps ! (fst $ neighbors p)) == False<br>&nbsp;&nbsp;&nbsp;&nbsp; then (writeTVar tps $ ps // [(n,p{left=True})])<br>&nbsp;&nbsp;&nbsp;&nbsp; else retry<br><br>takeRight :: Int -&gt; TVar (Array Int Philosopher) -&gt; STM ()<br>takeRight n tps = do
<br>&nbsp; ps &lt;- readTVar tps<br>&nbsp; let p = ps ! n<br>&nbsp; if left (ps ! (snd $ neighbors p)) == False<br>&nbsp;&nbsp;&nbsp;&nbsp; then (writeTVar tps $ ps // [(n,p{right=True})])<br>&nbsp;&nbsp;&nbsp;&nbsp; else retry<br><br>releaseLeft n tps = do<br>&nbsp; ps &lt;- readTVar tps
<br>&nbsp; let p = ps ! n<br>&nbsp; writeTVar tps $ ps // [(n,p{left=False})]<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br>releaseRight n tps = do<br>&nbsp; ps &lt;- readTVar tps<br>&nbsp; let p = ps ! n<br>&nbsp; writeTVar tps $ ps // [(n,p{right=False})]<br>