Control.DeepSeq を使用して正格評価

Haskell

本記事はfoldのアルゴリズムに対する理解がめちゃくちゃだったんで修正記事作りました。(2012/06/25)

モンテカルロ法で円周率を計算するために多数のIOから取り出した結果の集計を行おうとした。

しかし未評価thunkによるメモリオーバーフローが発生し、インスタンス数を増やせなかった。途中でわざとprintを行なって未評価thunkを潰してメモリリークを防いでいたのだがもちろんこれは本質的な解決ではない。

また、Bang-Patternを使用して未評価thunkを潰そうとしたが、どうもthunkが潰れてくれない。

調べてみたところ、厳密な正格評価にはControl.DeepSeqが使用できることがわかったので試して見ることにした。

 

まず、リークを起こすコードの説明から。

-- Simple example for Bang-Patterns leak
import Control.Monad
import Data.Foldable ( foldr' )
import System.IO

main :: IO ()
main = do
    result <- takeStat (return 100) 10000000
    print $ "result is " ++ show result

takeStat :: IO Int -> Int -> IO Int
takeStat io count =
    foldr' (liftM2 (+)) (return 0) $ replicate count io

実行するとメモリオーバーフローで落ちる。 そこで、DeepSeqを使用したコードに修正する。

takeStat :: IO Int -> Int -> IO Int
takeStat io count =
    foldr'' (liftM2 (+)) (return 0) $ replicate count io

instance NFData a => NFData (IO a) where
    rnf x = rnf $ unsafePerformIO x

foldr''  :: NFData b => (a->b->b) -> b-> [a] -> b
foldr'' folder init           = init
foldr'' folder init (head:tail) =
    (foldr'' folder $!! (folder head init)) tail

NFDataクラスはDeepSeqモジュールの正格評価を適用できるデータのクラス。$!!はBang-Patternsにおける$!に相当する。引数を(Bang PatternsにおけるWHNFではなく、)値になるまで評価する。

foldを自分で書くクソダサさとIOを今更(しかも無理に)インスタンス化したり、無茶しまくっている、、、 でも、確かにコレで落ちない。

Bang Pattern的には下記なら大丈夫な感じがしてしまうが、やっぱりメモリ不足でおちちゃう。なぜダメなんだろうなぁ。

takeStat :: IO Int -> Int -> IO Int
takeStat io count =
    return $ foldr' (+).unsafePerformIO 0 $ replicate count $ unsafePerformIO io
参考：【まとめ】Haskellでの正格評価とWHNF
http://kamonama.blogspot.jp/2011/04/haskellwhnf.html

補足：

$ ghc --version
The Glorious Glasgow Haskell Compilation System, version 7.4.1
$ ghc -O Recursion.hs
[1 of 1] Compiling Main             ( Recursion.hs, Recursion.o )
Linking Recursion.exe ...

追記：

IOをインスタンス化するのはやっぱ嫌なのでどうせunsafePerformIOつかうなら下記がいいかな、、、

takeStat :: IO Int -> Int -> IO Int
takeStat io count =
    return $ foldr'' ((+).unsafePerformIO) 0 $ replicate count io

foldr''  :: NFData b => (a->b->b) -> b-> [a] -> b
foldr'' folder init           = init
foldr'' folder init (head:tail) =
    (foldr'' folder $!! folder head init) tail

追記２：

foldr'の根本にforceを挿してみたがこれもダメ。Bang Patternsがちゃんと動いていないのでは？

takeStat :: IO Int -> Int -> IO Int
takeStat io count =
    return $ (foldr' . force) ((+).unsafePerformIO) 0 $ replicate count io