Creighton Hogg wrote:
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?
One of the things biting you is more subtle. Since it is Aug 18th,2006, lets call that "snake #1". Another is the single TVar, call that "snake #2":
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}
Each philosopher starts with False False.
initPhilosophers = listArray (0,4) (map makeInitPhilosopher [(1,4),(2,0),(3,1),(4,2),(0,3)])
So philosopher 0 sits next to 1 and 4, and #1 sits next to 2 and 0. Okay.
main = do z <- atomically $ newTVar initPhilosophers
There is a single TVar in the program with the global state. By the way: This is not the best design, since it prevents concurrent updates. Imagine philosopher #0 and #2 both taking left and right. They will both contest the single TVar and one will have to retry even though this is unneeded. This is snake #2.
mapM_ (\x -> forkIO (loop x z 0 10000)) [0,1,2,3,4]
This is good, but "main" finished immediately. This may end your program...I forget the semantics of the extra threads.
loop n tps c l | c > l = (atomically (readTVar tps)) >>= (\x -> print x) | otherwise = do think atomically $ eat n tps
So the atomic action of eat either will run to completion, or be retried. The other philosophers only notice eat when it finishes.
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
Hmmm... if release undoes take then when eat completes there will be no visible change. In that case "atomically $ eat n tps" will have had no affect on other parts of the program. This could be snake #1
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
Okay. I can see that if both #0's left and #1's right are both "True" then they are both holding the same piece of silverware, and this code is designed to avoid that. Skipping the *Right code:
releaseLeft n tps = do ps <- readTVar tps let p = ps ! n writeTVar tps $ ps // [(n,p{left=False})]
Okay, this reverses takeLeft. So your "atomically $ eat", if it succeeds, changes the array in the TVar and then changes it back to what it was before. If any other philosopher eats in the meantime, then you have to retry eating. So only one philosopher will get to eat at a time. This is a poor solution to the problem. Suggestion for killing snake #1: Give each piece of silverware a TVar. Perhaps an (Array (TVar (Maybe Int))). Philosopher #3 claims a piece by changing it from Nothing to (Just 3). Now the silverware has a hope of being picked up in parallel. Suggestion for killing snake #2: Change atomically $ eat to do atomically $ (takeRight ... >> takeLeft ...) -- print "Mmm... tasty snake" -- yield -- threadDelay atomically $ (releaseRight ... >> releaseLeft ...) Now when a diner gets the silverware she can only get both or "retry". Then other diners can see the first atomically block committed and they will block waiting for the silverware (only the TVars they need).