どうも、pxfncです。最近現実への疲れからか、純粋な関数が夢に出てくるようになりました。
前置きはさておき、問題のStrict拡張でハマった話をします。問題となるコードを簡略化して簡単なプログラムを用意しました。なお、環境はghc8.6.3です。
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言語拡張なしのソースをダンプしてみます。
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_a10gが0と等しい場合は0、そうでない場合はdiv関数に10とn_a10gを渡してます。ほぼソースのままですね。
そしてこちらが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言語も出力してみます。
{-# LANGUAG Strict #-}
main = do
n <- readLn
print $ div10 n
div10 :: Int -> Int
div10 n | n == 0 = 0
| otherwise = result
where ~result = 10 `div` n -- なぜかコンパイル通る
そしてダンプした結果がこちら
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拡張を入れた時にはローカルの束縛は必ず評価されてしまうので気をつけましょう。
※追記
今回のケース以外にもStrict拡張にはハマりポイントがあるのですが、それをまとめた記事があるので、もっとStrictわかりたい！な人はこちらをどうぞ！