Last active
May 18, 2020 12:31
-
-
Save rcythr/9f4d37573387ee646442450d7dcd1bfe to your computer and use it in GitHub Desktop.
An implementation of the dining philosopher problem with STM in Haskell. ( see: https://en.wikipedia.org/wiki/Dining_philosophers_problem )
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| module Main where | |
| import Control.Concurrent | |
| import Control.Concurrent.STM (STM, atomically, retry) | |
| import Control.Concurrent.STM.TVar (TVar, newTVarIO, modifyTVar', readTVar, writeTVar) | |
| import Control.Concurrent.STM.TMVar (TMVar, newTMVarIO, takeTMVar, putTMVar) | |
| import Control.Monad (when, forM) | |
| import Data.Array | |
| import System.IO (hFlush, stdout) | |
| import System.Random | |
| philosopherMain :: Int -> TMVar () -> TVar Int -> TMVar () -> IO () | |
| philosopherMain k left plate right = do | |
| v <- atomically $ do | |
| takeTMVar left | |
| takeTMVar right | |
| plateVal <- readTVar plate | |
| writeTVar plate (plateVal-1) | |
| putTMVar right () | |
| putTMVar left () | |
| return (plateVal-1) | |
| putStrLn (concat ["Philosopher #", show k, " eats (", show v, " remaining)."]) | |
| when (v /= 0) $ do | |
| s <- randomRIO (1, 10) | |
| putStrLn (concat ["Philosopher #", show k, " rests for ", show s, " seconds."]) | |
| threadDelay (s * 1000000) | |
| philosopherMain k left plate right | |
| main :: IO () | |
| main = do | |
| putStr "Number of Philosophers: " | |
| hFlush stdout | |
| n <- fmap read getLine | |
| putStr "Amount of Food: " | |
| hFlush stdout | |
| p <- fmap read getLine | |
| forks <- sequenceA $ listArray (0, n-1) $ replicate n (newTMVarIO ()) | |
| plates <- sequenceA $ listArray (0, n-1) $ replicate n (newTVarIO p) | |
| philosophers <- forM [0..n-1] $ \k -> do | |
| done <- newEmptyMVar | |
| forkIO $ do | |
| putStrLn (concat ["Philosopher #", show k, " is ready to eat!"]) | |
| philosopherMain k (forks ! ((k-1) `mod` n)) (plates ! k) (forks ! ((k+1) `mod` n)) | |
| putStrLn (concat ["Philosopher #", show k, " is finished eating!"]) | |
| putMVar done () | |
| return done | |
| mapM_ takeMVar philosophers |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment