2012-08-30 38 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调用,则这很重要。 –