この記事では、Haskell における セマフォを使った並行処理の実装方法を紹介します。
前回の記事では、Haskellで並行プログラムを開発するためのMVarとChanについて説明しました。今回は、並行処理
を達成するための別の方法であるセマフォについて話したいと思います。
バイナリセマフォ
セマフォは、原子的にインクリメントまたはデクリメントできるカウンタのようなもので、バイナリセマフォは1までしかカウント できないセマフォです。これは、ミューテックスロックのように機能し、同時に1つのスレッドしか実行できないようにするために 使用できます。
import Control.Concurrent
hello :: QSem -> IO ()
hello qSem = do
tid <- myThreadId
waitQSem qSem
print $! "Hello! "++show tid
signalQSem qSem
main :: IO ()
main = do
qSem <- newQSem 0
forkIO $ hello qSem
signalQSem qSemバイナリセマフォはQSemを使って実装できます。QSemはnewQSemを使って0または1で初期化でき、セマフォはsignalQSem
でインクリメントされ、waitQSemでデクリメントされます。
カウンティングセマフォ
カウンティングセマフォは、1の上限を持たないセマフォで、Chanの代わりに使用できます。Chanとは異なり、セマフォは
ループを使ってセマフォがn回インクリメントされるのを待つ必要がありません。カウンティングセマフォはQSemNを使って実装できます。
任意の正の値でnewQSemNを使って初期化され、signalQSemNでインクリメントされ、waitQSemNでデクリメントされます。
QSemとQSemNを使用することで、以下のように10のスレッドIDを出力する並行プログラムをリファクタリングできます。
getGreeting :: IO String
getGreeting = do
tid <- myThreadId
let greeting = "Hello from" ++ show tid
return $! greeting
hello :: QSem -> QSemN -> IO ()
hello mutexLock endFlags = do
greeting <- getGreeting
waitQSem mutexLock
putStrLn greeting
signalQSem mutexLock
signalQSemN endFlags 1
main :: IO()
main = do
hSetBuffering stdout NoBuffering
mutexLock <- newQSem 0
endFlags <- newQSemN 0
let n = 10
mapM_ (const $ forkIO $ hello mutexLock endFlags) [1..n]
signalQSem mutexLock
waitQSemN endFlags nデッドロック
MVar、Chan、およびセマフォは、並行プログラムを書くのに非常に便利ですが、これらすべてに影響を与える重大な問題
があります。それはデッドロックです。デッドロックは、ミューテックスが解放されるのを待ち続ける、チャンネルに書き込まれ
るのを待つ、またはセマフォがシグナルを受け取るのを待っているスレッドが全て永遠に待ち続ける状態です。次に示すのは、
デッドロックの最も簡単な例です。
hello :: QSem -> IO ()
hello qSem = do
tid <- myThreadId
waitQSem qSem
print $! "Hello! "++show tid
signalQSem qSem
main :: IO ()
main = do
qSem <- newQSem 0
let n = 10
mapM_ (const $ forkIO $ hello qSem) [1..n]上記のコードでは、QSemがインクリメントされるのを待っている10のスレッドが作成されますが、QSemをインクリメント
しようとしているスレッドが存在しないため、すべてのスレッドが停止してしまいます。このような明白なデッドロックは見
つけやすいですが、デッドロックは暗黙的に発生することもあります。以下にその例を示します。
hello1 :: MVar () -> MVar () -> IO ()
hello1 mVar1 mVar2 = do
tid <- myThreadId
takeMVar mVar1
takeMVar mVar2
print $! "Hello 1! "++show tid
putMVar mVar1 ()
putMVar mVar2 ()
hello2 :: MVar () -> MVar () -> IO ()
hello2 mVar1 mVar2 = do
tid <- myThreadId
takeMVar mVar2
takeMVar mVar1
print $! "Hello 2! "++show tid
putMVar mVar1 ()
putMVar mVar2 ()
main :: IO ()
main = do
mVar1 <- newEmptyMVar
mVar2 <- newEmptyMVar
let n = 5
mapM_ (const $ forkIO $ hello1 mVar1 mVar2) [1..n]
mapM_ (const $ forkIO $ hello2 mVar1 mVar2) [1..n]
putMVar mVar1 ()
putMVar mVar2 ()hello1とhello2関数はほとんど同じですが、MVarを取得する順序が異なります。このような状況では、hello1の1つの
スレッドがmVar1をロックし、hello2の別のスレッドがmVar2をロックしてから、もう一方のMVarをロックする前に両方
のスレッドが停止してしまうことがあります。これにより、他のスレッドもミューテックスが解放されるのを待って停止してしまいます。
このような小さなコードではありえないように見えるミスですが、より大きなコードベースでは頻繁に発生する可能性があります。
したがって、ミューテックス、チャンネル、セマフォを使用する際には非常に注意が必要です。あるいは、デッドロックの問題が発生 しない別の並行処理の方法を使用する必要があります。それについては次の記事で紹介します。
クイズ
この記事では、学習した内容を確認するためのクイズを設けます。記事のメイン部分を読んだ後に、ぜひ自分で問題を解いてみることを強くお勧めします。各問題をクリックすると答えが表示されます。
リソース
- Philipp, Hagenlocher. 2020. Haskell for Imperative Programmers #29 - Semaphores (QSem, QSemN). YouTube.