2012-08-30 78 views
5

爲了熟悉哈斯克爾STM,我寫了下面的解決哲學家就餐問題:以下解決方案「Dining Philosophers」有什麼問題?

import Control.Concurrent 
import Control.Concurrent.STM 
import Control.Monad 
import System.Random 

type Fork = TVar Bool 
type StringBuffer = TChan String 

philosopherNames :: [String] 
philosopherNames = map show ([1..] :: [Int]) 

logThinking :: String -> StringBuffer -> STM() 
logThinking name buffer = writeTChan buffer $ name ++ " is thinking..." 

logEating :: String -> StringBuffer -> STM() 
logEating name buffer = writeTChan buffer $ name ++ " is eating..." 

firstLogEntry :: StringBuffer -> STM String 
firstLogEntry buffer = do empty <- isEmptyTChan buffer 
          if empty then retry 
            else readTChan buffer 

takeForks :: Fork -> Fork -> STM() 
takeForks left right = do leftUsed <- readTVar left 
          rightUsed <- readTVar right 
          if leftUsed || rightUsed 
          then retry 
          else do writeTVar left True 
            writeTVar right True 

putForks :: Fork -> Fork -> STM() 
putForks left right = do writeTVar left False 
         writeTVar right False 

philosopher :: String -> StringBuffer -> Fork -> Fork -> IO() 
philosopher name out left right = do atomically $ logThinking name out 
            randomDelay 
            atomically $ takeForks left right 
            atomically $ logEating name out 
            randomDelay 
            atomically $ putForks left right 

randomDelay :: IO() 
randomDelay = do delay <- getStdRandom(randomR (1,3)) 
       threadDelay (delay * 1000000) 

main :: IO() 
main = do let n = 8 
      forks <- replicateM n $ newTVarIO False 
      buffer <- newTChanIO 
      forM_ [0 .. n - 1] $ \i -> 
       do let left = forks !! i 
        right = forks !! ((i + 1) `mod` n) 
        name = philosopherNames !! i 
       forkIO $ forever $ philosopher name buffer left right 

      forever $ do str <- atomically $ firstLogEntry buffer 
         putStrLn str 

當我編譯和運行我的解決方案,似乎不存在明顯的併發問題:每個哲學家會最終吃掉,沒有哲學家似乎被青睞。但是,如果我從philosopher刪除randomDelay聲明,編譯和運行,我的程序的輸出如下所示:

1 is thinking... 
1 is eating... 
1 is thinking... 
1 is eating... 
2 is thinking... 
2 is eating... 
2 is thinking... 
2 is eating... 
2 is thinking... 
2 is eating... 
2 is thinking... 

About 2500 lines later... 

2 is thinking... 
2 is eating... 
2 is thinking... 
3 is thinking... 
3 is eating... 
3 is thinking... 
3 is eating... 

And so on... 

什麼在這種情況下是怎麼回事?

+0

如果這是家庭作業,請添加作業選項卡。 – Gray

+0

這不是作業,我在真實世界的Haskell上看過STM,我正在努力熟悉它。 – Alexandros

+0

與我的設置(Debian 6 Testing,ghc 7.4.1,runhaskell/ghc -O2 --make philosophers.hs)我認爲我沒有問題 - 哲學家1.8正在進食和思考每個輪到它。你的ghc版本是什麼,你正在編譯或使用ghci嗎? – epsilonhalbe

回答

5

您需要用螺紋運行時編譯並啓用rtsopts,並與+RTS -N(或+RTS -Nk其中k是線程數運行它。就這樣,我得到的輸出喜歡

8 is eating... 
6 is eating... 
4 is thinking... 
6 is thinking... 
4 is eating... 
7 is eating... 
8 is thinking... 
4 is thinking... 
7 is thinking... 
8 is eating... 
4 is eating... 
4 is thinking... 
4 is eating... 
6 is eating... 
4 is thinking... 

的一點是對另一個哲學家來說,如果你在你的處置中沒有多個硬件線程,就必須發生上下文切換,這種上下文切換在這裏並不經常發生,因爲沒有太多的分配完成,所以每個哲學家都有在下一個回合出現之前有很多時間去思考和吃很多東西。

在你的處置中有足夠的線程,所有哲學家可以同時嘗試伸展叉子。

+0

使用'+ RTS -N9'(每個哲學家8個線程,主線程1個,寫入'stdout'),似乎有兩位哲學家壟斷CPU一段時間。 – Alexandros

+4

你有多少個核心?與硬件功能相比,無法同時運行更多的線程,因此如果您擁有雙核心機器,則不超過兩位哲學家可以隨時競爭叉子。 –

+0

最好將'-Nk'看作是控制要使用的內核數量而不是OS線程數量。在其他情況下,如果您使用'forkOS'或進行FFI調用,則這很重要。 –

相關問題