シンプルでかつ最高のJavaScriptプロファイラ sjsp を作りました! ― Webアプリケーションが複雑化する中でプロファイラに求められるものとは何か

あらすじ

  • Web技術が複雑になる中で、JavaScriptのプロファイリングをとる方法とは。
  • プロファイリングを取るためのコードを手で書いてみましょう。
  • とてもシンプルで、かつ最高のJavaScriptプロファイラ sjsp を作りました。

本当にあった怖い話

上司 「とにかくJavaScriptのコードを速くしてくれ」

私 「分かりました、速くします」

(次の日)

私 「いいプロファイラがないなら作ればいいじゃない」

同じチームの人 「えっ?」

私 「最高のJavaScriptプロファイラ作ったよ」

同じチームの人 「「えっえっ???」」

私 「早速使ってみたらこことここが遅いって分かったよ」

同じチームの人 「「「この子は一体…」」」

JavaScriptのプロファイリングの難しさ

近年、Webブラウザーの処理速度は著しく向上し、その可用性の高さから、アプリケーションのプラットフォームとして広く利用されるようになりました。 JavaScriptは誕生して20年経ちましたが、当初からは考えられないほど巨大で複雑なコードが、日常的に実行されるようになりました。 端末の処理速度は向上しましたが、アプリケーションの複雑さも増してきており、また比較的リソースの少ない端末にも対応しなければならないといった要求もあることから、JavaScriptのプロファイリング技術はますます重要になってきています。

Web技術の進化はあまりにも速く、書かれるアプリケーションのコードは複雑化してきているにもかかわらず、プロファイリングの手法は従来よりほとんど進化していません。 そのほとんど唯一と言っていい手段、それはWebブラウザーの開発者用ツールを使うことです。 JavaScriptのコードは複雑化し、Webフレームワークによりコードの抽象度が高まっているのに、プロファイルといえば開発者用ツールしかなく、時にこのプロファイラが開発者を悩ませます。 f:id:itchyny:20150701011309p:plain 一体ここから何を読み解けばいいのでしょうか。 f:id:itchyny:20150701103639p:plain 一体どれだけ関数をたどれば、私の書いたコードが出てくるのでしょうか。

Webフレームワークは私たちの書くコードの抽象度を高めてくれます。しかし処理系からすると、私たちのコードはフレームワークの様々な複雑怪奇な仕組みにより隠蔽されてきています。フレームワークがあまりに複雑になってきているので、ご丁寧にもあらゆる関数の実行時間を表示してくださるプロファイラ様は、もはやほとんど私たちの要求にそぐわなくなっています。フレームワーク製作者ならばいざ知らず、

私たちがプロファイルを取りたいのは、フレームワークの関数ではなく、私たちが書いたコードのはずです。

私たちのやりたいプロファイルとは、フレームワークの関数の一覧から一所懸命我々の書いた原因箇所を掘り当てる行為ではないはずです。あなたは本当に、そのプロファイラが便利だと思って使っていますか?情報は多いけど結局自分で原因箇所を探さなくてはいけない、そんなプロファイラに疲弊していませんか?

プロファイラとは

いま一度、プロファイラの仕事とは何なのか考えてみましょう。私の考える、使いやすいプロファイラに求められる責務とは次のようなものになると思います。

  • 私たちが書いたコードの中から (あるいはこちらが指定したコードに限定して)
  • 実行に時間がかかる箇所を
  • 分かりやすく提示する

この3つの条件を前提条件に考えてみますと、ブラウザーのプロファイラはとにかく2つ目の「実行に時間がかかる箇所を」単に提示しているだけにしか見えません。フレームワークの関数ばかり提示してくれるようなのは、(少なくともフレームワークの作者ではない私には) 使い物になりませんし、分かりやすいとは思えません。また、本来は私たちのコードが原因なのに、プロファイラのせいで「遅い」という不当な評価を受けるフレームワークもかわいそうです。

簡単なプロファイラを手で書いてみよう

他のプロファイラのことは一旦忘れて、私たちの書いたコードの中で時間がかかる箇所を特定するにはどうすればいいかをゆっくり考えていきましょう。 実行にどれくらい時間がかかるかというのは、どうやって取ればいいでしょうか。 例えば、次のようにコードがあったとします。

function test1() {
  // 何らかの処理
}
function test2() {
  // 何らかの処理
}
function test3() {
  // 何らかの処理
}

test1();
test2();
test3();

さて、どの関数の実行に時間がかかったでしょうか。それを調べるには、現在時間を取って差を取ればいいはずです。

function test1() {
  var startTime = Date.now();

  // 何らかの処理

  var endTime = Date.now();
  // endTime - startTime が関数の実行にかかった時間
}

test2、test3にも同様に、Date.now()を取るコードを関数の最初と最後に差し込めばいいはずですね。 上のコードでは実行にかかった時間が保存されないので、保存するコードも書いてみます。

var profileResult = {};
function logProfile(funcName, time) {
  profileResult[funcName] = profileResult[funcName] || 0;
  profileResult[funcName] += time;
}

function test1() {
  var startTime = Date.now();

  // 何らかの処理

  logProfile("test1", Date.now() - startTime);
}

あまりにシンプルですが、すでに十分な機能を持ったプロファイラです。 上のプロファイラに求められる条件を考えますと、「私たちの書いたコードの中から」はクリアしたように思えます。なぜなら、test1は私が書いた関数だからです!

しかし、次のような関数を考えて下さい。returnがある関数です。

function test2() {
  if (x) {
    // 何か処理
    return;
  }
  // 何か処理
  if (y) {
    // 何か処理
    return;
  }
  // 何か処理
}

このコードにはどこにプロファイルコードを差し込めばいいのでしょうか。関数の最初と最後?

function test2() {
  var startTime = Date.now();
  if (x) {
    // 何か処理
    return;
  }
  // 何か処理
  if (y) {
    // 何か処理
    return;
  }
  // 何か処理
  logProfile("test2", Date.now() - startTime);
}

これはダメですね。関数は実行されるのにlogProfileが呼ばれることなく終了する可能性があります。どうやら、全てのreturnの直前に置く必要があるようです。

function test2() {
  var startTime = Date.now();
  if (x) {
    // 何か処理
    logProfile("test2", Date.now() - startTime);
    return;
  }
  // 何か処理
  if (y) {
    // 何か処理
    logProfile("test2", Date.now() - startTime);
    return;
  }
  // 何か処理
  logProfile("test2", Date.now() - startTime);
}

良さそうですね。関数の最初でstartTimeを取り、returnの直前と関数の最後でlogProfileすればいいわけですね。

では、次のようなコードを考えてみましょう。

function test3() {
  if (x) {
    return [ (重い処理), (重い処理) ];
  }
  return [ (重い処理), (重い処理), (重い処理) ];
}

関数の最初と最後とreturnの直前にコードを差し込んでみましょう。

function test3() {
  var startTime = Date.now();
  if (x) {
    logProfile("test3", Date.now() - startTime);
    return [ (重い処理), (重い処理) ];
  }
  logProfile("test3", Date.now() - startTime);
  return [ (重い処理), (重い処理), (重い処理) ];
  logProfile("test3", Date.now() - startTime);
}

これでは全然ダメですね。きちんとプロファイルを取るには、returnで返される値の計算時間も考慮しなくてはいけません。変数に入れてみましょう。

function test3() {
  var startTime = Date.now();
  if (x) {
    logProfile("test3", Date.now() - startTime);
    var returnedValue = [ (重い処理), (重い処理) ];
    logProfile("test3", Date.now() - startTime);
    return returnedValue;
  }
  var returnedValue = [ (重い処理), (重い処理), (重い処理) ];
  logProfile("test3", Date.now() - startTime);
  return returnedValue;
  logProfile("test3", Date.now() - startTime);
}

この方法では、次のようなぶら下がりreturnには括弧でくるまないといけないという罠があります。

function test3() {
  var startTime = Date.now();
  if (x)
    return [ (重い処理), (重い処理) ];
}
function test3() {
  if (x) {
    logProfile("test3", Date.now() - startTime);
    var returnedValue = [ (重い処理), (重い処理) ];
    return returnedValue;
  }
  logProfile("test3", Date.now() - startTime);
}

括弧なしのぶら下がりreturnは、if文やwhile文の変換になり、少し手間がかかります。ifwhileの本体、そしてreturn文自体のように複数ケースあるのも大変です。

そこで、次のようにすると、単純にreturn文の変換だけになって、変換コードも綺麗にかけます。

function test3() {
  var startTime = Date.now();
  if (x) {
    return (function() {
      var returnedValue = [ (重い処理), (重い処理) ];
      logProfile("test3", Date.now() - startTime);
      return returnedValue;
    }).call(this);
  }
  return (function() {
    var returnedValue = [ (重い処理), (重い処理), (重い処理) ];
    logProfile("test3", Date.now() - startTime);
    return returnedValue;
  }).call(this);
}

さて、以上の試行錯誤で、ある関数のプロファイルを取るために必要な処理が分かりました。

  1. 関数の最初で現在時刻を取る
  2. 関数の最後でプロファイル結果を報告 (returnが一つもない関数があることを忘れてはいけません!)
  3. returnで、返される値を一時的に変数に保存し、プロファイル結果を報告する即時関数を呼ぶようにする。

とても簡単ですね。 複雑でかつ謎技術により動いているブラウザーのプロファイラと比較すると、私たちの書いた手動プロファイルはとても単純明快です。

sjsp

さあ、JavaScriptのコードをプロファイリングするのに、必要最低限のことは全てお伝えしました。 私の知りうる手の内はすべて明かしました。 上記の処理を、私たちのコードのすべての関数について行えばいいはずです。

ここで質問です。 あなたが普段触るプロダクトコードには、関数はいくつありますか。 いちいち上の処理を全ての関数に適用しますか。

もちろん、プログラマーは、こういうことをするためにプログラムを書くはずです! というわけで、上記の処理を、すべて自動で行うプログラムを作りました。

github.com

その名も sjsp です。Simple JavaScript Profilerの略です。sjspHaskellで書かれています。抽象構文木を扱うにはとても適した言語だと思います。sjspのインストールはとても簡単です。まず、stackコマンドをcommercialhaskell / stack - GitHubよりインストールして下さい。そして、次のように実行して下さい。

 $ git clone https://github.com/itchyny/sjsp
 $ cd sjsp
 $ stack install
 $ export PATH=$PATH:$HOME/.local/bin

こうすると、sjspがインストールされるはずです。

sjspコマンドは、私たちのJavaScriptのコードをプロファイリングコード付きのJavaScriptコードに変換してくれます。

プロファイルしたい JavaScript ファイル   test.js
                    |
                    |   sjsp コマンド
                    ↓
プロファイリングコードが差し込まれた JavaScript ファイル test.sjsp.js

使い方はとても簡単です。

 $ sjsp test.js          # test.sjsp.js が生成される

そして、普段ならtest.jsを読み込むところを、test.sjsp.jsに書き換えて下さい。 Webサイトを開きJavaScriptコンソールを見ると、一定時間ごとにプロファイリング結果が流れてきます。 例えば次のような感じです。

========== SORT BY TIME ==========
time: 30.20sec   count:  71      test6  test.js  (line: 31, col: 18)  function test6() {
time: 16.47sec   count:  41      test7  test.js  (line: 37, col: 18)  function test7() {
time: 15.49sec   count: 133      test4  test.js  (line: 19, col: 18)  function test4() {
time:  5.98sec   count: 216      test1  test.js  (line:  1, col: 18)  function test1() {
time:  4.37sec   count:  18      test5  test.js  (line: 25, col: 18)  function test5() {
time:  3.24sec   count: 512      test3  test.js  (line: 13, col: 18)  function test3() {
time:  0.87sec   count:  67  anonymous  test.js  (line: 49, col: 24)  setInterval(function() {
time:  0.80sec   count:   2      test2  test.js  (line:  7, col: 18)  function test2() {
time:  0.44sec   count:   2  anonymous  test.js  (line: 43, col: 23)  setTimeout(function() {
========== SORT BY COUNT ==========
time:  3.24sec   count: 512      test3  test.js  (line: 13, col: 18)  function test3() {
time:  5.98sec   count: 216      test1  test.js  (line:  1, col: 18)  function test1() {
time: 15.49sec   count: 133      test4  test.js  (line: 19, col: 18)  function test4() {
time: 30.20sec   count:  71      test6  test.js  (line: 31, col: 18)  function test6() {
time:  0.87sec   count:  67  anonymous  test.js  (line: 49, col: 24)  setInterval(function() {
time: 16.47sec   count:  41      test7  test.js  (line: 37, col: 18)  function test7() {
time:  4.37sec   count:  18      test5  test.js  (line: 25, col: 18)  function test5() {
time:  0.80sec   count:   2      test2  test.js  (line:  7, col: 18)  function test2() {
time:  0.44sec   count:   2  anonymous  test.js  (line: 43, col: 23)  setTimeout(function() {

上記のモックアップから、sjspの便利さを読み解くのは難しいかもしれません。 しかし、私は実際にプロダクトコードで使ってみて、Webフレームワークにがっちり乗っかった複雑なコードのプロファイリングに、とても役に立っています。 こちらがプロファイルを取るファイルを指定できるため、当然プロファイル結果には(sjspで変換していない)フレームワークの関数は出てきませんし、苦労してスタックトレースを辿らなくても良いわけです。

sjsp コマンドは、複数ファイルの変換にも対応しています。

 $ sjsp *.js
 $ mv *.sjsp.js /some/other/path

あるいは、findxargsなど他のツールと組み合わせて使用して下さい。 生成されるファイル名は、常に入力ファイルの.js.sjsp.jsにしたものです。 sjspは常に入力ファイルと同じディレクトリーにファイルを生成します。 そのディレクトリーに何らかの事情で書き込めない場合は、--print オプションを利用してください。 出力先が標準出力になります。

では、具体的にsjspが吐くコードを覗いてみましょう。 例えば、次のようなコードがあるとします。

function test() {
  console.log('test');
}

これをsjspで変換すると、次のようになります。

/* sjspの準備コード */ function test() { var sjsp__state = sjsp__start("test.js",1,1,"test","function test() {");
  console.log('test');; sjsp__end(sjsp__state);
}

おや、 sjsp__start とは何でしょうか。「準備コード」の中にあります。

sjsp__start = function(fname, line, col, name, linestr) {
  return { time: Date.now(), line: line, col: col, name: name, fname: fname, linestr: linestr };
};

関数ローカルな変数 sjsp__statesjsp__state.timeに現在時刻が入るということですね。 関数名やファイル名などの状態もとっていますが、本質的にはこれまで書いてきた手動プロファイルと同じです。 それではsjsp__end関数を見てみましょう。 これも「準備コード」の中にあります。

sjsp__end = function(x) {
  if (!x.time) return;
  var key = x.fname + ' :: ' + x.line + ' :: ' + x.col;
  sjsp__result[key] = sjsp__result[key] || { count: 0, time: 0, line: x.line, col: x.col, name: x.name, fname: x.fname, linestr: x.linestr };
  sjsp__result[key].time += (Date.now() - x.time);
  sjsp__result[key].count += 1;
};

sjsp__result という辞書に、「ファイル名」「行番号」「列番号」をくっつけたキーで、プロファイル結果を保存しています。

  sjsp__result[key].time += (Date.now() - x.time);
  sjsp__result[key].count += 1;

この二行が重要ですね。

もう少し複雑なコードを変換してみましょう。

function test() {  
  if (x) {
    return someHeavyExpression;
  }
  return otherHeavyExpression;
}

これを変換すると、次のようになります。

/* sjsp準備コード */ function test() { var sjsp__state = sjsp__start("test.js",1,1,"test","function test() {  ");  
  if (x) {
    return (function(){ var sjsp__return = someHeavyExpression; sjsp__end(sjsp__state); return sjsp__return; } ).call(this);
  }
  return (function(){ var sjsp__return = otherHeavyExpression; sjsp__end(sjsp__state); return sjsp__return; } ).call(this);; sjsp__end(sjsp__state);
}

returnの返り値を、ローカル変数sjsp__returnに代入し、プロファイルを終わった後にsjsp__returnを返す匿名関数が生成されていることが分かります。 本当に上記の手動プロファイルとまったく同じことをやっていることが分かります。

開発秘話

一昨日、上司に本気でJavaScriptのチューニングをするように言われて、なかなかいいプロファイルが取れないので困ってしまいました。 会社から帰るときに、やはりコードをパースして抽象構文木でプロファイリングコードを差し込まないとダメだと思い、家に帰ってからコードを0から書き始めました。 最初はJavaScriptのパースを行うところからでしたが、良いライブラリーのおかげでJavaScriptのパースは簡単にクリアし、直ぐに構文木の変換処理にとりかかることができました。 昨日の午前中、会社で作業してなんとかsjspは完成し、早速プロダクトコードのプロファイリングを取りました。 私の関わっているプロダクトのJavaScriptは数万行ありますが、十分な速度で変換してくれる上 (数100ms程度)、複数JavaScriptファイルを変換したものを読み込んでも干渉せずにうまく動作します。 また、ブラウザーのプロファイラではなかなか分かりづらかった処理の重い関数を、sjspを使うととても簡単に見つけることができました。ブラウザーのプロファイラにきちんと見限りをつけて、自分でプロファイリングツールを作って正解だったと思います。

結論

sjsp は、本当にシンプルで、最高のプロファイリングツールです。

関数の最初と最後やreturnで現在時刻を取り、その差を保存するだけです。 しかし、Web技術が高度に発達し、複雑なフレームワークに支えられた大規模なWebアプリケーションには、 このようにシンプルなやり方こそが、ボトルネックを発見できるのではないでしょうか。

ブラウザーのプロファイラが提示する結果は複雑で、読み解くのが難しく、「なぜその関数をチューニングしなくてはいけないのか」というのを他の開発者に説得するのも困難でした (変なチューニングをしてコードを複雑にすると怒られます… )。 sjspのプロファイリング結果は私たちのコードにフォーカスし、分かりやすいフォーマットで伝えてくれるため、「やっぱりこの関数がこれだけ重いんです」ということを簡単に他の開発者と共有できます。 作っていきなり実戦投入したsjspは、私の関わっているプロダクトで大変役に立っており、実用に耐えうるプロファイリング方法だと考えています。 JavaScriptのプロファイリングに悩んでおられる方は、ぜひご検討下さい。

github.com

sjsp のコードやドキュメントの30%くらいと、このエントリーの30%は勤務時間内に書かれました。この機会を与えてくれたチームと会社に感謝しています。

はてなでは、自分の能力を最大限に活かして、Webアプリケーションのパフォーマンスのボトルネックになっている原因を突き止めたい人や、既存のものは使いものにならないときちんと腹を立てて自ら新しいものを生みだす人、そして最高のWebアプリケーションを構築したいエンジニアを募集しています。

hatenacorp.jp

Google Code Jam 2015 Qualification Round

これからもたまにはコンテスト参加しよう。あたしがんばるもん。まぁCodeforcesは日本時間だとつらい感じに開催されているので、寝不足にならないように程々にね?

A. Standing Ovation

左からなめて行って、足らなかったら観客を足す。足した観客はみんな拍手できるのかと一瞬思うけれど、S_i=0にみんな置けばいいので大丈夫。

import Data.Char (digitToInt)
import Data.List (foldl')

main :: IO ()
main = getContents >>= mapM_ (putStrLn . format) . zip [1..] . map (solve . map digitToInt . (!!1) . words) . tail . lines

solve :: [Int] -> Int
solve = snd . foldl' (\((n, k), r) x -> ((max n k + x, k + 1), r + max 0 (k - n))) ((0, 0), 0)

format :: Show a => (Int, a) -> String
format (k, s) = "Case #" ++ show k ++ ": " ++ show s

B. Infinite House of Pancakes

最後に一つづつ減らしていく数dに対して、それより多いやつを分けて行くのに必要な回数の総和を足す。それの最小。

main :: IO ()
main = getContents >>= mapM_ (putStrLn . format) . zip [1..] . solve . map (map read . words) . tail . lines

solve :: [[Int]] -> [Int]
solve (_:ds:rest) = solve' ds : solve rest
solve _ = []

solve' :: [Int] -> Int
solve' ds = minimum [ k + sum [ (d - 1) `div` k | d <- ds ] | k <- [1..1000] ]

format :: Show a => (Int, a) -> String
format (k, s) = "Case #" ++ show k ++ ": " ++ show s

(コンテスト中は、大きいのから半分にしていって…とか考えていて解けなかった。悔しいよ。)

C. Dijkstra

四元数を左側から掛けて行って、iとかjとかkになればOK。残ったやつを掛けたら1になるとかもOK。四元数の扱い方はなんでもいいけど、実数の四つ組にするのが一番簡単かと思われる。以下ではIntにしてるけど誤差よけのため。グラフのダイクストラ法は関係ない。

import Data.List (foldl')

main :: IO ()
main = getContents >>= mapM_ (putStrLn . format) . zip [1..] . map yesno . solve . tail . words

solve :: [String] -> [Bool]
solve (_:x:cs:rest) = solve' (map charToQuaternion "ijk")
                             ([1 .. f (read x) :: Integer] >> map charToQuaternion cs)
                             one
                    : solve rest
  where f y = min y (y `mod` 4 + 8)
solve _ = []

solve' :: [Quaternion] -> [Quaternion] -> Quaternion -> Bool
solve' [] ys _ = one == foldl' (<<>>) one ys
solve' xxs@(x:xs) (y:ys) z | x == z <<>> y = solve' xs ys one
                           | otherwise = solve' xxs ys (z <<>> y)
solve' _ _ _ = False

data Quaternion = Quaternion Int Int Int Int deriving Eq

(<<>>) :: Quaternion -> Quaternion -> Quaternion
Quaternion a1 b1 c1 d1 <<>> Quaternion a2 b2 c2 d2
  = Quaternion (a1 * a2 - b1 * b2 - c1 * c2 - d1 * d2)
               (a1 * b2 + b1 * a2 + c1 * d2 - d1 * c2)
               (a1 * c2 - b1 * d2 + c1 * a2 + d1 * b2)
               (a1 * d2 + b1 * c2 - c1 * b2 + d1 * a2)

one :: Quaternion
one = Quaternion 1 0 0 0

charToQuaternion :: Char -> Quaternion
charToQuaternion 'i' = Quaternion 0 1 0 0
charToQuaternion 'j' = Quaternion 0 0 1 0
charToQuaternion 'k' = Quaternion 0 0 0 1
charToQuaternion _ = one

yesno :: Bool -> String
yesno True = "YES"
yesno _ = "NO"

format :: (Int, String) -> String
format (k, s) = "Case #" ++ show k ++ ": " ++ s

(コンテスト中はダイクストラ法か…めんどくさそうだな…って思って問題すら開かなかった。丁寧にやれば解ける。)

D. Ominous Omino

解いていない。

Haskellでハマった - runhaskellを使うとリストがメモ化されない?あるいはモジュールにすると-O3でもリストがメモ化されない?

Haskellを書いていて、久しぶりに言語自体について不可解な挙動にぶち当たった。普段Haskellを書いていて、言語について「なんだこれ」と思うことはまずない。ところが、今回の疑問点は自分の理解を遥かに超える内容だった。最初はTwitterで質問してみたのだが、誰にも答えて頂けなかったので、stackoverflowで質問した。すると、見事に解決しまったので紹介する。

質問が長い。でも丁寧に書いたつもり。下の方に和訳も用意した。英語を読むのが面倒な人はそっちを読んでほしい。(自分が書いた英語を和訳するとか意味が分からんね。)
http://stackoverflow.com/questions/25958007/

Why ghc changes the evaluation way due to the optimisation flag?

Hello, I've encountered a wired behaviour of the optimisation flags of ghc. The optimising flags seem to change the way of evaluation. In summary,

  • I wrote a code containing primes and isPrime defined by referring to the each other.
  • I found that the program works well with ghc -O3, but I could not use runhaskell to get the result. It costs too much time.
  • I noticed that when I used ghc -O1, the result appears instantly as -O3, but the executable compiled by ghc -O0 fails to calculate the result in a minute.
  • I used Debug.Trace.trace to find that primes is evaluated from its start every time when isPrime is called.
  • I moved the definition of primes and isPrime to another file Prime.hs. In the main file, I imported my Prime library. Unfortunately, the executable compiled by ghc -O3 does not calculate the result in a minute.

Here's the description. Please see the following code.

main :: IO ()
main = print $ length $ filter isPrime [100000..1000000]

primes :: Integral a => [a]
primes = 2 : filter isPrime [3,5..]

isPrime :: Integral a => a -> Bool
isPrime n = n > 1 && foldr (\p r -> p * p > n || (n `mod` p /= 0 && r)) True primes

When I compile the code with ghc -O3, the executable calculates the correct result 68906 in 2 seconds.

 $ ghc -O3 test.hs
[1 of 1] Compiling Main             ( test.hs, test.o )
Linking test ...
 $ time ./test
68906
./test  1.24s user 0.02s system 79% cpu 1.574 total

However, when I used -O0, I could not get the result in a minute. Be sure to remove the generated files in advance.

 $ rm -f ./test ./test.o ./test.hi
 $ ghc -O0 test.hs
[1 of 1] Compiling Main             ( test.hs, test.o )
Linking test ...
 $ time ./test
^C
./test  64.34s user 0.94s system 94% cpu 1:08.90 total

I aborted. The flag -O1 works well as same as -O3.

So let us dive into investigation. I used Debug.Trace.trace. I traced the argument of isPrime.

import Debug.Trace

main :: IO ()
main = print $ length $ filter isPrime [10..30]

primes :: (Show a, Integral a) => [a]
primes = 2 : filter isPrime [3,5..]

isPrime :: (Show a, Integral a) => a -> Bool
isPrime n = trace (show n) $ n > 1 && foldr (\p r -> p * p > n || (n `mod` p /= 0 && r)) True primes

When the optimisation flag is -O3, (or -O1), the output is as follows.

10
11
3
5
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
7
30
6

This result is reasonable (note that the last line prints the number of the primes; 11, 13, 17, 19, 23, 29).

Here's the result with -O0 (or runhaskell)

10
11
3
5
3
12
13
3
5
3
14
15
3
16
17
3
5
3
18
19
3
5
3
20
21
3
22
23
3
5
3
24
25
3
5
3
26
27
3
28
29
3
5
3
7
3
30
6

This result is interesting to look into. 2 is already arranged at the head of primes. 3 and 5 are checked if isPrime again and again. When isPrime 11 is called, 3 is checked if a prime, and 5 is also checked, isPrime 3 is called again. Likewise, for almost every odd numbers, isPrime 3 and isPrime 5 is called again and again.

Thus I thought that when I use -O0, primes is not cached and constructed from [2] every time as isPrime is called. So the first question is why -O0 and -O1 changes the behavior of evaluation.

Here's another problem. Okay, okay, but I rarely use -O0 flag. In most case I use -O2 or -O3 optimisation flag so I thought that the above problem does not appear in many use case.

But when I moved the codes into another file, the problem again turns up. I just moved primes and isPrime to Prime.hs.

test.hs:

import Prime

main :: IO ()
main = print $ length $ filter isPrime [100000..1000000]

Prime.hs:

module Prime where

primes :: Integral a => [a]
primes = 2 : filter isPrime [3,5..]

isPrime :: Integral a => a -> Bool
isPrime n = n > 1 && foldr (\p r -> p * p > n || (n `mod` p /= 0 && r)) True primes

In this time, I could not obtain the result with -O1 flag, or even with -O3 flag.

 $ ghc -O3 test.hs
[1 of 2] Compiling Prime            ( Prime.hs, Prime.o )
[2 of 2] Compiling Main             ( test.hs, test.o )
Linking test ...
 $ time ./test
^C
./test  62.41s user 0.88s system 92% cpu 1:08.23 total

hmm, I aborted again. I do not know whether this way has an effect to the result, I precompiled Prime.hs with -O3 in advance, but in vain. I hereby used Debug.Trace.trace and I saw 2 and 3 again and again with -O3 flag. In short, I could not create a Prime library because the evaluation way changes when primes and isPrime are moved into a module (which made me surprised) and -O3 does not make it work.

So the second question is, in spite of the -O3 flag, why the stuffs in a module are evaluated as compiled by -O0 flag?

I finally get tired of investigating into this wired behaviour. I concluded that I should not use a cross-referenced definition in a module. I gave up creating my Prime library and started to use Data.Numbers.Primes.

Thanks in advance.

http://stackoverflow.com/questions/25958007/

和訳も書いておく。

なぜghcは最適化オプションに伴って評価方法を変えるのか

こんにちは。ghcの最適化オプションの変な挙動を見つけたよ。最適化オプションによって評価方法が変わってるようなんだ。要約するとこうだ。

  • 相互に参照して定義された、primesとisPrimeを含むコードを書いた。
  • そのプログラムは、ghc -O3だとうまく動いた。だけど、runhaskellを使うと結果を得られなかった。時間が掛かり過ぎるんだ。
  • 次に、ghc -O1を使うと-O3でコンパイルしたのと同様に結果がすぐに出てくることを確認した。でも、ghc -O0でコンパイルした実行ファイルは、一分たっても結果をよこさなかった。
  • Debug.Trace.traceを使ってプロファイルしてみたところ、isPrimeが呼ばれる度にprimesが最初から計算されていることに気がついた。
  • 今度はprimesとisPrimeを他のファイル、Prime.hsに移動した。メインのファイルでそのPrimeライブラリーをインポートしたんだ。そうすると、ghc -O3でコンパイルしても、一分の間に計算できなかったんだ。

ここからは詳細を記述する。次のコードを見てくれ。

main :: IO ()
main = print $ length $ filter isPrime [100000..1000000]

primes :: Integral a => [a]
primes = 2 : filter isPrime [3,5..]

isPrime :: Integral a => a -> Bool
isPrime n = n > 1 && foldr (\p r -> p * p > n || (n `mod` p /= 0 && r)) True primes

このコードをghc -O3でコンパイルすると、二秒もしないうちに正しい答えである68906が計算された。

 $ ghc -O3 test.hs
[1 of 1] Compiling Main             ( test.hs, test.o )
Linking test ...
 $ time ./test
68906
./test  1.24s user 0.02s system 79% cpu 1.574 total

でもね、-O0でコンパイルすると、一分たっても結果を得られないんだ。ghcによって生成されるファイルを消すのに注意したよ。

 $ rm -f ./test ./test.o ./test.hi
 $ ghc -O0 test.hs
[1 of 1] Compiling Main             ( test.hs, test.o )
Linking test ...
 $ time ./test
^C
./test  64.34s user 0.94s system 94% cpu 1:08.90 total

中断したよ。-O1オプションは-O3と同じように、うまくいくんだ。

何が起こっているのか、調査してみよう。私はDebug.Trace.traceを使った。isPrimeの引数をトレースしたんだ。

import Debug.Trace

main :: IO ()
main = print $ length $ filter isPrime [10..30]

primes :: (Show a, Integral a) => [a]
primes = 2 : filter isPrime [3,5..]

isPrime :: (Show a, Integral a) => a -> Bool
isPrime n = trace (show n) $ n > 1 && foldr (\p r -> p * p > n || (n `mod` p /= 0 && r)) True primes

最適化オプションが-O3 (や-O1) だと、出力はこんな感じだ。

10
11
3
5
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
7
30
6

この結果は理に適っているよ。(最後の行は素数の和を表示していることに注意してくれ: 11, 13, 17, 19, 23, 29)

お次は、-O0 (やrunhaskell) での結果だ。

10
11
3
5
3
12
13
3
5
3
14
15
3
16
17
3
5
3
18
19
3
5
3
20
21
3
22
23
3
5
3
24
25
3
5
3
26
27
3
28
29
3
5
3
7
3
30
6

この結果をよく見てみると、面白いよ。まず、コードを見ると、2は予めprimesの頭についているよね。3と5は、isPrimeで何度も何度も素数かどうか確認されるんだ。isPrime 11が呼ばれるとき、まず3が素数かどうか調べられて、そして5が素数か調べられる。そのときに、isPrime 3が再度呼ばれるんだ。同様に、ほとんどすべての奇数について、isPrime 3やisPrime 5が何度も何度も呼ばれるんだ。

だから私は、-O0を用いると、primesはキャッシュされなくて、isPrimeが呼ばれる度に[2]から構築されるんだと思った。最初の疑問は、なぜ-O0と-O1で評価の方法が変わるのかということだ

しかしここで、新しい問題が発生した。よろしい、よろしい、-O0なんてめったに使わないからね。ほとんどのケースで-O2や-O3の最適化オプションを使うから、上のような問題は現実問題では現れないと思ったんだ。

でも違ったよ。コードを他のファイルに移動しただけで、また問題が発生した。primesとisPrimeをPrime.hsに移動するだけなんだ。

test.hs:

import Prime

main :: IO ()
main = print $ length $ filter isPrime [100000..1000000]

Prime.hs:

module Prime where

primes :: Integral a => [a]
primes = 2 : filter isPrime [3,5..]

isPrime :: Integral a => a -> Bool
isPrime n = n > 1 && foldr (\p r -> p * p > n || (n `mod` p /= 0 && r)) True primes

今度はなんと、-O1オプション、いや-O3オプションでさえも、結果を得ることが出来なかった。

 $ ghc -O3 test.hs
[1 of 2] Compiling Prime            ( Prime.hs, Prime.o )
[2 of 2] Compiling Main             ( test.hs, test.o )
Linking test ...
 $ time ./test
^C
./test  62.41s user 0.88s system 92% cpu 1:08.23 total

うーん、中断したよ。このやり方が結果に影響するかどうかは分からないけれど、予めPrime.hsを-O3でコンパイルしてみたんだ、ダメだったけどね。ここでまたDebug.Trace.traceを使ってみると、-O3オプションを使っても2と3が何度も何度も現れるんだ。要するに、primesとisPrimeをモジュールに移動するだけで(ここが一番驚いたんだけど)評価方法が変わるせいで、Primeライブラリーを作ることが出来なかった。-O3を使っても動かせなかったからね。

だから2つ目の質問はこうだ。-O3オプションを使ったにも関わらず、どうしてモジュールの中の物は-O0でコンパイルしたように評価されるんだい?

私はとうとう、この奇妙な動作を調査するのに疲れてしまった。モジュールの中で相互参照する定義は使うべきではないと結論づけた。私はPrimeライブラリーを作るのを諦めて、Data.Numbers.Primesを使うようにしたよ。

ありがとう。

http://stackoverflow.com/questions/25958007/

ここで読者に確認してほしいこと (1)

次のコードを-O0と-O1でコンパイルして比較せよ。(生成される.hi、.oをコンパイルする都度消すこと: 以下同様)

main :: IO ()
main = print $ length $ filter isPrime [100000..1000000]

primes :: Integral a => [a]
primes = 2 : filter isPrime [3,5..]

isPrime :: Integral a => a -> Bool
isPrime n = n > 1 && foldr (\p r -> p * p > n || (n `mod` p /= 0 && r)) True primes

次のコードを-O0と-O1で比較せよ。

import Debug.Trace

main :: IO ()
main = print $ length $ filter isPrime [10..30]

primes :: (Show a, Integral a) => [a]
primes = 2 : filter isPrime [3,5..]

isPrime :: (Show a, Integral a) => a -> Bool
isPrime n = trace (show n) $ n > 1 && foldr (\p r -> p * p > n || (n `mod` p /= 0 && r)) True primes

次のtest.hsを-O3でコンパイルして実行せよ。
test.hs:

import Prime

main :: IO ()
main = print $ length $ filter isPrime [100000..1000000]

Prime.hs:

module Prime where

primes :: Integral a => [a]
primes = 2 : filter isPrime [3,5..]

isPrime :: Integral a => a -> Bool
isPrime n = n > 1 && foldr (\p r -> p * p > n || (n `mod` p /= 0 && r)) True primes

test.hsとPrime.hsを次のように変更して、-O3でコンパイルして実行せよ。
test.hs:

import Prime

main :: IO ()
main = print $ length $ filter isPrime [10..30]

Prime.hs:

module Prime where

import Debug.Trace

primes :: (Show a, Integral a) => [a]
primes = 2 : filter isPrime [3,5..]

isPrime :: (Show a, Integral a) => a -> Bool
isPrime n = trace (show n) $ n > 1 && foldr (\p r -> p * p > n || (n `mod` p /= 0 && r)) True primes

回答

stackoverflowで素晴らしい回答を得ることが出来た。ありがとう、Carl。stackoverflowには優れた人がたくさんいて素晴らしい。

What's going on here is in the following signature:

primes :: Integral a => [a]

The type class prevents primes from being memoized naively. primes :: [Int] is not the same as primes :: [Integer]. And no calculations can be shared, because GHC can't assume all instances of Num follow the same logic. Because of that, every use of primes ends up recalculating the list at the selected type.

But when you enable optimizations, GHC gets a fair bit smarter. When the only use of primes is in the same module as the definition, GHC can optimize it down to the concrete type it's used as. Then calculations are shared across uses of the list.

It only does this within module boundaries, though. Separate compilation of modules means that if primes is exported, it can't be specialized to a concrete type - GHC never knows if the next module it will compile might use primes at a different type.

The simplest way to resolve this is to give primes a concrete type. Then even the naive use of it memoizes.

http://stackoverflow.com/questions/25958007#answer-25960838

和訳してみよう。

ここで起こっていることは、次の型シグネチャのせいだ。

primes :: Integral a => [a]

この型クラスがのせいで、primesがメモ化されないんだ。primes :: [Int] と primes :: [Integer] は違うよね。だから計算は共有されない、どうしてかというと、GHCはNumのすべてのインスタンスが同じロジックに従うと決められないからなんだ。そのせいで、primesを使う度に、その型に対してリストを再計算する羽目になっているんだ。

でも、最適化を有効にすると、GHCはちょっとだけ賢くなる。primesが同じモジュールの中にあるときだけ、GHCは使われている具体的な型に対して最適化できる。そうすると、リストの計算結果は共有されるようになる。

でも、GHCがこれをやってくれるのはモジュールの中に限った話だ。別々のモジュールをコンパイルすると、もしprimesが別のモジュールにエクスポートされると、具体的な型に特定できなくなる。GHCは次にコンパイルしようとしているモジュールがprimesを他の型で使用するかもしれないといったことは分からないからね。

単純な解決方法は、具体的な型を指定すればいい。そうするとprimesはメモ化される。

http://stackoverflow.com/questions/25958007#answer-25960838

ここで読者に確認してほしいこと (2)

次のコードを-O0でコンパイルして実行せよ。

main :: IO ()
main = print $ length $ filter isPrime [100000..1000000]

primes :: [Integer]
primes = 2 : filter isPrime [3,5..]

isPrime :: Integer -> Bool
isPrime n = n > 1 && foldr (\p r -> p * p > n || (n `mod` p /= 0 && r)) True primes

再度、型シグネチャを次のように戻して-O0で実行せよ。

primes :: Integral a => [a]

isPrime :: Integral a => a -> Bool

次のtest.hsを-O0でコンパイルして実行せよ。
test.hs:

import Prime

main :: IO ()
main = print $ length $ filter isPrime [100000..1000000]

Prime.hs:

module Prime where

primes :: [Integer]
primes = 2 : filter isPrime [3,5..]

isPrime :: Integer -> Bool
isPrime n = n > 1 && foldr (\p r -> p * p > n || (n `mod` p /= 0 && r)) True primes

なんと、型クラスIntegral aではなくて、具体的にIntegerに限定するだけで、実行できるようになる。

解説

つまり、こういうことだ。
シグネチャ

primes :: Integral a => [a]

だと、primes :: [Int] と primes :: [Integer] の二通りの使い方がある。簡単にいえば、GHCはこの二通りの使い方のどちらで使われるか分からない。更に、Integralなものが他にある可能性もあるし(例えばユーザーが適当に作ったデータ型)、どういう使われ方をされるか分からないので、メモ化できない。
しかし、mainと同じファイルにprimesが書かれると、状況が簡単になる。つまり、そのファイルの中でprimesがどのように使われるか - [Int]か[Integer]か - といったことは、そのファイルを調べれば一つに分かる。よって、同じファイルでの使い方 ([Int]か[Integer]か) を見れば、メモ化できる。

そうなると、気になるのは次のコードだ。

main :: IO ()
main = do
  print $ length $ filter isPrime ([100000..1000000] :: [Int])
  print $ length $ filter isPrime ([100000..1000000] :: [Integer])

primes :: Integral a => [a]
primes = 2 : filter isPrime [3,5..]

isPrime :: Integral a => a -> Bool
isPrime n = n > 1 && foldr (\p r -> p * p > n || (n `mod` p /= 0 && r)) True primes

つまり、同じファイルなのだが、二通りの使い方をする場合。この場合は、実験してみたところ、メモ化される。すなわち、同じファイルで[Int]と[Integer]で使うことが分かるので、両方のprimesをメモ化するコードを吐くのだろう。


では、primesとisPrimeをモジュールにした時はどうなるか。ghcは、test.hsをコンパイルをする時に、まずインポートしているPrime.hsをコンパイルする。
Prime.hs:

module Prime where

primes :: Integral a => [a]
primes = 2 : filter isPrime [3,5..]

isPrime :: Integral a => a -> Bool
isPrime n = n > 1 && foldr (\p r -> p * p > n || (n `mod` p /= 0 && r)) True primes

ところが、この時点では、これらがIntegralのどの型で用いられるかが決定できない。(これは一見奇妙だ、test.hsのimport文を見てPrime.hsをコンパイルしているはずなのに、なぜtest.hsでの使われ方が分からないのか。まぁ簡単のためだろうか)
型が決定できないから、どういう型についてメモ化すればいいのか分からない。(ここのロジックもいささか危うい。IntegralなものがIntとIntegerであることくらい、分からないものなのだろうか。まぁそういうことなのだろう)
primes、isPrimeの型を

primes :: [Integer]
isPrime :: Integer -> Bool

とすると、当然使われ方はIntegerに決定されるので、メモ化されて効率よく実行できる。

モジュールの中で型クラスで束縛した型のリストには注意したほうが良いだろう。

解決策

では、モジュールの中で primes :: Integral a => [a] のようなものを書くのは諦めるか?実は諦める必要はなくて、非常に簡潔な解決策がある。教えてくれたchi、ありがとう。

Maybe a {-# SPECIALIZE primes :: Int #-} pragma could prod the optimizer to do a better job here. (Not really sure, though). – chi

http://stackoverflow.com/questions/25958007#comment40647503_25960838

このコメントの型は明らかに間違っていて、正しくはこうだ。

{-# SPECIALIZE primes :: [Int] #-}
{-# SPECIALIZE primes :: [Integer] #-}

つまり、このSPECIALIZEという特別なプラグマによって、ghcにprimesがおそらくこう使われるだろうということを伝えるのだ。

ここで読者に確認してほしいこと (3)

次のtest.hsを-O3でコンパイルして実行せよ。
test.hs:

import Prime

main :: IO ()
main = print $ length $ filter isPrime [100000..1000000]

Prime.hs:

module Prime where

{-# SPECIALIZE primes :: [Int] #-}
{-# SPECIALIZE primes :: [Integer] #-}
primes :: Integral a => [a]
primes = 2 : filter isPrime [3,5..]

isPrime :: Integral a => a -> Bool
isPrime n = n > 1 && foldr (\p r -> p * p > n || (n `mod` p /= 0 && r)) True primes

プラグマの二行を消してみて、実行できるかどうか試してみよ。


この非常にシンプルな方法により、すべてが解決される。
実際、primesというパッケージHaskellにはあるが、そのprimesの定義には、これらのプラグマが書かれていることを確認することができる。


もちろん、SPECIALIZEで指定されていない使われ方には、メモ化されないことを期待するだろう。すなわち、最後の課題はこうだ。次のtest.hsを-O3でコンパイルして実行せよ。
test.hs:

import Prime

main :: IO ()
main = print $ length $ filter isPrime ([100000..1000000] :: [Int])

Prime.hs:

module Prime where

{-# SPECIALIZE primes :: [Integer] #-}
primes :: Integral a => [a]
primes = 2 : filter isPrime [3,5..]

isPrime :: Integral a => a -> Bool
isPrime n = n > 1 && foldr (\p r -> p * p > n || (n `mod` p /= 0 && r)) True primes

上のような場合、ghcがPrime.hsをコンパイルする時点では、primesが[Int]で用いられるのは予期しない使われ方であって、メモ化はされない。
型クラスで型を束縛された物に対してSPECIALIZEプラグマを用いると、指定した型に対応するコードを生成する。これは一般に生成コードを長くするが、実行速度を速くする可能性がある。その上、今回のケースのようにメモ化されるようになることもある。

まとめ

モジュール内で型クラスで束縛した型を持つリストは、どのような型で使われるか分からないので、メモ化されない。SPECIALIZEプラグマで主な使われ方を指定する。もちろん、これで指定していない型で用いることはできる。しかしメモ化はされない。なぜなら、そのモジュールをコンパイルする時点では、SPECIALIZEプラグマで指定した型以外のどのような型で使われるか分からないからだ。
Haskellは、型クラスという優れたシステムを備えている。それは、私がHaskellを好む一つの理由だ。自らが定義したデータ型を、ある型クラスのインスタンスにするだけで、その型クラスのインスタンスならば使える関数を用いることができる。例えば、Ordのインスタンスにすればsortが使えるようになるといった具合だ。ある関数がどれだけ広い型に適用できるかを考えることは、 - 実際にはghcが教えてくれるのだが - とても楽しいことである。しかし、SPECIALIZEという、この楽しさと逆行するようなプラグマを使わざるを得ない場面があるという発見もまた、興味深いことである。

実装して理解する遅延評価の仕組み 〜 thunkを絵に描いて理解しよう・JavaScriptでHaskellを実装!?

この記事では, Haskellに用いられる「遅延評価」の仕組みを, 図に描いて説明します. 更に, 遅延評価版のフィボナッチ数の無限列を, JavaScriptで実装します. 遅延評価とはどのように動くのか, 考えて行きましょう.

HaskellのコードとJavaScriptのコードの比較

Haskellでの

x = y
y = 10

と, JavaScript

var x = y;
var y = 10;

というコードを考えてください. Haskellのコードは, これだけでは何も起こりません. print xとすると, x = y = 10 となって 10 が表示されます. 一方, JavaScriptのコードは var x = y; を評価した瞬間, 「ReferenceError: y is not defined」というエラーが出ます.


更に,

main = let x = 10 in let x = x + 5 in print x

というコードは, x の評価が無限ループに陥って何も表示されません.
JavaScript

x = 10;
x = x + 5;
console.log(x);

とは, 全く違った風に動くのです.


他の言語に慣れている人にとっては, Haskellの評価は奇妙に思えると思います. それは, Haskellが遅延評価と呼ばれる評価戦略をとっているからです.

遅延評価と無限リスト, undefined

遅延評価の分かりやすい例として, 無限リストを考えてみます.

main = print [0..]
[0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,...

このプログラムは, 0 からの数をずーっと表示し続けます.
これは以下のようにも書けます.

main = putStrLn (show [0..])

show [0..]というのは, 「無限リスト」を評価して無限の長さの文字列になります.
では,

main = let x = show [0..] in print (head x)
'['

というのはどうでしょう?
x は無限の長さの文字列です.
これってすごくないですか?
let x = show [0..] とした瞬間に, show [0..] という無限の長さの文字列の何らかの情報が x に束縛されるのですが, この時点で評価はされないのです.
そして, print (head x) とした瞬間に, x の最初が必要になって評価するのです.


take という関数を思い出して下さい.

main = let x = [0..] in print (take 10 x)
[0,1,2,3,4,5,6,7,8,9]

このプログラムも, 遅延評価が役だっています.
let x = [0..] で無限長のリストを x に束縛し, そのリストから最初の10個が必要になって, それ「だけ」評価して, print します.



もう一つ, undefined を思い出しましょう.

main = undefined >> print "hello"
 *** Exception: Prelude.undefined

ヤバイやつですね.
評価したら例外が飛んでプログラムがストップします.

main = let x = undefined in print x
 *** Exception: Prelude.undefined

もちろん, これも.
でも, 次のプログラムは undefined が評価されません!

main = let x = [undefined, undefined, undefined] in print (length x)
3

さらに次も!

main = let x = undefined : x in print (null x)
False

さらに

main = let x = undefined : x in print (length (take 10 x))
10

本当に, 必要になるまで評価されないんですね!!!



let x = [0..] や, let x = show [0..] などは, よく考えたら不思議な式です.
どうやって無限長のデータを x に束縛することができ, 必要なときに評価することができるのでしょうか.
さらに, let x = undefined : x など, undefined は本当の本当に要素が必要になるまでは, 評価されません.
値が必要か, どれくらい必要かどうかって, どうやって判定するのでしょうか.

評価されていない様子を絵に描いてみよう

let x = 3 という式は, 我々の直感的な代入とは異なります.
x は, 評価したら 3 になる, 何かなのです.
この「何か」を, 四角で囲って描いて表してみることにします.
つまり,

じゃなくて,

です.


何らかの関数 f, g がある時,

let x = f g 10

というのは,

ではなくて,

です!
つまり, 括弧を書けそうなところには全て四角で囲うのです.

let x = (((f) (g)) (10))


この絵の表現を使って, Haskell の評価がどのように動いているのか確かめてみましょう.
次のコードを考えます.

main = let x = 1 : x in print (null x)

これを絵に描いてみると

となります.
演算子は良い感じにセクションとして見て下さい.


null の定義はこうでした.

null       :: [a] -> Bool
null []    =  True
null (_:_) =  False

JavaScriptのnullとは違って, 空リストかどうか判定する関数ですね.
つまり, function (list) { return list.length === 0; } のことです (大体).
これを用いると,

   print (null x)
 = print (null (1 : x))
 = print False

となることが分かりますね.
これを絵で確認してみましょう.
「評価する」ことは, 絵の上では四角を外すことになります.
二項演算子は, 演算子から四角を外します.

何ステップも経て箱を外し, ようやく False と表示することができました (まぁ厳密にはちょっと違うますが許してください(๑´◕﹏◕`))
最後から二行目に注目して下さい.
「1」が, 四角で囲われたままです!
つまり, null 関数は最初の要素が何であるかを評価しないのです.
もちろん null 関数は最初以外「も」必要がありません.
だからこそ, このコードはきちんと評価が止まるんです.
結局, データ構成子 (:) だけ, 評価出来ればいいんですね.


ここで書いたような図には, 幾つかのルールに基づいています.

  • let x = hoge とした時, hoge 全体が四角で囲われる; x = [ hoge ]. すぐには評価されない.
  • 四角は外側から外す. 勝手に内側の四角を外してはいけない.
  • f x という関数適用の四角を外した後は, f の方が先に評価される. その後, x は評価されないまま f に適用される; [ [ f ] [ x ] ] -> [ f ] [ x ] -> f [ x ]. [ [ [ f ] [ g ] ] [ x ] ] -> [ [ f ] [ g ] ] [ x ] -> ([ f ] [ g ]) [ x ] -> (f [ g ]) [ x ].
  • パターンマッチはデータ構成子で行われる. データ構成子が評価された時点で, パターンマッチで分岐し, 変数には評価されていないデータが束縛される; [ [ T ] [ a ] ] -> [ T ] [ a ] -> T [ a ].


undefined を含むコードが, この絵の上でどう評価されるか考えてみましょう.

main = undefined >> print "hello"

このコードを実行すると, "hello"と表示すること無くundefined の例外が飛ぶんでしたね.
これを図に描くと次のようになります.

undefined の箱を開けると, 例外が飛んでその他のコードを評価すること無く, プログラムは終了します.
図に描くと, >> の第一引数を評価した瞬間終了し, print "hello" が評価されないというのがよく分かります.


逆に, undefined の箱を外さなければ, 例外は飛ぶこと無くプログラムはきちんと動作します.

main = let x = undefined : x
           in print (null x)

図に描くと, こうなります.

上の絵を見て分かるように, null x では undefined は評価されないんですね (undefinedを囲っている四角が外れない).
だから例外が飛ばなかったんですね.

四角 = thunk

上の図で四角に書いたものは, thunk と呼ばれるものです.
後で評価する, ブラックボックスのようなものです.
それを評価したら何が出てくるかは, 評価しなければ分かりません.
絵の上では, thunk を評価すると, どんどん箱が取れていくのです.


しかし, 箱はどこまでもとるわけではありません.
もし全ての箱を取らなければいけないならば, null (undefined : x) の引数を全て評価しようとして, 無限ループになってしまうはずです.
null の分岐は, データ構成子 (:) のパターンマッチで行われます.
この動作から推測するに, データ構成子の箱がとれた時に, 取り敢えずはそこで評価が止まるのです.

JavaScriptで書いてみる

以上のことを踏まえて, JavaScriptで遅延評価を実装してみます.
まずは, 基本的なデータです.
thunk は, 値を保持しておいて後で評価するような箱です.

function Thunk (value) {
  this.value = value;
}

使い方は

> x = new Thunk(10);
Thunk
> x.value;
10

ではなくて,

> x = new Thunk(function () { return 10; });
Thunk
> x.value;
function () { return 10; }
> x.value();
10

です.
こうすることで, Haskell

x = y
y = 20

は,

> x = new Thunk(function () { return y; });
Thunk
> y = new Thunk(function () { return 20; });
Thunk
> x.value();
Thunk
> x.value().value();
20

のように書けます.
value を何度も評価することで, 値を得ることができます.


λの wrapper と, thunk を二つ取って関数適用したものを作る App を書きます.

function Lambda (fn) {
  this.fn = fn;
}

function App (fn, arg) {
  this.fn = fn;
  this.arg = arg;
}

次に, thunk を評価する関数です.
thunk である限りは箱を外し続けます.

function Evaluate (val) {
  while (val instanceof Thunk) {
    val = val.value();
    if (val instanceof App) {
      val = (PeelLambda(Evaluate(val.fn)))(val.arg);
    }
  }
  return val;
}

function PeelLambda (lam) {
  if (!(lam instanceof Lambda)) {
    throw "type error: apply a non-lambda to a value"
  }
  return lam.fn;
}

ここで,

      val = (PeelLambda(Evaluate(val.fn)))(Evaluate(val.arg));

ではないことに注意して下さい.
値は評価せずに, thunk のまま関数に適用するのです!!!


二つの thunk から関数適用の thunk を作るものを準備しておきます.
先ほどの App は, 直接使うと全体を thunk で包まないので, 代わりにこちらの Apply を使うことにします.

function Apply (fn) {
  return function (arg) {
    return new Thunk(function () {
      return new App(fn, arg);
    });
  };
}

さあ, 準備は整いました.
Thunk, Apply, Lambda を実際に使って実装してみましょう.
目指すは, fib = 0 : 1 : zipWith (+) fib (tail fib) をJavaScript で実装することです!
これが実装できたら, 遅延評価の実装もホンマモンでしょう?


JavaScript のあらゆる値は, thunk で包まれます.

> twenty = new Thunk(function () { return 20; });
Thunk
> twenty.value;
function () { return 20; }
> Evaluate(twenty);
20
> x = new Thunk(function () { return y; });
Thunk
> y = new Thunk(function () { return 20; });
Thunk
> Evaluate(x);
20


関数は new Lambda を使って, 次のように書きます.

var add = new Lambda(function (x) {
  return new Lambda(function (y) {
    return new Thunk(function () {
      return Evaluate(x) + Evaluate(y);
    });
  });
});

var sub = new Lambda(function (x) {
  return new Lambda(function (y) {
    return new Thunk(function () {
      return Evaluate(x) - Evaluate(y);
    });
  });
});


これを用いて 1 + 2 を計算してみます.

> one = new Thunk(function () { return 1; });
Thunk
> two = new Thunk(function () { return 2; });
Thunk
> onetwo = new Thunk(function () { return Apply(Apply(add)(one))(two); });
Thunk
> Evaluate(onetwo);
3

はい, 1 + 2 = 3 ということが分かりました.
関数適用するあらゆる所に Apply を使います.
なぜカーリー化がデフォルトなのか, これでお分かりだと思います.
カーリー化してた方が統一的に扱えるでしょう?



リストを実装すると, こんな感じです.

function Cons (car, cdr) {
  this.car = car;
  this.cdr = cdr;
}
function Nil () {
}

// []
var nil = new Thunk(function () {
  return new Nil();
});

// (:)
var cons = new Lambda(function (x) {
  return new Lambda(function (xs) {
    return new Thunk(function () {
      return new Cons(x, xs);
    });
  });
});

JavaScript のデータとして new Nil, new Cons を使うことはできるのですが, これは nil, cons を通して使わなくてはなりません.
何故なら, 適当に new Cons... とか書くと, thunk で包むのを忘れるからです.


Evaluate 関数で, リストを処理した時にどうなるか, 考えてみます.

> zero = new Thunk(function () { return 0; });
Thunk
> // let x = 0 : x
> x = new Thunk(function () { return new Cons(zero, x); });
Thunk

評価します.

> Evaluate(x);
Cons

無限ループになりません!
これは, Cons というデータ構成子で Evaluate が止まるからです.



実装を進めましょう.
map関数, take関数は次のようになります.

// map _ [] = []
// map f (x:xs) = f x : map f xs
var map = new Lambda(function (f) {
  return new Lambda(function (list) {
    return new Thunk(function () {
      var xxs = Evaluate(list);
      if (xxs instanceof Cons) {
        var x = xxs.car;
        var xs = xxs.cdr;
        return Apply(Apply(cons)(Apply(f)(x)))
                                (Apply(Apply(map)(f))(xs));
      } else {
        return nil;
      }
    });
  });
});

// take _ [] = []
// take n _ | n <= 0 = []
// take n (x:xs) = x : take (n - 1) xs
var take = new Lambda(function (n) {
  return new Lambda(function (list) {
    return new Thunk(function () {
      var xxs = Evaluate(list);
      if (xxs instanceof Cons) {
        var nval = Evaluate(n);
        if (nval <= 0) {
          return nil;
        } else {
          var x = xxs.car;
          var xs = xxs.cdr;
          return Apply(Apply(cons)(x))
                                  (Apply(Apply(take)(Apply(Apply(sub)(n))(one)))(xs));
        }
      } else {
        return nil;
      }
    });
  });
});

Apply がいっぱいですね.
関数適用するあらゆる所に, Apply を使わなければいけません.
さらに, 条件分岐する所で Evaluate を使っていることに注意して下さい.


() と, monad 的な関数を用意しておきます.

function Unit () {
}

// ()
var unit = new Thunk(function () {
  return new Unit();
});

// print = \x -> log x; return ()
var print = new Lambda(function (x) {
  return new Thunk(function () {
    console.log(Evaluate(x));
    return Apply(return_)(unit);
  });
});

// return
var return_ = new Lambda(function (x) {
  return new Thunk(function () {
    return x;
  });
});

// (>>)
var then = new Lambda(function (fn1) {
  return new Lambda(function (fn2) {
    return new Thunk(function () {
      Evaluate(fn1);
      Evaluate(fn2);
    });
  });
});

まぁぶっちゃけ, ここのコードはあまり monad 的じゃなくて, 取り敢えず動きそうなコードです.
きちんとしたコードは自分で書いてみて下さい.
あと, ここでの print 関数は Haskell で言う print 関数と動作が異なるので, 注意して下さい.


map 関数を真似して, mapM_ を書いてみます.

// mapM_ _ [] = return ()
// mapM_ f (x:xs) = f x >> mapM_ f xs
var mapM_ = new Lambda(function (f) {
  return new Lambda(function (list) {
    return new Thunk(function () {
      var xxs = Evaluate(list);
      if (xxs instanceof Cons) {
        var x = xxs.car;
        var xs = xxs.cdr;
        return Apply(Apply(then)(Apply(f)(x)))
                                (Apply(Apply(mapM_)(f))(xs));
      } else {
        return Apply(return_)(unit);
      }
    });
  });
});

以上の用意で, Haskell

inf = 0 : map (+1) inf

は次のようになります.

var zero = new Thunk(function () {
  return 0;
});

var one = new Thunk(function () {
  return 1;
});

// inf = 0 : map (+1) inf
var inf = new Thunk(function () {
  return Apply(Apply(cons)(zero))
                          (Apply(Apply(map)(Apply(add)(one)))(inf));
});

実行すると次のようになります.

> twenty = new Thunk(function () { return 20; });
Thunk
> // mapM_ print (take 20 inf);
> Evaluate(Apply(Apply(mapM_)(print))(Apply(Apply(take)(twenty))(inf)));
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

うまく動いているように見えます∩(>◡<*)∩
ideone での実行結果を置いておきます: http://ideone.com/KXT74d .


そろそろフィボナッチ数を書きたくなって来ましたよね.
ウズウズしていると思います.

fib = 0 : 1 : zipWith (+) fib (tail fib)

これを実装するには, zipWith と tail 関数が必要です.
zipWith は二つのリストを関数で貼りあわせて新しいリストを作る関数です.
tail は, リストの頭以外を返す関数 function tail(list) { return list.slice(1); }(大体こんな感じ; ホントは空リストならエラーが飛ぶ) ですね.

// zipWith f (a:as) (b:bs) = f a b : zipWith f as bs
// zipWith _ _ _ = []
var zipWith = new Lambda(function (f) {
  return new Lambda(function (listx) {
    return new Lambda(function (listy) {
      return new Thunk(function () {
        var xxs = Evaluate(listx);
        if (xxs instanceof Cons) {
          var yys = Evaluate(listy);
          if (yys instanceof Cons) {
            return Apply(Apply(cons)(Apply(Apply(f)(xxs.car))(yys.car)))
                                    (Apply(Apply(Apply(zipWith)(f))(xxs.cdr))(yys.cdr));
          }
        } else {
          return nil;
        }
      });
    });
  });
});

// tail [] = error "tail: empty list"
// tail (_:xs) = xs
var tail = new Lambda(function (list) {
  return new Thunk(function () {
    var xxs = Evaluate(list);
    if (xxs instanceof Cons) {
      return xxs.cdr;
    } else {
      throw "tail: empty list";
    }
  });
});

フィボナッチ数の無限列は, 次のように実装できます.

// fib = 0 : 1 : zipWith (+) fib (tail fib)
var fib = new Thunk(function () {
  return Apply(Apply(cons)(zero))
                          (Apply(Apply(cons)(one))
                                            (Apply(Apply(Apply(zipWith)(add))(fib))(Apply(tail)(fib))));
});

var twenty = new Thunk(function () {
  return 20;
});

Evaluate(Apply(Apply(mapM_)(print))(Apply(Apply(take)(twenty))(fib)));

実行すると

0
1
1
2
3
5
8
13
21
34
55
89
144
233
377
610
987
1597
2584
4181

となります. (ideone: http://ideone.com/6HJhqA )
バンザイです! JavaScript でフィボナッチ数の無限リストを実装することができました∩(>◡<*)∩♡

束の間の喜び, フィボナッチ数が再帰爆発していることに気が付こう

しかしながら, 上の実装には問題があります.
フィボナッチ数の計算が, 再帰爆発を起こしています.
試しに add 関数で足し算が実行される回数をカウントしてみましょう.

i = 0;
var add = new Lambda(function (x) {
  return new Lambda(function (y) {
    return new Thunk(function () {
      i++;
      return Evaluate(x) + Evaluate(y);
    });
  });
});
> i = 0;
0
> Evaluate(Apply(Apply(mapM_)(print))(Apply(Apply(take)(twenty))(fib)));
0
1
1
...
2584
4181
> i;
17690

やべぇ...
フィボナッチ数20個ですので, 大体足し算は20回すればいいはずです.
適当に

> i = 0;
0
> twentyfive = new Thunk(function () { return 25; });
Thunk
> Evaluate(Apply(Apply(mapM_)(print))(Apply(Apply(take)(twentyfive))(fib)));
0
1
...
6765
10946
17711
28657
46368
> i;
196392

もーーんーーのーーすーーごーーくっ時間がかかります...



何が悪いんでしょうか.



先ほどの fib から最初の3つを評価するまでの様子を, 図に描いてみました.
mapM_ print fib したと考えて下さい.

最初から三行で, 「0」「1」が表示されます.
その後, 3つ目の「1」の表示のために, fib を定義まで戻ってまた thunk を開くことを2回しています.
そうです, fib を呼ぶたびに, 定義まで戻っているからダメなんです.
この後に, fib の4つ目を計算するために定義まで戻っていては, せっかく3つ目が分かっているのに勿体ないです.



fib の箱を幾つか外したら, そこまでの処理は何度もしなくていいのではないでしょうか.
すぐ前の結果を呼ぶようにして, 3つまでの値を評価したのが次の図です.

こちらの方がすぐに3つの要素が取り出せますね.
それだけでなく, 「(+) 0 1」が実行され, fib !! 2 が数字に決定していますので, これ以降のステップで fib を呼ぶ時は「0 : 1 : 1 : zipWith ...」となります.
3つ目を計算するための足し算(+)が不要になるのです.



問題が分かった所で, 実装を変更します.
評価したところまでキャッシュするために, Evaluate 関数だけ変更します.

function Evaluate (val) {
  while (val instanceof Thunk) {
    var v = val;
    if (v.evaluated) {
      val = val.value;
    } else {
      val = val.value();
    }
    if (val instanceof App) {
      val = (PeelLambda(Evaluate(val.fn)))(val.arg);
    }
    v.evaluated = true;
    v.value = val;
  }
  return val;
}

実行します.

> i = 0;
0
> Evaluate(Apply(Apply(mapM_)(print))(Apply(Apply(take)(twenty))(fib)));
0
1
1
...
4181
> i;
18

キタ━━━━✧*。ヾ(๑>◡<๑)ノ゙✧*。━━━━!!

> i = 0;
0
> hundred = new Thunk(function () { return 100; });
Thunk
> Evaluate(Apply(Apply(mapM_)(print))(Apply(Apply(take)(hundred))(fib)));
0
1
1
2
3
5
8

.....

31940434634990100000
51680708854858330000
83621143489848430000
135301852344706760000
218922995834555200000
> i;
98

さっきは滅茶苦茶時間がかかってたのに, 今度は100個も余裕で求められるようになりました!(ideone: http://ideone.com/ILSuJW )
足し算の回数も, 合ってます! (fib から100個求めるのに, 最初の二つは足し算をしないでも分かっているので, 100 - 2 = 98 なのですが, 「80」と出た人は, 理由を考えてみて下さい.)
たった Evaluate だけの変更で, うまく動くようになるのは, とっても嬉しいなって.
下の方の桁がうまく求められてないのは, JavaScriptの数値の扱いのせいなので, 仕方ないですね.


Evaluate 関数が, 何処まで処理するかは, とても重要です.
何度も言っていますが, データ構成子が現れたら, そこでストップします.
もう一つ, 今まで言ってなかったのが, λです.
ほら, while (val instanceof Thunk) {... というコードですので, new Lambda に対しては処理しません.
これはとても重要な観察で, WHNF というのですが, この記事が更に長くなりそうなので名前を出すだけにとどめます.


遅延評価はどう動いているか, お分かりいただけたかと思います.
キーワードは, thunk です.
図をいっぱい描いてどういうふうに thunk の箱が外れていくか, 考えてみて下さい.

JavaScript == Haskell

もう一回, fib のコードを見てみます.

var fib = new Thunk(function () {
  return Apply(Apply(cons)(zero))
                          (Apply(Apply(cons)(one))
                                            (Apply(Apply(Apply(zipWith)(add))(fib))(Apply(tail)(fib))));
});

Haskellのコードはこうでした.

fib = 0 : 1 : zipWith (+) fib (tail fib)

つまり,

fib = ((:) (0)) (((:) (1)) (((zipWith (+)) (fib)) (tail (fib))))

であり, 更に関数適用に全て($)を用いると

fib = ($) (($) (:) 0)
           (($) (($) (:) 1)
                 (($) (($) (($) zipWith (+)) fib) (($) tail fib)))

となります.
あれ... これってJavaScript のコードと($)の位置とApplyの位置が, そのままじゃないですか!

と言うことは...

$ = Apply

まさかの...

var fib = new Thunk(function () {
  return ($)(($)(cons)(zero))
                      (($)(($)(cons)(one))
                                    (($)(($)(($)(zipWith)(add))(fib))(($)(tail)(fib))));
});

うおお... これは... Haskell のコードです!!!

add = (+)
cons = (:)
zero = 0
one = 1
fib = ($)(($)(cons)(zero))
                    (($)(($)(cons)(one))
                                  (($)(($)(($)(zipWith)(add))(fib))(($)(tail)(fib))));

うわああああああああ...
JavaScriptHaskell は一緒だったのだ... +。:.゚٩(๑>◡<๑)۶:.。+゚




まとめ

thunk のイメージを捉えられたでしょうか.
絵を描いて見ることが重要です.
私も, いっぱい箱を描きました.
詳しいことは, Haskell WikiThunk - HaskellWiki, Lazy evaluation - HaskellWiki, Weak head normal form - HaskellWiki, そして Haskell/Laziness - Wikibooks, open books for an open world あたりを読んで勉強して下さい.
そして何よりも, 遅延評価しない言語で遅延評価を実装してみるのが一番理解を深めます.
お好きな言語で, 遅延評価を実装してみて下さい.

裏話

このブログ記事を書いたきっかけは, fay(https://github.com/faylang/fay)でした.
Haskell のコードを JavaScript のコードに変換するプログラムです.
これがどう実装しているのか, 最初は見当も付きませんでした.
私はまず, fib を Haskell で実装, fay で変換し, その出力コードを読みほどいてみたのです.
そして, thunk をどう実装すればいいか, それをどう評価すればいいかが分かったのです.


thunk, WHNF について調べ, 徐々に理解してきた私は, fay の出力コードを参考にしながら JavaScript で書いてみました.
高階関数ばかりでデバッグしにくい状況で, 初めて mapM_ print (take 20 fib) がうまく動いた時は, 心が震えました.
その感動に, 再帰爆発していることに気が付きませんでした.


数日して, フィボナッチ数を100個求めたいと思ったのです.
その時, 初めて再帰爆発していることに気が付きました.
fay で出力したコードでは, すぐにフィボナッチ数100個を評価出来ました.


最初は原因すら分かりませんでした.
コードは thunk ばっかりで, 非常にデバッグしにくいものでした.
キャッシュしていないせいだと分かったのは, fay の出力コードを読み直した時でした.
これは, 再帰爆発に気がついた数日後, そしてこの記事を書いた前日でした.

コード全体

コピペして実行したい人のために全体のコード置いておきますね♡-(╹ヮ<✿)
以下のコードの実行結果はこちらです: http://ideone.com/5FmJha .
というより, 自分で実装しやがれ下さい♡-(╹ヮ<★)

function Thunk (value) {
  this.value = value;
}

function Lambda (fn) {
  this.fn = fn;
}

function App (fn, arg) {
  this.fn = fn;
  this.arg = arg;
}

function Evaluate (val) {
  while (val instanceof Thunk) {
    var v = val;
    if (v.evaluated) {
      val = val.value;
    } else {
      val = val.value();
    }
    if (val instanceof App) {
      val = (PeelLambda(Evaluate(val.fn)))(val.arg);
    }
    v.evaluated = true;
    v.value = val;
  }
  return val;
}

function PeelLambda (lam) {
  if (!(lam instanceof Lambda)) {
    throw "type error: apply a non-lambda to a value"
  }
  return lam.fn;
}

function Apply (fn) {
  return function (arg) {
    return new Thunk(function () {
      return new App(fn, arg);
    });
  };
}

// add = (+)
var add = new Lambda(function (x) {
  return new Lambda(function (y) {
    return new Thunk(function () {
      return Evaluate(x) + Evaluate(y);
    });
  });
});

// sub = (-)
var sub = new Lambda(function (x) {
  return new Lambda(function (y) {
    return new Thunk(function () {
      return Evaluate(x) - Evaluate(y);
    });
  });
});

function Cons (car, cdr) {
  this.car = car;
  this.cdr = cdr;
}

function Nil () {
}

// []
var nil = new Thunk(function () {
  return new Nil();
});

// (:)
var cons = new Lambda(function (x) {
  return new Lambda(function (xs) {
    return new Thunk(function () {
      return new Cons(x, xs);
    });
  });
});

// head [] = error "head: empty list"
// head (x:_) = x
var head = new Lambda(function (list) {
  return new Thunk(function () {
    var xxs = Evaluate(list);
    if (xxs instanceof Cons) {
      return xxs.car;
    } else {
      throw "head: empty list";
    }
  });
});

// tail [] = error "tail: empty list"
// tail (_:xs) = xs
var tail = new Lambda(function (list) {
  return new Thunk(function () {
    var xxs = Evaluate(list);
    if (xxs instanceof Cons) {
      return xxs.cdr;
    } else {
      throw "tail: empty list";
    }
  });
});

// map _ [] = []
// map f (x:xs) = f x : map f xs
var map = new Lambda(function (f) {
  return new Lambda(function (list) {
    return new Thunk(function () {
      var xxs = Evaluate(list);
      if (xxs instanceof Cons) {
        var x = xxs.car;
        var xs = xxs.cdr;
        return Apply(Apply(cons)(Apply(f)(x)))
                                (Apply(Apply(map)(f))(xs));
      } else {
        return nil;
      }
    });
  });
});

// take _ [] = []
// take n _ | n <= 0 = []
// take n (x:xs) = x : take (n - 1) xs
var take = new Lambda(function (n) {
  return new Lambda(function (list) {
    return new Thunk(function () {
      var xxs = Evaluate(list);
      if (xxs instanceof Cons) {
        var nval = Evaluate(n);
        if (nval <= 0) {
          return nil;
        } else {
          var x = xxs.car;
          var xs = xxs.cdr;
          return Apply(Apply(cons)(x))
                                  (Apply(Apply(take)(Apply(Apply(sub)(n))(one)))(xs));
        }
      } else {
        return nil;
      }
    });
  });
});

function Unit () {
}

// unit = ()
var unit = new Thunk(function () {
  return new Unit();
});

// print = \x -> log x; return ()
//   (not so monadic...)
var print = new Lambda(function (x) {
  return new Thunk(function () {
    console.log(Evaluate(x));
    return Apply(return_)(unit);
  });
});

// return
var return_ = new Lambda(function (x) {
  return new Thunk(function () {
    return x;
  });
});

// (>>)
var then = new Lambda(function (fn1) {
  return new Lambda(function (fn2) {
    return new Thunk(function () {
      Evaluate(fn1);
      Evaluate(fn2);
    });
  });
});

// mapM_ _ [] = return ()
// mapM_ f (x:xs) = f x >> mapM_ f xs
var mapM_ = new Lambda(function (f) {
  return new Lambda(function (list) {
    return new Thunk(function () {
      var xxs = Evaluate(list);
      if (xxs instanceof Cons) {
        var x = xxs.car;
        var xs = xxs.cdr;
        return Apply(Apply(then)(Apply(f)(x)))
                                (Apply(Apply(mapM_)(f))(xs));
      } else {
        return Apply(return_)(unit);
      }
    });
  });
});

// zipWith f (a:as) (b:bs) = f a b : zipWith f as bs
// zipWith _ _ _ = []
var zipWith = new Lambda(function (f) {
  return new Lambda(function (listx) {
    return new Lambda(function (listy) {
      return new Thunk(function () {
        var xxs = Evaluate(listx);
        if (xxs instanceof Cons) {
          var yys = Evaluate(listy);
          if (yys instanceof Cons) {
            return Apply(Apply(cons)(Apply(Apply(f)(xxs.car))(yys.car)))
                                    (Apply(Apply(Apply(zipWith)(f))(xxs.cdr))(yys.cdr));
          }
        } else {
          return nil;
        }
      });
    });
  });
});

var zero = new Thunk(function () {
  return 0;
});

var one = new Thunk(function () {
  return 1;
});

var twenty = new Thunk(function () {
  return 20;
});

var hundred = new Thunk(function () {
  return 100;
});

// inf = 0 : map (+1) inf
var inf = new Thunk(function () {
  return Apply(Apply(cons)(zero))
                          (Apply(Apply(map)(Apply(add)(one)))(inf));
});

// fib = 0 : 1 : zipWith (+) fib (tail fib)
var fib = new Thunk(function () {
  return Apply(Apply(cons)(zero))
                          (Apply(Apply(cons)(one))
                                            (Apply(Apply(Apply(zipWith)(add))(fib))(Apply(tail)(fib))));
});

// main = mapM_ print (take 100 fib)
var main = new Thunk(function () { 
  return Apply(Apply(mapM_)(print))(Apply(Apply(take)(hundred))(fib)); 
});

Evaluate(main);

Haskellで書くBrainfuckインタープリタ







注意: Haskellerの方は, 私のコードを見る前に自分で実装したほうが, 気持ちがよく分かると思います. 頑張って下さい. 自分で実装したのと, 私のコードを比べてみてください!!!













HaskellBrainfuckインタープリタ書きました.

-- Brainfuck interpreter in Haskell
import Data.Char (chr, ord)
import Control.Monad (void)
import Control.Arrow (first, app, (***), (>>>))

data BF = Incr | Decr | Next | Prev | Put | Get | While [BF]
type State = ([Int], Int, [Int])

(<>>) :: a -> ([a], b) -> ([a], b)
(<>>) = first . (:)

parse :: String -> [BF]
parse = fst . parse'
  where
    parse' :: String -> ([BF], String)
    parse' ('+':bs) = Incr <>> parse' bs
    parse' ('-':bs) = Decr <>> parse' bs
    parse' ('>':bs) = Next <>> parse' bs
    parse' ('<':bs) = Prev <>> parse' bs
    parse' ('.':bs) = Put <>> parse' bs
    parse' (',':bs) = Get <>> parse' bs
    parse' ('[':bs) = app $ ((<>>) . While *** parse') (parse' bs)
    parse' (']':bs) = ([], bs)
    parse' (_:bs)   = parse' bs
    parse' []       = ([], [])

run :: [BF] -> IO ()
run = void . flip run' ([], 0, [])
  where
    run' :: [BF] -> State -> IO State
    run' (Incr:bs) (xs, x, ys)    = run' bs (xs, x + 1, ys)
    run' (Decr:bs) (xs, x, ys)    = run' bs (xs, x - 1, ys)
    run' (Next:bs) (xs, x, [])    = run' bs (x:xs, 0, [])
    run' (Next:bs) (xs, x, y:ys)  = run' bs (x:xs, y, ys)
    run' (Prev:bs) s@([] , _, _)  = run' bs s
    run' (Prev:bs) (x:xs, y, ys)  = run' bs (xs, x, y:ys)
    run' (While _:bs) s@(_, 0, _) = run' bs s
    run' bbs@(While bs:_) s       = run' bs s >>= run' bbs
    run' (Put:bs) s@(_, x, _)     = putChar (chr x) >> run' bs s
    run' (Get:bs) (xs, _, ys)     = getChar >>= \x -> run' bs (xs, ord x, ys)
    run' [] s                     = return s

main :: IO ()
main = readFile "hello.bf" >>= (parse >>> run)
~$ echo "+++++++++[>++++++++>+++++++++++>+++++<<<-]>.>++.+++++++..+++.>-.------------.<++++++++.--------.+++.------.--------.>+." > hello.bf 
~$ runhaskell bf.hs 
Hello, world!%  
~$ 

(%記号は改行なしのアレ)



自分で言うのもなんだけど, コードが美しい...

「ifなしletなしswitchなし」は基本ですね.

これ以上に美しいコードが書けた人は, 勉強したいので教えてほしいです.

解説

main :: IO ()
main = readFile "hello.bf" >>= (parse >>> run)

これは, 次のコードと同じです.

main :: IO ()
main = do
  code <- readFile "hello.bf"
  run (parse code)

(>>>)は, (<<<)の逆で, (<<<)は(.)と同じです.
Control.Categoryの中で定義されていますが, Control.Arrowで再エクスポートされています.
上のコードのように, (>>=)と親和性がいいと思います.

data BF = Incr | Decr | Next | Prev | Put | Get | While [BF]
--         +     -     >      <      .     ,     [  ]

Brainfuckのコードの「素」を定義します.

data BF = Incr | Decr | Next | Prev | Put | Get | WhileStart | WhileEnd
--         +     -     >      <      .     ,     [            ]

という方法もあります.
こちらはコードに近くてパースはしやすいのですが, 実行しにくい形です.

type State = ([Int], Int, [Int])

ポインターの状態を表します.
(左, 今, 右)としました.
ポインター全体は, (reverse 左 ++ [今] ++ 右)となります.

data State = State { tape :: [Word8], pos :: Int }

みたいにすることもできますが, リストだとアクセスが遅い→Arrayにするか→めんどくさ...
的な, いつものあれなので.

あと, (左, 今, 右)とできるのは, Brainfuckで突然「絶対位置10の場所にジャンプ」とかが無く, 必ずすぐ左かすぐ右にしか動かないからですね.

(<>>) :: a -> ([a], b) -> ([a], b)
(<>>) = first . (:)

parse :: String -> [BF]
parse = fst . parse'
  where
    parse' :: String -> ([BF], String)
    parse' ('+':bs) = Incr <>> parse' bs
    parse' ('-':bs) = Decr <>> parse' bs
    parse' ('>':bs) = Next <>> parse' bs
    parse' ('<':bs) = Prev <>> parse' bs
    parse' ('.':bs) = Put <>> parse' bs
    parse' (',':bs) = Get <>> parse' bs
    parse' ('[':bs) = app $ ((<>>) . While *** parse') (parse' bs)
    parse' (']':bs) = ([], bs)
    parse' (_:bs)   = parse' bs
    parse' []       = ([], [])

Haskellの特徴である, 演算子を定義できるのを使ってみました.
例えば,

    parse' ('+':bs) = Incr <>> parse' bs

    parse' ('+':bs) = first (Incr:) $ parse' bs

と, さらに,

    parse' ('+':bs) = let (b, s) = parse' bs in (Incr:b, s)

と同じです.

'['のコードも, Arrowに慣れていないと意味不明ですよね.

    parse' ('[':bs) = app $ ((<>>) . While *** parse') (parse' bs)

は, 元に戻すと

    parse' ('[':bs) = let (b, s) = parse' bs in While b <>> parse' s

と同じで, 更に

    parse' ('[':bs) = let (b, s) = parse' bs 
                          (b', s') = parse' s
                          in (While b:b', s')

と同じです.

    parse' (_:bs)   = parse' bs

変な文字が入っていたら, それをスキップします.
スペースとか改行とかよく入っているので...

    parse' []       = ([], [])

終了条件. 大事.



次はrunを見てみましょう.

run :: [BF] -> IO ()
run = void . flip run' ([], 0, [])

これは,

run code = run' code ([], 0, []) >> return ()

と同じですね. ただ, ghc-modに怒られてしまうので, voidを使ってみました.

    run' :: [BF] -> State -> IO State
    run' (Incr:bs) (xs, x, ys)    = run' bs (xs, x + 1, ys)
    run' (Decr:bs) (xs, x, ys)    = run' bs (xs, x - 1, ys)

テープの現在の値に, 足したり引いたりします.

    run' (Next:bs) (xs, x, [])    = run' bs (x:xs, 0, [])
    run' (Next:bs) (xs, x, y:ys)  = run' bs (x:xs, y, ys)
    run' (Prev:bs) s@([] , _, _)  = run' bs s
    run' (Prev:bs) (x:xs, y, ys)  = run' bs (xs, x, y:ys)

ポインターを動かします.
ここでは, テープの長さは決め打ちせずに, 必要に応じて長くなるようになっています.
また, 本当なら負の領域にアクセスしたらダメなんですが, そういうことをやりだすとコードが汚くなっていくので, 左端に壁があるものとしました.

    run' (While _:bs) s@(_, 0, _) = run' bs s
    run' bbs@(While bs:_) s       = run' bs s >>= run' bbs

Whileループの実行です.
メモリーの今の位置の値が0なら, Whileをすっぽかして次のコードを実行します.
そうでなければ, Whileループの中を一回実行して, その結果の状態をまた判定します.

    run' (Put:bs) s@(_, x, _)     = putChar (chr x) >> run' bs s
    run' (Get:bs) (xs, _, ys)     = getChar >>= \x -> run' bs (xs, ord x, ys)

Putは出力, Getは入力ですね.
それぞれchr, ordを使ってIntと変換します.

    run' [] s                     = return s

終了条件. 大事.


改めてコードを見てみると, やはりコード全体が引き締まって見えますね.
ああ美しい.

インタープリタならデータ構造作らなくていいんじゃ

という説もありますが, やはりコードの上を行ったり来たりするのはアホらしいです.
特に, [ と ] の間は, いちいち「対応するカッコに(進む|戻る)」関数を書かなくてはならないので...
まぁ実際書いてみたら, 40行を切って, 一番上のコードより短くなったんですけどね.
でも汚いです.

ループのパースをどうやるか

上記のコードにたどり着くまで, ちょっとだけ時間がかかりました.

イメージしてください. Brainfuckのコードから, 再帰的な構造 While [BF] を作るタスクです.

パースする関数は, おそらく

parse :: String -> [BF]

でしょう.
完璧なコードしか入ってこないものとし, parse error, invalid codeとかは無いとします*1.

最初に思いつくのはこんな感じではないでしょうか.

parse ('[':bs) = let s = takeToMatchBracket bs
                     in While (parse s) : opps.....
takeToMatchBracket :: String -> String

対応するカッコまでの文字を持ってくる... あ, 残りも要りますがな...

parse ('[':bs) = let (l, r) = splitToMatchBracket bs
                     in While (parse l) : parse r
splitToMatchBracket :: String -> (String, String)

これに満足して, 実装しだしたら, 泥沼ですね. 最悪です.

何がダメかというと, コードの上を何度も舐めることになるからです.

もし, Brainfuckのコードが

+[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[-]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]

みたいなのだったらどうなるか, 想像付きますね?
splitToMatchBracket関数で最後まで舐めて, splitして, 更に切り出したものをparseに掛けます.
こんなアホらしいことやる人いませんね.



コードの上は一回舐めればいいはずです.
一回舐めたらBFの再帰的構造

data BF = Incr | Decr | Next | Prev | Put | Get | While [BF]

を作れるはずです.

どうすればいいのでしょうか.




ひとつの答えが, (結果, 未処理文字列)です.

    --        コード -> (結果, 未処理)
    parse' :: String -> ([BF], String)

こうしておくと, トップレベルのparse関数は

parse code = let (result, rest) = parse' code
                 in result

で,

parse code = fst (parse' code)

となり,

parse = fst . parse'

となることが分かりますね. (ただし, 入力がすべてvalidなコードとします)


では, parse'関数を書いてみましょう.
やはり, よくある再帰処理になります.

    parse' ('+':bs) = let (result, rest) = parse' bs
                          in (Incr : result, rest)

こんな感じですね.
しかし, 同様に書いていくと

    parse' ('+':bs) = let (result, rest) = parse' bs
                          in (Incr : result, rest)
    parse' ('-':bs) = let (result, rest) = parse' bs
                          in (Decr : result, rest)
    parse' ('>':bs) = let (result, rest) = parse' bs
                          in (Next : result, rest)
    parse' ('<':bs) = let (result, rest) = parse' bs
                          in (Prev : result, rest)
    parse' ('.':bs) = let (result, rest) = parse' bs
                          in (Put : result, rest)
    parse' (',':bs) = let (result, rest) = parse' bs
                          in (Get : result, rest)

とかなって, なんか嫌です.
同じ部分は関数にしましょう.

    parse' ('+':bs) = f Incr bs
    parse' ('-':bs) = f Decr bs
    parse' ('>':bs) = f Next bs
    parse' ('<':bs) = f Prev bs
    parse' ('.':bs) = f Put bs
    parse' (',':bs) = f Get bs
    f b bs = let (result, rest) = parse' bs
                 in (b : result, rest)

ええ, ましになりました.

ただ, Arrowを一度知った身としては, 「, rest)」のあたりが気になってしょうがありません.
まず, fからlet inを取り除きます.

    f b bs = first (b:) $ parse' bs

ここで, 一歩立ち止まります.
「fを演算子にしたらもっとかっこよくなるんじゃ?」
「でもparse'なんてものが入っているのを演算子とかにしたくないなぁ...」
「もっと一般的な部分を取り出して...」


というわけで, 一歩戻ります.

    parse' ('+':bs) = f Incr bs
    f b bs = let (result, rest) = parse' bs
                 in (b : result, rest)

要は, bをfstに入れ込むことがしたいのです.

    parse' ('+':bs) = f Incr bs
    f b bs = (\(l, r) -> (b:l, r)) (parse' bs)

そうか, parse'までfに入れなくていいんだ.

    parse' ('+':bs) = f Incr (parse' bs)
    f b bs = (\(l, r) -> (b:l, r)) bs

fを演算子にして

(<>>) :: a -> ([a], b) -> ([a], b)
(<>>) b (l, r) = (b:l, r)

    parse' ('+':bs) = Incr <>> parse' bs

おお, カッコいい!!!


記号は基本的になんでもいいので, 「右のタプルに入れ込む」みたいな気持ちを込めて(<>>)にしてみました.

ここで, 悪魔がささやきます.
「これ, Arrowで書いたらモテるんじゃね?」

firstを使って

(<>>) b (l, r) = first (b:) (l, r)

η変換して

(<>>) b = first (b:)

或いは

(<>>) b = first $ ((:) b)

($) を (.) に置き換えて

(<>>) b = first . (:) $ (b)

η変換して

(<>>) = first . (:)

完成.

バッチリです.

これで気になるあの娘も落とせそうですね.




さて,

    --        コード -> (結果, 未処理)
    parse' :: String -> ([BF], String)

の形にしたのは, ループのパースのためでした.
取り敢えず, ループの最後は

    parse' (']':bs) = ([], bs)

と書くことができます.
ループの最後に到達したら, 取り敢えずそれまでも[BF]の結果を返してあげて, 残りのコードは未処理とするのです.

ではループの最初はどうするかというと,

    parse' ('[':bs) = let (result, rest) = parse' bs
                          in ...

この段階で, resultには括弧中の結果が, restには未処理のコードが入ります.
従って, restをまたparse'で処理して

    parse' ('[':bs) = let (result, rest) = parse' bs
                          (result', rest') = parse' rest
                          in (While result : result', rest')

が正解ですね.



すぐ分かるように, While result : の部分は, さっきも見た「タプルのfstの要素の最初に追加する系」です.
従って,

    parse' ('[':bs) = let (result, rest) = parse' bs
                          in While result <>> parse' rest

となります.


しかし, Arrow病を発病すると, こんなタプルでさえ耐えられなくなってきます.
とにかく変換します.

    parse' ('[':bs) = let (result, rest) = parse' bs
                          in (((<>>) . While) result) (parse' rest)

(result, rest)が引数となるような関数をArrowで作ります. (f a) (g b) == app $ (f *** g) (a, b)ですね. (app :: (b -> c, b) -> c ですよ!)

    parse' ('[':bs) = let (result, rest) = parse' bs
                          in app $ (((<>>) . While) *** parse') (result, rest)

そうするとlet inを消すことができて

    parse' ('[':bs) = app $ (((<>>) . While) *** parse') (parse' bs)

さらに, (.)の優先度は9, (***)の優先度は3なので, 括弧がひとつ不要です.

    parse' ('[':bs) = app $ ((<>>) . While *** parse') (parse' bs)


こうやって一番最初のコードにたどり着いたのです.


Arrowを知ってたらコードの流れがよく分かりますね.
「appで適用して... *** は上と下に並行して適用して...」


まとめ

言いたいことは, Arrowバンザイではなくて, 妥協して効率の悪いプログラムを書くな, ですね.
Whileのために, 入力のコードの上を何度も行ったり来たりするのなんて馬鹿げてますよね.
そんな効率の悪いコード, C言語じゃ書かないでしょう?
Haskellだから許される, ではありません.
型を考えなさい, それが良い処方箋ですね.


ところで, Brainfuckインタープリタは, なんかいつ書いても飽きないですね.
あと, parse'やrun'をfoldrか何かを使って書こうとしたけど失敗したので, 誰かやっておいてください. できるかどうかしらんけど.

追記(2012/12/24)

最近fmapの有用性に気がついたのですが, 上に書いた(<>>)は, (<$>)で書けることに気が付きました.
Functor ((,) a)なので, タプルを逆にしなきゃいけないんですけどね.

import Data.Functor ((<$>))
import Control.Monad.Instances

parse :: String -> [BF]
parse = snd . parse'
  where
    parse' :: String -> (String, [BF])
    parse' ('+':bs) = (Incr:) <$> parse' bs
    parse' ('-':bs) = (Decr:) <$> parse' bs
    parse' ('>':bs) = (Next:) <$> parse' bs
    parse' ('<':bs) = (Prev:) <$> parse' bs
    parse' ('.':bs) = (Put:) <$> parse' bs
    parse' (',':bs) = (Get:) <$> parse' bs
    parse' ('[':bs) = app $ (flip (<$>) . parse' *** (:) . While) (parse' bs)
    parse' (']':bs) = (bs, [])
    parse' (_:bs)   = parse' bs
    parse' []       = ([], [])

*1:つまりパーサー的な失敗系にする必要がない. [なしの]は, そこで打ち切り, ]なしの[は, 最後にマッチする]を加えたのと同様に動きます.