正格評価がうまく動かない？

モンテカルロ法で円周率計算、みたいな話がちょろっと降ってきたので任意精度で計算できるようなコードをHaskellで書いてみたのだがループの中でどうもスペースリークしている。もう少しいうと、集計用の畳み込み関数が未評価のまま残ってしまうようだ。

    
main :: IO ()
main = do
    (count,total)  Int -> IO Stat
takeStat func count =
    let c   = \(x1,y1)(x2,y2) -> (x1+x2,y1+y2)
        f   = \ (x,_) -> if x then (1,1) else (0,1)
    in
    foldRN c (liftM f func) count (0,0)

みたくして、foldRN関数を次のように。(unsafePerformIOは見逃してw)

foldRN :: (Show a)=> (a->a->a) -> IO a -> Int -> a -> IO a
foldRN folder m count init =
    let foldRN_sub folder m count v
        | count == 0 = v
        | otherwise  =
            let r = unsafePerformIO $ do
                when ((count `mod` 100000) == 0) $ do
                    putStrLn $ "v: " ++ show v ++ " count: " ++ show count
                    hFlush stdout
                m
            in
            foldRN_sub folder m (count -1) $! folder v r
    in return $ foldRN_sub folder m count init

これ、whenがないとスペースリークで死んでしまう。 再帰関数のtail-recursionでBangによってthunkを潰してるはずなのに。。。 なぜ、、、、 あとMonoid使わねーの？という指摘がありましたら甘んじて受けます。