Anonymous user
Dining philosophers: Difference between revisions
Added haskell
m (Fixed lang tags.) |
(Added haskell) |
||
Line 540:
end,
unregister(diningRoom).</lang>
=={{header|Haskell}}==
Using the built-in Software Transactional Memory in GHC.
<lang haskell>module Philosophers where
import Control.Monad
import Control.Concurrent
import Control.Concurrent.STM
import System.Random
-- TMVars are transactional references. They can only be used in transactional actions.
-- They are either empty or contain one value. Taking an empty reference fails and
-- putting a value in a full reference fails. A transactional action only succeeds
-- when all the component actions succeed, else it rolls back and retries until it
-- succeeds.
-- The Int is just for display purposes.
type Fork = TMVar Int
newFork :: Int -> IO Fork
newFork i = newTMVarIO i
-- The basic transactional operations on forks
takeFork :: Fork -> STM Int
takeFork fork = takeTMVar fork
releaseFork :: Int -> Fork -> STM ()
releaseFork i fork = putTMVar fork i
type Name = String
runPhilosopher :: Name -> (Fork, Fork) -> IO ()
runPhilosopher name (left, right) = forever $ do
putStrLn (name ++ " is hungry.")
-- Run the transactional action atomically.
-- The type system ensures this is the only way to run transactional actions.
(leftNum, rightNum) <- atomically $ do
leftNum <- takeFork left
rightNum <- takeFork right
return (leftNum, rightNum)
putStrLn (name ++ " got forks " ++ show leftNum ++ " and " ++ show rightNum ++ " and is now eating.")
delay <- randomRIO (1,10)
threadDelay (delay * 1000000) -- 1, 10 seconds. threadDelay uses nanoseconds.
putStrLn (name ++ " is done eating. Going back to thinking.")
atomically $ do
releaseFork leftNum left
releaseFork rightNum right
delay <- randomRIO (1, 10)
threadDelay (delay * 1000000)
philosophers :: [String]
philosophers = ["Aristotle", "Kant", "Spinoza", "Marx", "Russel"]
main = do
forks <- mapM newFork [1..5]
let namedPhilosophers = map runPhilosopher philosophers
forkPairs = zip forks (tail . cycle $ forks)
philosophersWithForks = zipWith ($) namedPhilosophers forkPairs
putStrLn "Running the philosophers. Press enter to quit."
mapM_ forkIO philosophersWithForks
-- All threads exit when the main thread exits.
getLine
</lang>
=={{header|Python}}==
| |||