[Haskell-cafe] More threading confusion

[Creighton Hogg]

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)
  threadDelay ms

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
  ps <- readTVar tps
  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
  ps <- readTVar tps
  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
  ps <- readTVar tps
  let p = ps ! n
  writeTVar tps $ ps // [(n,p{left=False})]

releaseRight n tps = do
  ps <- readTVar tps
  let p = ps ! n
  writeTVar tps $ ps // [(n,p{right=False})]
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org//pipermail/haskell-cafe/attachments/20060817/ee8ab971/attachment.htm