Haskell の並列処理と遅延評価の罠

2017年 08月 24日

少し前までは Haskell はインストールが非常に手間がかかる上に、ライブラリ類のバージョン整合性をとるのが非常に困難なのが大きな欠点だったのだが、 Stack なるビルドツールが現れてからはその点が一気に解消されて大変便利になった。コンパイル時に様々な問題を一気に洗い出してくれる Haskell は、書いている自分でも驚くほど正しく動くし、変更にも強い。言語の選択はもちろん適材適所なので一概には言えないが、堅牢なプログラムを素早く書くという観点ではお勧めできる言語だ。

しかし一方で、Haskell で書かれたプログラムにはパフォーマンスバグ（時間、空間、あるいはその両方）が含まれていることも多い。ビルドさえできればたいてい「正しく動く」が、意図したパフォーマンスが得られなかったり、余計なメモリを消費し続けたりといったことでは片手落ちである。

今回は、そんななかでも並列プログラミングを行う場合に遅延評価が問題となる例とその解決法を紹介する。

サンプルプログラム

プロジェクト作成

とりあえず、並列処理を行うサンプルのプロジェクトを作成しよう。問題を理解するには実際にコードを変更して実行しながら確認するのが早い。 Stack 自体はインストール済みとして、まずプロジェクトを作成する。

$ stack new cphaskell simple

これでさくっとプロジェクトを作ってくれるのだから便利になったもんだ。今回は並列プログラミングを行うので、 GHC の場合マルチコアを活用するにはコンパイルオプション -threaded を指定する必要がある。それと、これだけでは足りなくて、ビルド後のプログラムのランタイムにもさらにマルチコアを活用する指示をしなければならない。ビルド後のプログラムを実行する際に program +RTS -N -RTS などとすれば良いが、実行するごとにいちいち付けるのも面倒なのでコンパイル時に埋め込んでおこう。GHC に -with-rtsopts=-N を知らせれば、ランタイムオプション -N を埋め込んだ状態でビルドしてくれる。 cphaskell.cabal を開いて、 ghc-options を追記しよう。

executable cphaskell
  hs-source-dirs:      src
  main-is:             Main.hs
  default-language:    Haskell2010
  ghc-options:         -threaded -with-rtsopts=-N
  build-depends:       base >= 4.7 && < 5

この辺少々面倒だし、今時マルチコアプロセッサが主流なのだからデフォルトでマルチスレッド版でも良いんじゃないかと個人的には思うのだが、とはいえプログラムによっては安易にマルチスレッド化するとむしろパフォーマンス劣化を引き起こすこともあるので、まだ難しいところだろうか。

プログラム作成

さくっと（問題が含まれる）サンプルプログラムを紹介する。 src/Main.hs は以下の通りだ。

module Main where

import Control.Monad
import Control.Concurrent
import Control.DeepSeq

heavyWork :: Integer -> Integer
heavyWork n = sum [1..n*5000000]

main :: IO ()
main = do
  out <- newChan

  forM_ [1..20] $ \i -> forkIO $
    writeChan out $ heavyWork i

  replicateM_ 20 $ do
    res <- readChan out
    putStrLn $ show res

  putStrLn "Finished"

heavyWork は「時間がかかる計算」を示している。今回はサンプルなのでただたくさん足し算をするだけだ。問題を確認したいだけの小さなプログラムで何分も待つのはばかばかしいので、リストの要素数はお手頃な実行時間になるよう調整すると良いだろう。

main は forkIO を使って 20 個のスレッドを立ち上げ、各スレッドから送られてくる結果を Chan から取り出して表示する。

forkIO にて作られるスレッドは、 heavyWork の結果を Chan に書き込む。

全体としては、Producer が 20、 Consumer が 1 の Producer-Consumer パターンを実践するプログラムだと思えば良いだろう。さて、このプログラムのどこに問題があるのだろう？

実行

とりあえず実行してみよう。

$ stack build && stack exec cphaskell
... snip ...
50000005000000
12500002500000
112500007500000
312500012500000
612500017500000
1012500022500000
1512500027500000
2112500032500000
200000010000000
450000015000000
800000020000000
2812500037500000
1250000025000000
3200000040000000
1800000030000000
3612500042500000
5000000050000000
4050000045000000
2450000035000000
4512500047500000
Finished

おー、なんか順番バラバラだし並列実行されてるのかな？

うーん。微妙なところだが、「並行」実行はされている。なにしろ Control.Concurrent （並行制御）モジュールを使っているのだからそうあってもらわねば困るし、そういう意味では「正しく動いて」いる。だが、「並列」となると複数コアの性能を引き出すことが目的なわけで、その観点からするとどうもおかしい。実際に複数コアを持つ環境で CPU 使用率を確認していれば、どうやら複数コアをきちんと使っているとは思えない状況なことがわかる。4 コアな手元の環境では使用率 30% 程度なので、メインの仕事をしているのは恐らく 1 スレッドだけである（25% ではないのは、おそらく GC など内部処理が並列実行されるからだろう）。一体何が問題なのだろう？

遅延評価による問題

問題は、 Haskell の評価戦略が標準で非正格なことにある。Haskell の式は実際にそれが必要になるまで評価されないのが基本だ。問題のコードは以下の部分である。

writeChan out $ heavyWork i

この writeChan は out に対して何を書き込むのか？それは、未評価のサンク heavyWork i そのものである。

では、 Consumer たるメインスレッドの readChan は何を読み込むのか。

res <- readChan out

当然、 out に対して書き込まれた、未評価のサンク heavyWork i である。今 res は heavyWork i に束縛された状態だ。そして悲しいかな、次の行

putStrLn $ show res

で、 res 即ち heavyWork i が必要となり、ここで初めて評価されるのだ。結局、 heavyWork i は、なんとメインスレッドで計算されているのである。道理でマルチコアを使っているようには見えないわけだ。

解決

問題を解決するには、 heavyWork i をメインスレッドではなく各ワーカースレッドに計算させればよい。それを指示するためには、評価を強制する seq を使う。

seq :: a -> b -> b

これは、 seq 式が評価されたとき、第一引数もまた WHNF (Weak Head Normal Form / 弱頭部正規形) まで評価された状態となることを保証する。（ドキュメントには pseq と絡んで評価順序に関する注意事項がある。今はあまり気にしなくてよい。このことは par や pseq を使うときに思い出そう。）

seq は Prelude に含まれているので、特に何か import する必要なく利用可能だ。これを使って次のようにすれば問題は解決する。

let r = heavyWork i
in r `seq` writeChan out r

これで writeChan out r が評価されたとき、 r 即ち heavyWork i も評価される。従って heavyWork i はワーカースレッド上で行われる。再実行してみれば CPU 使用率が 100% 弱まで上がり（複数コア時に使用率 100% を超えて表示するシステムなら、例えば 400% 弱などとなるだろう）、実行時間も短縮されることが確認できるはずだ。

なお seq の亜種として ($!) 演算子も用意されている。

($!) :: (a -> b) -> a -> b
f $! x = x `seq` f x

つまりこのようにすれば良い。

writeChan out $! heavyWork i

こちらのほうが元のプログラムに近く、分かりやすいだろう。

サンプルプログラムの微修正

だがまだ罠がある。 WHNF とは何か、ということを理解していないと seq や ($!) では不足することがある。例えば今のプログラムを次のように変更してみよう。

main :: IO ()
main = do
  out <- newChan

  forM_ [1..20] $ \i -> forkIO $
    writeChan out $! (i, heavyWork i)

  replicateM_ 20 $ do
    (i, res) <- readChan out
    putStrLn $ show i ++ ": " ++ show res

  putStrLn "Finished"

修正点は結果表示に i も含めるようにしただけだ。元のプログラムだと、並行処理を行うがゆえに結果の順序が一定しないので、どの結果がどの入力のものなのかわからない状態だった。しかし一般的にはどの結果がどの入力に対応するものなのか知りたいだろう。そんなわけで、 i の値も一緒に返すようにしてみたというわけだ。

だが、これでまたマルチコアを利用できない状態に逆戻りしてしまう。 writeChan out には ($!) も使っているのに、一体なぜ？

WHNF とは

WHNF (Weak Head Normal Form / 弱頭部正規形) とは、以下のいずれか状態のことを言う。

最も外側がデータコンストラクタ
例： 1、 'A'、 True、 Just (1 + 2) など
最も外側が適用可能な引数を持つ関数
例： head、 drop (1 + 2)、 \x -> x * 2 など

1 や 'A' 、 True などはこれ以上評価できないので、 NF (Normal Form / 正規形) でもある。一方、 Just (1 + 2) は、 (1 + 2) の部分が 3 まで評価可能なので NF ではないが、外側がデータコンストラクタ Just なので WHNF ではある。未評価のサンクを含んだままでも、 WHNF ではあることに注意しよう。

問題点

WHNF が何なのかがわかれば先のプログラムの問題もわかる。問題はやはり次の行だ。

writeChan out $! (i, heavyWork i)

思い出すべきことは次の点だ。

seq や ($!) は WHNF まで評価する
タプル (a, b) は、 (,) a b の中置記法である
(i, heavyWork i) は、この状態で WHNF である (∵外側がデータコンストラクタ (,) なので）

seq や ($!) は、あくまで WHNF までしか評価しない。ということは、結局タプルの内側にある heavyWork i は、またしても未評価サンクのまま Chan に書き込まれてしまうのだ。なんてこった。

解決1: seq で頑張る

この問題ももちろん seq で解決できる。

let r = heavyWork i
in r `seq` writeChan out (i, r)

タプルの内側の r が評価されてほしいわけだから、それを seq に通してやればよい。

失敗例1-a

しかし、一発で先の解答にたどり着くには少々経験が必要だ。まずやる失敗は以下のようなものだ。

let r = heavyWork i
in writeChan out $! (i, r `seq` r)

だがこれは意味がない。 seq は「 seq 式自身が評価されたとき」に第一引数も WHNF まで評価されるのであって、その式そのものの評価は遅延するのだ。確かに $! を使ってはいるが、先に説明した通り (i, seq r r) は既に WHNF であり、タプルの内側の seq r r は未評価のサンクのままである。一般に、 seq r r は r に等しい。

失敗例1-b

let r = heavyWork i
in writeChan out $ r `seq` (i, r)

もうひとつの失敗例は seq を内側に入れてしまうパターン。先と同じように、 seq r (i, r) という式自体が未評価サンクのままである。この形にしたいのであれば、 seq 自体が評価されるよう、 $ ではなく $! にしておかなければならない。

解決2: deepseq を使う

今回は 2 要素タプルで正格評価したいサンクはひとつだけなので seq でも良いが、一般的には多数のフィールドからなるデータ型や、リストのように再帰構造をしているデータ型もある。そうときはいちいちすべてのフィールドに対して seq で正格評価を指示していくのは大変だ。

そんなときのために、 Control.DeepSeq モジュールが用意されている。 import 文が必要なほか、パッケージが分かれているので .cabal ファイルの build-depends に deepseq を追記する必要があることも忘れないようにしよう。

build-depends:       base >= 4.7 && < 5
                   , deepseq

コードのほうは以下のようになる。

let r = (i, heavyWork i)
in r `deepseq` writeChan out r

名前の通り、データ構造の内側まで「deep に」 seq してくれるのが deepseq だ。 r はタプルで、それ自身 WHNF であった。従って seq を使った場合はその内側の heavyWork i は未評価サンクのままだったわけだが、 deepseq であれば内側まで正格評価してくれる。だたし、 deepseq の第一引数に指定可能なのは NFData クラスに属するデータ型だけであることに注意しよう。

ちなみに ($!) の deep 版 ($!!) もある。

writeChan out $!! (i, heavyWork i)

今回はこれのほうが分かりやすいだろう。

失敗例2

Control.DeepSeq には force なる亜種もある。

force :: NFData a => a -> a
force x = x `deepseq` x

これを使ってこうしたくなるかもしれない。

writeChan out $ force (i, heavyWork i)

だがこれも目的を達成しない。 force 式自身が未評価サンクのままとなるからだ。この形にするのであれば、失敗例1-bと同じく $ を $! にする必要がある。

解決3: BangPatterns 言語拡張を使う

GHC の言語拡張だが、 let !r = heavyWork i などとすることで正格評価を指示することもできる。言語拡張を問題なく利用可能なのであれば、恐らくこれが一番書きやすい。

let !r = heavyWork i
in writeChan out (i, r)

失敗例3

ただし deep ではないことに注意すること。以下は目的を達成しない。

let !r = (i, heavyWork i)
in writeChan out r

< 前の記事へ次の記事へ >

2025年1月22日

インターン体験記 2024！

#人事ブログ