5

Haskell の STM に慣れるために、食事の哲学者の問題に対する次の解決策を書きました。

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

ソリューションをコンパイルして実行すると、明らかな並行性の問題はないように見えます。各哲学者は最終的に食べてしまい、どの哲学者も支持されないようです。ただし、randomDelayステートメントを から削除しphilosopher、コンパイルして実行すると、プログラムの出力は次のようになります。

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...

この場合、何が起こっていますか?

4

1 に答える 1

5

スレッド化されたランタイムと enabledrtsoptsでコンパイルし、 +RTS -N(または+RTS -Nkwherekはスレッドの数) で実行する必要があります。それにより、次のような出力が得られます

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...

ポイントは、別の哲学者が考えたり食べたりするためには、処分するハードウェアスレッドがいくつかない場合、コンテキストの切り替えが発生する必要があるということです。このようなコンテキストの切り替えは、割り当てがあまり行われていないここではあまり頻繁に発生しないため、各哲学者には、次の番が来る前に考えてたくさん食べる時間がたくさんあります。

自由に使える十分なスレッドがあれば、すべての哲学者が同時にフォークに到達しようとすることができます。

于 2012-08-30T19:13:18.610 に答える