哲学者

無限ループなのになぜか終了してしまうという問題は、id:mzp に、最後の forkOS を消せばいいとアドバイスされて解決されました。サンクス。
うむ、たしかに親は子の終了を待たないってどっかに書いてあったな。なんで気がつかなかったんだろう。
あと Concurrent Haskell では、全てのスレッドが MVar を読もうとして止まると、それを検出してプロセスを止めてくれるようです。

% ./philo
"OK! (1)"
"OK! (1)"
"OK! (1)"
(略)
"OK! (3)"
"OK! (2)"
"OK! (1)"
"OK! (4)"
"OK! (3)"
"OK! (2)"
philo: thread blocked indefinitely

%  

止められる fib

これまた適当に書きました。sfib が汚い。フィボナッチ数を裏で計算している途中で何かキーを入力すると、計算が止まります。(しばらく待ってても結果が出力されないことで確認できます)

でも、計算を止めないとなぜかデッドロックする模様。はて。

import Control.Concurrent
import Control.Monad (mzero, liftM2)

main = do putStrLn "Enter number: "
          n <- getLine
          stopper <- newMVar False
          forkIO $ fib (read n) stopper
          putStrLn "Press any key to stop calculation."
          getChar
          putMVar stopper True
          putStrLn "Now thread stops."
          getChar
          return ()
fib n s = do result <- sfib n s
             print result
             putStrLn "Complete!"
             return ()
sfib :: Int -> MVar Bool -> IO (Maybe Int)
sfib n s = do s' <- readMVar s
              if s' then return mzero
                    else if n < 1 then return $ return 1
                                  else do a <- sfib (n-1) s
                                          b <- sfib (n-2) s
                                          return $ liftM2 (+) a b

止めた場合。

% ./sfib
Enter number: 
25
Press any key to stop calculation.

Now thread stops.

%

止めなかった場合。

% ./sfib
Enter number: 
25
Press any key to stop calculation.
Just 196418
Complete!

sfib: thread blocked indefinitely

% 

止められる fib その2

killThread という関数を使えば、別に Maybe とかで頑張らなくてもいいね。

main = do putStrLn "Enter number: "
          n <- getLine
          id <- forkIO $ fib (read n)
          putStrLn "Press any key to stop calculation."
          getChar
          killThread id
          putStrLn "Now thread stops."
          getChar
          return ()
fib n = print $ fib' n
fib' n | n < 1 = 1
       | otherwise = fib' (n-1) + fib' (n-2)