[Haskell-cafe] More threading confusion

[Chris Kuklewicz]

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).