为了熟悉 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
当我编译并运行我的解决方案时,似乎不存在明显的并发问题:每个哲学家最终都会吃饭,并且似乎没有哲学家受到青睐。但是,如果我从 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...
这种情况发生了什么?
最佳答案
您需要使用线程运行时编译它并启用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...
要点是,对于另一个哲学家思考/吃饭,如果您没有多个硬件线程可供使用,则必须发生上下文切换。这种上下文切换在这里并不经常发生,因为没有进行太多分配,因此每个哲学家在轮到下一个哲学家之前都有很多时间思考和吃很多东西。
有了足够多的线程可供使用,所有哲学家都可以同时尝试去拿 fork 。
关于haskell - 以下 "Dining Philosophers"的解决方案有什么问题?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/12203655/