Commit c9daeeeb authored by Yuanle Song's avatar Yuanle Song
Browse files

add Dining2.hs 

stm for this problem is quite easy, you don't need to worry about orders of
the locks.
parent aa03ccd2

concurrency-demo.cabal

+14 −1
Original line number Diff line number Diff line
@@ -34,5 +34,18 @@ executable dining1 
      base >=4.7 && <5

    , random

  other-modules:

      Paths_concurrency_demo

      Lib

  default-language: Haskell2010



executable dining2

  main-is: Dining2.hs

  hs-source-dirs:

      src

  ghc-options: -threaded -rtsopts -with-rtsopts=-N

  build-depends:

      base >=4.7 && <5

    , random

    , stm

  other-modules:

      Lib

  default-language: Haskell2010

operational

+9 −0
Original line number Diff line number Diff line
@@ -20,7 +20,16 @@ https://en.wikipedia.org/wiki/Dining_philosophers_problem 


  may deadlock if not well designed.



  implemented in ./src/Dining1.hs



- use haskell STM



  still have no idea when and how to use it.



  Parallel and Concurrent Programming in Haskell

  http://chimera.labs.oreilly.com/books/1230000000929/ch10.html



  quite easy to implement.



* done                                                                :entry:

* wontfix                                                             :entry:

src/Dining1.hs

+1 −16
Original line number Diff line number Diff line 
import System.Random

import Control.Concurrent

import Control.Concurrent.MVar

import Control.Monad (forever)



-- | return microseconds between [0, 5s]

randomMicroseconds :: IO Int

randomMicroseconds = randomRIO (0, 5 * 1000000)



think :: String -> IO ()

think name = do

  putStrLn $ "Philosopher " ++ name ++ " is thinking"

  delayAmout <- randomMicroseconds

  threadDelay delayAmout



eat :: String -> IO ()

eat name = do

  putStrLn $ "Philosopher " ++ name ++ " is eating"

  delayAmout <- randomMicroseconds

  threadDelay delayAmout

import Lib



pickFork :: MVar String -> String -> IO String

pickFork fork name = do

src/Dining2.hs

0 → 100644
+33 −0
Original line number Diff line number Diff line 
import System.Random

import Control.Monad (forever)

import Control.Concurrent.STM

import Control.Concurrent (forkIO)



import Lib



createPhilosopher :: String -> TMVar String -> TMVar String -> IO ()

createPhilosopher name fork1 fork2 = forever $ do

  think name

  (fork1Name, fork2Name) <- atomically $ do

    fork1Name <- takeTMVar fork1

    fork2Name <- takeTMVar fork2

    return (fork1Name, fork2Name)

  putStrLn $ "Philosopher " ++ name ++ " pick " ++ fork1Name ++ " and " ++ fork2Name

  eat name

  atomically $ do

    putTMVar fork1 fork1Name

    putTMVar fork2 fork2Name

  putStrLn $ "Philosopher " ++ name ++ " put " ++ fork1Name ++ " and " ++ fork2Name



main = do

  fork1 <- newTMVarIO "fork1"

  fork2 <- newTMVarIO "fork2"

  fork3 <- newTMVarIO "fork3"

  fork4 <- newTMVarIO "fork4"

  fork5 <- newTMVarIO "fork5"

  forkIO $ createPhilosopher "P1" fork5 fork1

  forkIO $ createPhilosopher "P2" fork1 fork2

  forkIO $ createPhilosopher "P3" fork2 fork3

  forkIO $ createPhilosopher "P4" fork3 fork4

  forkIO $ createPhilosopher "P5" fork4 fork5

  readLn :: IO String

src/Lib.hs

0 → 100644
+20 −0
Original line number Diff line number Diff line 
module Lib where



import System.Random (randomRIO)

import Control.Concurrent (threadDelay)



-- | return microseconds between [0, 5s]

randomMicroseconds :: IO Int

randomMicroseconds = randomRIO (0, 5 * 1000000)



think :: String -> IO ()

think name = do

  putStrLn $ "Philosopher " ++ name ++ " is thinking"

  delayAmout <- randomMicroseconds

  threadDelay delayAmout



eat :: String -> IO ()

eat name = do

  putStrLn $ "Philosopher " ++ name ++ " is eating"

  delayAmout <- randomMicroseconds

  threadDelay delayAmout