遅延評価とbang!

以下GHC7.10.1です。

GHCにはBangPatternsという拡張があります。

このBangPatternsを使うとSTGがどうなるか調べました。

これが

{-# LANGUAGE BangPatterns #-}

fact :: Int -> Int -> Int
fact acc 1 = acc
fact acc n = fact (acc * n) (n - 1)
{-# NOINLINE fact #-}

fact_bang :: Int -> Int -> Int
fact_bang acc 1 = acc
fact_bang !acc n = fact_bang (acc * n) (n - 1)
{-# NOINLINE fact_bang #-}


main :: IO ()
main = do
    print $ fact 1 100
    print $ fact_bang 1 100

こうなる

fact_rou :: GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Int
[GblId, Arity=2, Str=DmdType, Unf=OtherCon []] =
    sat-only \r srt:SRT:[rhy :-> GHC.Num.$fNumInt,
                         rou :-> fact_rou] [acc_s1bM ds_s1bN]
        case ds_s1bN of wild_s1bO {
          GHC.Types.I# ds1_s1bP [Occ=Once!] ->
              case ds1_s1bP of _ [Occ=Dead] {
                __DEFAULT ->
                    let {
                      sat_s1bT [Occ=Once] :: GHC.Types.Int
                      [LclId, Str=DmdType] =
                          \u srt:SRT:[rhy :-> GHC.Num.$fNumInt] []
                              let {
                                sat_s1bS [Occ=Once] :: GHC.Types.Int
                                [LclId, Str=DmdType] =
                                    NO_CCS GHC.Types.I#! [1];
                              } in  GHC.Num.- GHC.Num.$fNumInt wild_s1bO sat_s1bS; } in
                    let {
                      sat_s1bR [Occ=Once] :: GHC.Types.Int
                      [LclId, Str=DmdType] =
                          \u srt:SRT:[rhy :-> GHC.Num.$fNumInt] []
                              GHC.Num.* GHC.Num.$fNumInt acc_s1bM wild_s1bO;
                    } in  fact_rou sat_s1bR sat_s1bT;
                1 -> acc_s1bM;
              };
        };

fact_bang_rpv :: GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Int
[GblId, Arity=2, Str=DmdType, Unf=OtherCon []] =
    sat-only \r srt:SRT:[rhy :-> GHC.Num.$fNumInt,
                         rpv :-> fact_bang_rpv] [acc_s1bC ds_s1bD]
        case ds_s1bD of wild_s1bE {
          GHC.Types.I# ds1_s1bF [Occ=Once!] ->
              case ds1_s1bF of _ [Occ=Dead] {
                __DEFAULT ->
                    case acc_s1bC of acc1_s1bH {
                      GHC.Types.I# _ [Occ=Dead] ->
                          let {
                            sat_s1bL [Occ=Once] :: GHC.Types.Int
                            [LclId, Str=DmdType] =
                                \u srt:SRT:[rhy :-> GHC.Num.$fNumInt] []
                                    let {
                                      sat_s1bK [Occ=Once] :: GHC.Types.Int
                                      [LclId, Str=DmdType] =
                                          NO_CCS GHC.Types.I#! [1];
                                    } in  GHC.Num.- GHC.Num.$fNumInt wild_s1bE sat_s1bK; } in
                          let {
                            sat_s1bJ [Occ=Once] :: GHC.Types.Int
                            [LclId, Str=DmdType] =
                                \u srt:SRT:[rhy :-> GHC.Num.$fNumInt] []
                                    GHC.Num.* GHC.Num.$fNumInt acc1_s1bH wild_s1bE;
                          } in  fact_bang_rpv sat_s1bJ sat_s1bL;
                    };
                1 -> acc_s1bC;
              };
        };

お分かりだろうか。bangを使う方は使わない方に比べて、開始直後にcaseが一個増えています。引数accをcaseを使ってWHNFまで簡約するのですね。
以上。

おまけ

seq使った版はbangと同じでしたので略。

fact_seq :: Int -> Int -> Int
fact_seq acc 1 = acc
fact_seq acc n = acc `seq` fact_seq (acc * n) (n - 1)
{-# NOINLINE fact_seq #-}