Haskell
ghc
遅延評価
ghc-extensions

Strict拡張でハマったお話

どうも、pxfncです。最近現実への疲れからか、純粋な関数が夢に出てくるようになりました。

前置きはさておき、問題のStrict拡張でハマった話をします。問題となるコードを簡略化して簡単なプログラムを用意しました。なお、環境はghc8.6.3です。


Main.hs

main = do

n <- readLn
print $ div10 n

div10 :: Int -> Int
div10 n | n == 0 = 0
| otherwise = result
where result = 10 `div` n


div10は10を引数の数字で割るような実装となっており、0で割られる時に0を返す実装になってます。

そして今回の問題なのですが、div10関数に0が渡った時に、Strict拡張なしでは0を返すのに対し、Strict拡張をつけてコンパイルしていた場合はdivide by zeroの例外が発生します(は?)。


Core言語でダンプして中身を読んでみた

ソース上では何も変化がないので、仕方なくCore言語のソースを比較することにしました。とりあえず通常のStrict言語拡張なしのソースをダンプしてみます。


Strict拡張なし

33   main :: IO ()

34 [GblId]
35 main
36 = >>=
37 @ IO
38 GHC.Base.$fMonadIO
39 @ Int
40 @ ()
41 (readLn @ Int GHC.Read.$fReadInt)
42 (\ (n_a10g :: Int) ->
43 $ @ 'GHC.Types.LiftedRep
44 @ Int
45 @ (IO ())
46 (print @ Int GHC.Show.$fShowInt)
47 (case == @ Int GHC.Classes.$fEqInt n_a10g (GHC.Types.I# 0#) of {
48 False ->
49 div @ Int GHC.Real.$fIntegralInt (GHC.Types.I# 10#) n_a10g;
50 True -> GHC.Types.I# 0#
51 }))

注目する部分は47行目からのcase式ですです。n_a10g0と等しい場合は0、そうでない場合はdiv関数に10n_a10gを渡してます。ほぼソースのままですね。

そしてこちらがStrict言語拡張をつけてコンパイルしたもをダンプしたものです。


Strict拡張あり

33   main :: IO ()

34 [GblId]
35 main
36 = >>=
37 @ IO
38 GHC.Base.$fMonadIO
39 @ Int
40 @ ()
41 (readLn @ Int GHC.Read.$fReadInt)
42 (\ (n_a10g :: Int) ->
43 case n_a10g of n1_X10k { GHC.Types.I# ipv_s2W7 ->
44 $ @ 'GHC.Types.LiftedRep
45 @ Int
46 @ (IO ())
47 (print @ Int GHC.Show.$fShowInt)
48 (case div @ Int GHC.Real.$fIntegralInt (GHC.Types.I# 10#) n1_X10k
49 of result_a10i
50 { GHC.Types.I# ipv1_s2Wa ->
51 case == @ Int GHC.Classes.$fEqInt n1_X10k (GHC.Types.I# 0#) of {
52 False -> result_a10i;
53 True -> GHC.Types.I# 0#
54 }
55 })
56 })

上から辿っていくと、48行目でdivが呼ばれてしまっています。肝心の0であるかの分岐は51行目から行われています。

この実行結果から推測すると、あれ、ローカルの束縛がcaseによって強制評価されてるんじゃねということです。


ローカルの束縛を遅延してみる

そもそもBangPatternsなどでパターンマッチがWHNFまで評価できることは知っていたのですが、まさかローカルの束縛が正格に評価されてるのは想像もしていませんでした。そこでもう一つ疑問に思ったのが、ローカルの束縛がパターンマッチなら正格!にも遅延~にもできるんじゃないか?ということで、先ほどのソースのresultを遅延評価させ、Core言語も出力してみます。


resultを遅延させたコード

{-# LANGUAG Strict #-}

main = do
n <- readLn
print $ div10 n

div10 :: Int -> Int
div10 n | n == 0 = 0
| otherwise = result
where ~result = 10 `div` n -- なぜかコンパイル通る


そしてダンプした結果がこちら


Strict拡張あり

33   main :: IO ()

34 [GblId]
35 main
36 = >>=
37 @ IO
38 GHC.Base.$fMonadIO
39 @ Int
40 @ ()
41 (readLn @ Int GHC.Read.$fReadInt)
42 (\ (n_a10g :: Int) ->
43 case n_a10g of n1_X10k { GHC.Types.I# ipv_s2W9 ->
44 $ @ 'GHC.Types.LiftedRep
45 @ Int
46 @ (IO ())
47 (print @ Int GHC.Show.$fShowInt)
48 (case == @ Int GHC.Classes.$fEqInt n1_X10k (GHC.Types.I# 0#) of {
49 False ->
50 div @ Int GHC.Real.$fIntegralInt (GHC.Types.I# 10#) n1_X10k;
51 True -> GHC.Types.I# 0#
52 })
53 })

予想通りうまくいってしまいました。resultがlazy-patternになったことによってcaseによる強制評価が発生しなくなり、0と等しいかどうかで分岐してからdiv10が呼ばれているようです。ヤッタネ


いやいやまずいでしょ

そうなんです。忘れないといってる人に限って忘れるんですよ。

訓練されたHaskellerは遅延評価に知らずのうちに慣れているものなので、気づかぬところで罠にはまってしまいます。例えばこちら

import           System.IO.Unsafe               ( unsafePerformIO )

import Control.Concurrent ( threadDelay )

main = do
-- 激重な計算をエミューレートしました
let heavyValue = unsafePerformIO $ threadDelay 5000000 >> return 1

let lightValue = 2

print $ if True then lightValue else heavyValue

通常ならheavyValueを評価しないのですぐに値が表示されて終了しますが、Strict拡張をつけるだけでこのプログラムは5秒間スレッドスリープしてしまいます。使わないとわかっているようなheavyValueさえ評価されてしまうのです。

こちらも同様に~heavyValueというようにすることによってこの問題は解決できます。


まとめ


  • Strict拡張を入れた時にはローカルの束縛は必ず評価されてしまうので気をつけましょう。