Dining philosophers solution with STM.

DiningPhilosophersSTM.hs

import Control.Monad
import Control.Concurrent
import Control.Concurrent.STM
import System.Random
import Text.Printf
 
philosophers = ["Aristotle", "Kant", "Spinoza", "Marx", "Russel"] 

waitSome = randomRIO (1000, 5000) >>= threadDelay . (*1000)

runPhilo :: String -> (TMVar Int, TMVar Int) -> IO ()
runPhilo name (l, r) = forever $ do
    printf "%s is waiting for the forks.\n" name
    [lFork, rFork] <- atomically $ mapM takeTMVar [l, r]
    printf "%s is eating with forks %d and %d.\n" name lFork rFork
    waitSome
    atomically $ zipWithM_ putTMVar [l, r] [lFork, rFork]
    printf "%s is thinking.\n" name
    waitSome

main = do
    printf "Press enter to end dinner.\n\n"
    forks <- mapM newTMVarIO [1..5]
    zipWithM_ ((forkIO.) . runPhilo) philosophers (ap zip (tail . cycle) forks)
    getLine