Was ist los mit der folgenden Lösung für die "Dining Philosophers"?

Question

Um mit STM in Haskell vertraut zu machen, schrieb ich die folgende Lösung für die Gastronomie Philosophen Problem:

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 

Wenn ich kompilieren und meine Lösung laufen, scheint es, dass keine offensichtlichen Concurrency Probleme bestehen: Jeder Philosoph wird schließlich essen und kein Philosoph scheint begünstigt zu sein. Allerdings, wenn ich die randomDelay Aussagen von philosopher entfernen, kompilieren und ausführen, sieht die Ausgabe von meinem Programm wie folgt aus:

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

Was in diesem Fall geschieht?

Answer 1

Sie müssen sie mit der Gewindelaufzeit kompilieren und aktiviert rtsopts, und führen Sie es mit +RTS -N (oder +RTS -Nk wo k die Anzahl der Threads ist. Damit ich Ausganges wie

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

Der Punkt ist, dass ein anderer Philosoph denken/essen muss, muss ein Kontextwechsel passieren, wenn Sie nicht mehrere Hardware-Threads zur Verfügung haben.Ein solcher Kontextwechsel passiert hier nicht sehr oft, wo nicht viel Zuteilung gemacht wird, so hat jeder Philosoph viel Zeit zu denken und viel zu essen, bevor der nächste an die Reihe kommt

Mit genügend Fäden zur Verfügung, können alle Philosophen gleichzeitig versuchen, nach den Gabeln zu greifen.