popwin.elと相性が良いシンプルなディレクトリ・エクスプローラ、direx.elを作りました

振り返ってみれば、今年は、人に与えるということをあまりしてなかった気がします。ブログもろくに書きませんでしたし、ソフトウェアの開発も、本やら論文を読んでばかりで、あまり進みませんでした。このような状況を反省しつつ、また、気持ちの良い新年を迎えるために、ここは一つ、皆様にクリスマスプレゼントを提供する形で、タイトルにあるようなEmacs拡張を作ってみました。

diredの問題点

direxは、popwin.el同様、私の長年の不満を解消するために開発された拡張です。Emacsにおけるディレクトリ操作には、基本的にdiredを利用しますが（少なくとも私は）、このdired(DIRectory EDitor)というのは、その名の通り、ディレクトリを編集（ファイルのコピーや移動など）するのに特化した拡張で、ディレクトリをフラットにしか表示できないため、閲覧性が悪く、構造的な操作が難しいという欠点を持っています。

スクリーンショットを見ていただければ分かると思いますが、その表示領域のほとんどが、パーミションやファイルサイズなどの、基本的に不要な情報によって占められているのが分かると思います。また、 dired-maybe-insert-subdirによって挿入されたサブディレクトリが、ツリー状にではなく、バッファの末尾にフラットに展開されて表示されるため、ディレクトリの構造を把握しづらいというのも分かると思います。もちろんこのような表示が、ディレクトリ・エディタたることの要求であることは分かりますが、もう少し何とかならんのかと思います。

では、diredではなく他の拡張を使えばよいだろうと思われるでしょうが、実際のところdired以上に（ディレクトリ・エクスプローラとして）使いやすい拡張は今のところ知りません。ディレクトリ編集に特化したdiredに、閲覧性や操作性で負ける拡張がほとんどだというのが現実です。

direxの特徴

そこで開発したのがdirex(DIRectory EXplorer)で、その名の通り、ディレクトリを探索するのに特化しています。もちろんファイルの削除やコピーといった基本的な操作も可能ですが、現時点ではまだ実装していません。

diredとの最も大きな違いは、やはりその表示形式です。diredはディレクトリをフラットに表示するのに対して、direxはディレクトリを可能な限りコンパクトにツリー状に表示します。

また、ツリーをあまり強調せずに自然な操作で移動できるのも特徴です。ちなみに私はdiredユーザーなので、diredの操作性をある程度模倣しています。

direxの設計

先述したように私は、かなり長い間diredを使っていますが、基本的にdiredバッファを意識しておらず、ファイルの編集中に、そのファイルのディレクトリを開きたくなった際、適宜C-x C-j (dired-jump)を呼び出す、という使い方をしています。ですから、dired-jumpの機能性が、（私の）パフォーマンスを上げる上で最大のポイントとなります。

そこで用意したコマンドが、direx:jump-to-directoryで、このコマンドは dired-jumpと同様の機能を持ちながら、diredが抱える次の二つの問題を見事に解決してくれます。

1. diredはディレクトリをフラットに表示するためdired-jumpしたときに直近 のサブディレクトリが別バッファで表示されてしまう。
2. diredの表示は幅をとるため、popwinと組み合わせて利用するのが難しい。

(1)に関しては特に、ディレクトリ構造の深いプロジェクトで開発する際に問題になります。diredのようにサブディレトリを一つ一つ別バッファで表示するのではなく、プロジェクトルートからツリーを展開した状態のバッファを表示するのが理想でしょう。

(2)に関しては、直接的な問題ではないですが、私にとっては重大です。過去に一度、diredバッファをpopwinで表示する設定を行ったことがありますが、横幅の関係から、Windows Explorerのようにウィンドウの左辺にディレクトリの内容を表示するといったことが出来ませんでした。下辺に表示しても、今度は縦幅が小さすぎて一覧性が悪くなってしまいました。

結局のところ、私としては、あるファイルでC-x C-jなどとすると、そのファイルのディレクトリを含むプロジェクトツリーを、ウィンドウ左辺に表示することが理想となります。

スクリーンショットで示すと次のようになります。

操作前

操作後

このような設計になっていることから、direxのパワーを最大限発揮するには、 popwinの存在が不可欠であると言えます。

インストール方法

クリスマスに間に合わせたかったので、必要最低限の機能しか実装していません。また、Emacs 22,23,24で少し動かしてぐらいであまりテストしていません。今後少しづつ開発を進める予定です。

インストールするには、以下のURLからdirex.elをダウンロードしてきて、ロードパスの通ったディレクトリに配置します。

https://github.com/m2ym/direx-el

install-elispがある方は次の式を評価することでインストールできます。

(install-elisp "https://raw.github.com/m2ym/direx-el/master/direx.el")

続いて、.emacsに次のようなコードを記述すればインストール完了です。

(require 'direx)

また、popwin.elと一緒に利用する場合（推奨）、popwin.elを開発版を利用する必要があります（現在v0.4を開発中）。以下のURLからインストールをしてください。

https://github.com/m2ym/popwin-el

popwin.el自体のインストール方法や使い方は、少し古いですが以下の記事を参照してください。

http://d.hatena.ne.jp/m2ym/20110120/1295524932

使い方

「direxの設計」で示した機能の使い方を紹介します。それ以外の機能は、今のところかなりどうでもよいものばかりです。

それで、その肝心な機能がdirex:jump-to-directoryで、このコマンドは、現在開いているファイルのディレクトリをツリー状に表示して、バッファを選択します。もし、開こうとしているディレクトリを子孫に持つディレクトリがすでにdirexで表示されている場合、そのツリーを展開した状態でバッファを選択します。

このコマンドを次のようにC-x C-jに割り当てて利用するだけでも価値がありますが、

(global-set-key (kbd "C-x C-j") 'direx:jump-to-directory)

是非ともpopwinと一緒に利用しましょう。popwinの設定は以下のようになります。

;; direx:direx-modeのバッファをウィンドウ左辺に幅25でポップアップ
;; :dedicatedにtを指定することで、direxウィンドウ内でのバッファの切り替えが
;; ポップアップ前のウィンドウに移譲される
(push '(direx:direx-mode :position left :width 25 :dedicated t)
      popwin:special-display-config)

試しにM-x direx:jump-to-directory-other-windowを実行してみてください。ウィンドウ左辺にdirexバッファがポップアップされれば成功です。ウィンドウを閉じるにはqあるいはC-gを押します。

最後に、このコマンドを次のようにC-x C-jに割り当てましょう。

(global-set-key (kbd "C-x C-j") 'direx:jump-to-directory-other-window)

これで、どのファイルにいてもC-x C-jするだけでそのファイルを含むディレクトリをポップアップウィンドウにツリー状に表示することができます。

また、ツリーの表示で使われる罫線の形状も、ある程度設定可能になっています。私の設定は次のようになります（TextMate風）。

(setq direx:leaf-icon "  "
      direx:open-icon "▾ "
      direx:closed-icon "▸ ")

なお、direxバッファでのキーバインドは次のようになります。

キー	コマンド	説明
n, C-n, <down>	direx:next-node	次のノードを選択する
p, C-p, <up>	direx:previous-node	前のノードを選択する
C-M-n, C-M-<down>	direx:next-sibling	次の兄弟ノードを選択する
C-M-p, C-M-<up>	direx:previous-sibling	前の兄弟ノードを選択する
^, C-M-u, C-M-<left>	direx:up-node	親ノードを選択する
C-M-d, C-M-<right>	direx:down-node	最初の子ノードを選択する
f	direx:find-node	そのノードを現在のウィンドウに開く
o	direx:find-node-other-window	そのノードを別のウィンドウに開く
RET	direx:maybe-find-node	そのノードをトグルする
q	quit-window	ウィンドウを閉じる

以下で、現時点で実装されているコマンドをいくつか紹介します。

direx:find-directory

指定されたディレクトリをdirexで表示します。

direx:find-directory-other-window

direx:find-directoryと同じですが、別ウィンドウで表示される点が異なります。

今後の課題

diredを本格的に置き換えるにはまだまだ機能が足りません。しばらくはdired とdirexの使い分ける必要があるでしょう。今後、実装する予定の機能としては、

• ファイル操作（コピーや移動、マーク）
• フィルタや検索機能
• Tramp対応
• imenuをdirexで表示
• 高速化

などが挙げられます。

direxはディレクトリに限らずツリーのようなものは何でも表示・操作できるように抽象化された設計になっています。こういうものをdirexで表示すると面白いのでは、といったアイデアがあれば是非教えてください。また、direxや popwinに何か問題があれば私に連絡していただけると助かります。連絡先は @m2ymあるいはです。

それでは、良いお年を。

『タオのプーさん』からの引用

世の事なかれ主義のペシミストたちは、なんであれたいしたことは絶対やりとげない。なぜなら、状況をはっきりと客観的な目で見ることがなく、自分の能力を認めも信じもせず、たとえわずかな危険でも、それを克服するために自分の能力をせいいっぱい発揮しようというところもないからだ。たとえば、かの有名なノース・ポール（北極）発見の探検中、ルーが小川に落ちたとき、陰気なイーヨーはどういう手を打ったか？ルーが流れに運ばれてだいぶたってから、気のないやり方でしっぽを水の上にたらし、ルーがつかんでよじのぼれるようにした─というより、もっと正確にいうなら、イーヨーだってなにもしなかったわけじゃあない、とみんなにいってもらえるようにした。もちろん自分でも、本気でそれがなにかの足しになるとは思っていなかったし、もちろんなんの足しにもならなかった。

これを読んでハッと気が付かない人は、よほど人間が出来ているか、そうでなければ救えないぐらい鈍感なのだろう。

タオのプーさん

posted with amazlet at 11.12.20

ベンジャミン・ホフ
平河出版社
売り上げランキング: 62018

Amazon.co.jp で詳細を見る

AllegroGraphでSemantic Wikipediaを実装してみた

この記事は、Ariel Advent Calendar 2011 の17日目の記事です。

Semantic Wikipediaとは

Wikipediaに蓄積された多量の情報は、MediaWikiのWiki記法を用いて記述され ています。この記法は、人間が記述するのには適していますが、例えば機械に 意味を理解させるのには向いていません。実は、この問題は、もっと昔から、 さらに広い範囲で顕在化していました。つまりHTMLの問題です。

HTMLは、人間が記述したり、機械に読み取らせて、"機械的"に画面を構成する のには適していますが、その意味を機械に理解させるのには向いていません。 そこで考えられたのがSemantic Webというアイデアで、我々の意味理解の基盤 である論理言語を、メタ言語としてWebの世界に導入して、人間と機械とで"意 味"を共有しようという大きな目標が掲げられました。

このアイデアはWikipediaに対しても適用できます。例えば、もし、Wikipedia のデータベースが、人間と意味を共有しているなら、次のような質問に答える のは容易なはずです。

問： 広島県出身のテクノポップミュージシャンは？
答： Perfume

ところが、このような質問をWikipediaに問い合わせるのは現状では不可能です。 そこで、Semantic Webのアイデアを応用して作られたのが Semantic MediaWikiで、Wiki記法を厳密 化・構造化し、さらに既存の構文を適当に解釈することで、機械でも意味を理 解できるようにする拡張が加えられています。詳しく調べていないので正確で ないかも知れませんが、Semantic MediaWikiをWikipediaに導入すれば、上記し たような質問にも答えられる、Semantic Wikipediaを構築できるはずです。

この記事では、Semantic MediaWikiを使わず、AllegroGraphという永続グラフ データベースを利用して、一からSemantic Wikipediaを構築する手順と、 Semantic Wikipediaの意義について説明します。

AllegoGraphとは

実装の話に入る前にまず、AllegroGraphについて解説します。AllegroGraphは 公式には永続グラフデータベースと呼ばれていますが、より厳密に言えば、 AllegroGraphとは、トリプルストアに様々な優れた拡張を加えたデータベース と言えます。Semantic Webを勉強するにあたっては、後者の定義を利用したほ うが都合が良いでしょう。なぜなら、RDF・RDFS・OWLなどのSemantic Webに関 する重要な仕様は全て、トリプルの概念を基盤としているからです。グラフも トリプルの集合も本質的には同じですが、概念の粒度が異なりますので、分け て考えたほうが良いでしょう。

さらに厳密を期せば、トリプルストアという呼び方も正しくありません。トリ プルストアを言葉通り捉えれば、トリプルを格納（ストア）するものですが、 AllegroGraphは、トリプルを格納する機能に加えて、RDF・RDFS・OWLに基づく 推論機（RDF++ reasoner）や検索機能（SPARQL、Prolog）など、様々な重要な 機能が追加されているからです。ここで、推論機と検索機能について簡単に説 明します。

推論機とは、RDF・RDFS・OWLに基づいて、充足されるべきトリプルを自動的に 演繹する機能です。具体例を示します。OWLには、二つの対象が同じであること を宣言するowl:sameAsプロパティがありますが、このプロパティは、同じく OWLで推移律を満たすプロパティ（関係）であると言明（assert）されています。 例えば、

A owl:sameAs B
B owl:sameAs C

という二つのトリプルがあったとき、推論機はowl:sameAsが推移律を満たすプ ロパティであることを確認した上で、新しく

A owl:sameAs C

というトリプルを追加します。RDFS・OWLを使えば、他にも様々な言明が可能で すが、詳しくは仕様やAllegroGraphのドキュメントを参照してください。

検索機能には、SPARQLやPrologが挙げられますが、私はPrologを好んで使うの でこちらを紹介します。Allegro Common Lispに付属のProlog機能は、 AllegroGraphと統合して利用することが可能で、例えば次のようなクエリを書 くことができます。

;; ミケとポチを飼っている人を取得
(select ?x
  (q- ?x !rdf:type !ex:Human)
  (q- ?x !ex:has-pet !ex:Mike)
  (q- ?x !ex:has-pet !ex:Pochi))

その他にもAllegroGraphには様々な機能がありますのでドキュメントを参照し てください。

Semantic Wikipediaの実装

前述したように、Semantic Wikipediaを作る上で最大の難関はいかに関係性を 抽出するかです。一番最初に思い付くのは、あるページとそのページに含まれ る全てのリンクについて、次のようなトリプルを追加することです。

w:黒澤明 w:links-to w:七人の侍

w:links-toプロパティについてはOWLのinverseOfプロパティで逆プロパティを 定義しておくと便利でしょう。当然ながらAllegroGraphの推論機が自動的に推 論してくれます。

w:linked-by owl:inverseOf w:links-to

例えば、以下のようなクエリを発行すれば、

(select ?link (q !w:黒沢明 !w:links-to ?link))
;; 以下も同様
(select ?link (q ?link !w:linked-by !w:黒沢明))

次のような結果が得られます。

("七人の侍" "用心棒" "姿三四郎" "生きる" "白痴" "椿三十郎" ...)

なお、カテゴリ・リンクもリンクとして処理されるので、以下のようなクエリも有効です。

(select ?x (q ?x !w:linked-by !w:日本の俳優))

次に思い付くのがInfoboxなどのテンプレートの情報を利用することです。人物 や作品に関するページには、ページの右側にその人物や作品に関する情報が記 載されています。例えばPerfumeの ページには次のような記載があります。

Perfume
基本情報
出身地    日本 広島県
ジャンル    テクノポップ
活動期間    2001年 -
レーベル    徳間ジャパン
事務所   アミューズ
共同作業者 中田ヤスタカ
影響  SPEED
公式サイト Perfume Official Site
メンバー
大本彩乃（のっち）
樫野有香（かしゆか）
西脇綾香（あ〜ちゃん）

このページのソースを見れば、この記載には次のようなテンプレートが使われ ているのが分かります。

{{Infobox Musician <!--Wikipedia:ウィキプロジェクト 音楽家を参照-->
| Name = Perfume
| Img =
| Img_capt = 左より[[樫野有香]]、[[大本彩乃]][[西脇綾香]]
| Img_size = <!-- サイズが250ピクセルに満たない場合のみ記入 -->
| Landscape = yes
| Background = group
| Origin = {{JPN}} [[広島県]]
| Genre = [[テクノポップ]]
| Years_active = [[2001年]] -
| Label = [[徳間ジャパンコミュニケーションズ|徳間ジャパン]]
| Production = [[アミューズ]]
| Associated_acts = [[中田ヤスタカ]]
| Influences = [[SPEED]]
| URL = [http://www.perfume-web.jp/ Perfume Official Site]
| Current_members = [[大本彩乃]]（のっち）<br />[[樫野有香]]（かしゆか）<br />[[西脇綾香]]（あ〜ちゃん）
| Past_members = <!-- グループのみ -->
| Notable_instruments =
}}

これを解析することで、その主体に適当な属性を付与することが出来ます。

w:Perfume w:described-as w:Musician
w:Perfume w:Name Perfume
w:Perfume w:Origin w:広島県
w:Perfume w:Genre w:テクノポップ
w:Perfume w:Production w:アミューズ
w:Perfume w:Associated_acts w:中田ヤスタカ
w:Perfume w:Current_members w:大本彩乃
w:Perfume w:Current_members w:樫野有香
w:Perfume w:Current_members w:西脇綾香

なお、テンプレートの各引数の右辺にあらわれる文字列が、構造的に記述がさ れている場合があり、例えば 三船敏郎 の家族の項目は

| 家族 = 父：三船徳造<br />妻：吉峰幸子<br />長男：[[三船史郎]]<br />妾：[[喜多川美佳]]<br />娘：[[三船美佳]]<br />孫：三船力也

となっています。これを正しく解析できれば、

(select ?x (q !w:三船敏郎 !w:娘 ?x))
=> ?x = 三船美佳

のようなクエリも可能になります。

さらに、Wikipediaでは多数のエイリアスが定義されています。例えば、 アルコール飲料 のページを開くと、 酒 のページの内容が表示されますが、クエリを書くにあたっても、"アルコール飲 料"と"酒"は区別したくありません。具体的には、

(select ?x
  (q ?x !w:described-as !w:作家)
  (q ?x !w:links-to !w:酒))

と

(select ?x 
  (q ?x !w:described-as !w:作家)
  (q ?x !w:links-to !w:アルコール飲料))

を区別したくありません。そこでOWLのsameAsプロパティを使って、二つが同じ であることを言明します。

w:酒 owl:sameAs w:アルコール飲料

このトリプルを追加しておけば、あとはAllegroGraphの推論機が良きに図らっ てくれます。

他に考慮すべき点と言えば、例えば、 黒沢明の作 品一覧をトリプルに落とし込めれば嬉しいと思いますが、この記述には、テン プレートと比べて一般的なテーブル記法が用いられているため、解析が難しい という問題があります。

また、OWLの積極的に利用することで、より厳密なモデル化が可能になるでしょ うが、今回は時間の関係でかなり端折っています。

以下に、AllegroGraphを利用して実際にSemantic Wikipediaを構築する手順を 示します。まだ、おもちゃのレベルなのであまり期待しないでください。なお Allegro Common Lisp、AllegroGraphともにFree editionが用意されているので 誰でも試すことは出来ると思います。

まず、以下のURLからリポジトリをcloneして、Quicklispでロードできるように してください。

https://github.com/m2ym/semantic-wikipedia

次にAllegro Common Lispを起動し、次のように入力します。

CL-USER> (ql:quickload :semantic-wikipedia)
CL-USER> (in-package :semantic-wikipedia)
SEMANTIC-WIKIPEDIA> (create-triple-store #p"~/tmp/wikipedia")
SEMANTIC-WIKIPEDIA> (apply-rdfs++-reasoner)

続いてWikipediaのダンプXMLから、必要なトリプルをAllegroStoreにロードす るように命令します。なおダンプXMLは http://dumps.wikimedia.org/jawiki/latest/ からダウンロードできます。

SEMANTIC-WIKIPEDIA> (load-wikipedia-xml #p"~/tmp/jawiki-latest-pages-articles.xml")

これには、かなり時間がかかります。また、膨大な数のトリプルをロードする ため、トリプル数に制限のあるAllegroGraphでは途中で失敗します。ロードで きなかった情報にこだわらなければ、次の作業にそのまま進むことができます。

トリプルをロードできたら、それらのトリプルのインデックスを生成します。

SEMANTIC-WIKIPEDIA> (index-all-triples)

これでSemantic Wikipediaの構築が完了しました。

Semantic Wikipediaの実験

それでは実際にいくつかのクエリを投げてみましょう。

広島県出身のテクノポップミュージシャンは？

(select ?x
  (q ?x !w:described-as !w:Musician)
  (q ?x !w:Origin !w:広島県)
  (q ?x !w:Genre !w:テクノポップ))
=> ("Perfume")

家族に俳優/女優のいる女性モデルは？

(select (?x ?y)
  (q ?x !w:家族 ?y)
  (q ?x !w:described-as !w:ActorActress)
  (q ?y !w:described-as !w:女性モデル))
=> (("三船敏郎" "三船美佳")
    ...)

1923年生まれで芥川賞を受賞した作家は？

(select ?x
  (q ?x !w:described-as !w:作家)
  (q ?x !w:birth_date !w:1923年)
  (q ?x !w:awards !w:芥川龍之介賞))
=> ("遠藤周作")

配偶者ともに同じ職業の夫婦は？

(select (?x ?y ?z)
  (q ?x !w:described-as ?z)
  (q ?y !w:described-as ?z)
  (q ?x !w:配偶者 ?y))
=> (("ニコール・キッドマン"
     "トム・クルーズ"
     "ActorActress")
    ("ブラット・ピット"
     "アンジェリーナ・ジョリー"
     "ActorActress")
    ("市村正親"
     "篠原涼子"
     "ActorActress")
    ("山口百恵"
     "三浦友和"
     "ActorActress")
    ...)

どういう経緯で結婚したか、大体想像が付きますね。

今後の課題

今後の課題としては、

1. より多くのテンプレートの解釈
2. テーブルやリストの解釈
3. 厳密なオントロジーの構築
4. 高速化

などが考えられます。地道にやりたいと思いますが、AllegroGraphのトリプル 数制限をすでに軽く越えているので、これより先に進める気がしません。どう したらいいのだろう…

Semantic Wikipediaの今後として、WikipediaがSemantic Webに近づいてくる可 能性もないとは言えませんが、これまでのHTMLの動向を見るに、Wikipediaが Semantic Webに対応するのは未来永劫ないでしょう。人力で支えられているシ ステムである以上、人に制約を課すというのはあまりうまくいかないと思いま す。それより、既存のシステムをいかにSemantic Webに対応させていくかが今 後重要になるでしょう。Wikipediaに関して言えば、自然言語処理などの技術が 必要になると思われます。

次回は永遠の王子、@nagai_masatoさんです。

コンパイラマクロとインライン展開とその問題

最近、Allegro Common Lisp の Enterprise 版が手に入り、最適化熱を再燃させています。その手始めとして、Computer Language Benchmarks Game の Lisp プログラムを高速化しようとしましたが、正直に言って、これらのプログラムは Lisp らしからぬ書きぶりで（いやむしろ Lisp らしいと言ったらいいのか）、高速化しようにもなかなか手が付けられない状態です。どういうことかと言うと、例えば fannkuch-refux には次のようなマクロがあります。

(defmacro setlambda(n)
  (declare (type fixnum n))
  (let ((copy (gensym))
        (perm (gensym)))
  `(lambda (,perm ,copy)
     (declare (optimize (speed 3) (safety 0) (space 0) (debug 0))
      (type (simple-array sb (,n)) ,copy ,perm))
     ,@(loop for i of-type fixnum from 0 below n collect
         `(setf (aref ,copy ,i) (aref ,perm ,i))))))

このマクロは、プログラムの開始時に与えられた n でもって、 (eval `(setlambda ,n)) することで、 n に特化したループしない配列コピー関数を作るためのもので、良く言えば Lisp らしいと言えます。ただ、僕の哲学から言えば（納期に追われ、有無を言わさず高速化する必要がある場合を除いて）、これはむしろ Lisp のバッドノウハウと言いたくなります。なぜなら、Lisp には、コードの可読性を落とさずに、そのような目的を達成する手段があると信じているからです。今回は、件のマクロでやっている、手動 loop unrolling をもっと美しく達成する方法について考えます。なお、議論を明確にするため dotimes に対する最適化にフォーカスします。

まずナイーブな方法として、次のような専用のマクロを作る方法が考えられます。

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defparameter *loop-unrolling-threshold* 32))

(defmacro dotimes/unrolling ((var count &optional result) &body body)
  (if (and (integerp count)
           (< count *loop-unrolling-threshold*))
      `(block nil
         ,@(loop for i from 0 below count
                 collect `(let ((,var ,i)) ,@body))
         ,result)
      `(dotimes (,var ,count ,result) ,@body)))

このマクロは与えられた count が整数で一定の閾値未満なら loop unrolling を行います。例えば、

(dotimes/unrolling (i 10) (print i))

このコードは次のようなコードに macroexpand されます。

(BLOCK NIL
  (LET ((I 0))
    (PRINT I))
  (LET ((I 1))
    (PRINT I))
  (LET ((I 2))
    (PRINT I))
  (LET ((I 3))
    (PRINT I))
  (LET ((I 4))
    (PRINT I))
  (LET ((I 5))
    (PRINT I))
  (LET ((I 6))
    (PRINT I))
  (LET ((I 7))
    (PRINT I))
  (LET ((I 8))
    (PRINT I))
  (LET ((I 9))
    (PRINT I))
  NIL)

実際のところ、製品レベルで使うようなものでは、このようなマクロが現実的ですが、せっかく Lisp なのだからもう少し面白いことがしたいですね。そこで、もう一つの方法としてコンパイラマクロを使う方法を考えてみます。

コンパイラマクロを使えば、関数やマクロの挙動を部分的に最適化することが可能です。そのため、上のようにわざわざ dotimes/unrolling など作らなくとも dotimes コンパイラマクロを定義すれば良いのです。

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defparameter *loop-unrolling-threshold* 32))

(define-compiler-macro dotimes (&whole form (var count &optional result) &body body)
  (if (and (integerp count)
           (< count *loop-unrolling-threshold*))
      `(block nil
         ,@(loop for i from 0 below count
                 collect `(let ((,var ,i)) ,@body))
         ,result)
      form))

これで、通常通りコードを書けば最適化してくれます。

；； loop unrolling されるはず
(dotimes (i 10) (print i))

なお、上のコンパイラマクロを定義するとき、ACL や SBCL では package violation エラーが発生します。 cl パッケージのマクロの挙動を変更するわけですから、危険極まりないですし、当然の処置です。遊ぶときだけ適当に unlock しましょう。

それでは、コンパイラマクロ付きの dotimes を使って最初のマクロを関数に書きなおしてみましょう。

(declaim (inline copy))
(defun copy (dest src n)
  (dotimes (i n)
    (setf (aref dest i) (aref src i))))

例のマクロは、配列をコピーする関数を作るマクロなので、少し一般化しています。また、簡単のため宣言は省いています。私としては、

(let* ((n 10)
       (dest (make-array n))
       (src (make-array n)))
  (copy dest src n))

のようなコードにおいて、 copy の呼び出しがインライン展開され、そのとき n=10 というのが分かっているので、同時に dotimes のコンパイラマクロが展開され、loop unrolling が起こることを期待していたわけですが、よくよく考えれば、これは起こり得ないだろうと予想されます。

インライン展開の厳密な挙動は CLHS に述べられていないため、ここからは処理系依存の話になりますが、一般的に考えて、コンパイラマクロは"マクロ"である以上、そのマクロ展開時に渡される引数（項）はまさにそこにあるべきで、上の例で言えば、インライン展開された dotimes のコンパイラマクロは、10 という定数を取るわけではなく、まさにそこにある n を引数として取るのが常識的と言えるでしょう。

そのため、開発者の意図と、コンパイラマクロ+インライン展開の仕様との間には、ある種のギャップがあると言えます。仕様としての有効な解決手段は、私は思いつきませんが、例えばレキシカル環境にその変数が静的に取り得る定数を格納しておき、 CLtL2 の variable-information で取り出せるようにするのはどうかと考えています。疑似コードで示せば次のようになります。

(eval-when (:compile-toplevel)
  (defun static-constant-value (obj env)
    (cond ((constantp obj) obj)
          ((symbolp obj)
           (nth-value 3 (variable-information obj env))))))

(define-compiler-macro dotimes (&whole form &environment env (var count &optional result) &body body)
  (aif (static-constant-value count env)
       `(block nil
          ,@(loop for i from 0 below it
                  collect `(let ((,var ,i)) ,@body))
          ,result)
       form))

上の例では variable-information を使いましたが、処理系依存の関数を用意しても良い気がします。そこで SBCL 限定で、そのような関数、あるいは同じような目的を達成する手段がないか探してみたところ、 wanted: compiler macro expansion in later compilation stages (e.g. after inlining) という要望を見つけました。この人の要望というのは、まさに私の要望と同じで、静的に決定する正規表現の文字列に関して cl-ppcre:scan のコンパイラマクロを動作させたいというものです。この要望を客観的に見たとき、やはりこのような要望は自然であるし、インライン展開するのであれば、当然満たしておきたい要件でもあります。

SBCL のコアデベロッパである Nikodemus Siivola は、この要望に対して肯定的な態度をとっており、実際にこの問題を解決するためのパッチも提供しています。ただ、現時点では SBCL の HEAD にはそれに該当するコードが見つかりません。コメントを見るに、 Nikodemus はこのパッチに若干の苦悩を抱えており、なかなかマージに至れないという状況なのだと予想されます。 Nikodemus のパッチは、コンパイラマクロに渡されるシンボルを、可能であれば定数に置き換えるというもので、先に述べたようなコンパイラマクロが"マクロ"でなくなる点で苦悩しているようです。この方法は、コンパイラマクロに定数展開のコードを書かなくても良い点でメリットがありますが、やはりコンパイラマクロのなんぞやが問われる点で、デメリットのほうが大きいと私は考えます（おそらく Nikodemus も同じ）。やはり、コンパイラマクロ内部で、定数展開するための、専用の関数なりを用意するのが一番だと思いますが、そういう関数は今のところ見つかってないですし、 Nikodemus 自身もそのような発想はないようです、もしかしたら、そういった関数をそもそも定義できないのかもしれませんが、まだ SBCL のソースを眺めている段階で何とも言えません。

以上、コンパイラマクロ+インライン展開でも期待された最適化が行われない可能性が高いという話でした。ぐだぐだな上、特にオチはなし、終わり。

Clojure 1.3 のパフォーマンスに驚いた話

Clojureの今によると、 Clojure 1.3 からプリミティブ型による型注釈が可能になったようです。プリミティブ 型による型注釈は、最適化において最も重要な情報の一つですから、当然なが らその結果として、プリミティブな演算を伴う処理の高速化が期待できるわけ です。スライドでは、以下の fib 関数を例にとって、型注釈を与えた場合と 与えなかった場合とで、どれだけ実行速度が違うかを示しています。

;; 型注釈なし
(defn fib [n]
  (if (<= n 1)
      1
      (+ (fib (dec n)) (fib (- n 2)))))
(time (fib 38)) ;=> Elapsed time: 4100.272 msecs

;; 型注釈あり
(defn fib ^long [^long n]
  (if (<= n 1)
      1
      (+ (fib (dec n)) (fib (- n 2)))))
(time (fib 38)) ;=> Elapsed time: 674.706 msecs

この手の情報を安易に鵜呑みにするのはいけないので、実際に手元の環境で確 認してみました。

$ uname -a
Linux thinkpad 2.6.38-11-generic #50-Ubuntu SMP Mon Sep 12 21:17:25 UTC 2011 x86_64 x86_64 x86_64 GNU/Linux
$ java -version
java version "1.6.0_22"
OpenJDK Runtime Environment (IcedTea6 1.10.2) (6b22-1.10.2-0ubuntu1~11.04.1)
OpenJDK 64-Bit Server VM (build 20.0-b11, mixed mode)
$ java -jar ~/opt/clojure-1.3.0-RC0/clojure-1.3.0-RC0.jar
Clojure 1.3.0-RC0
user=> (defn fib [n] (if (<= n 1) 1 (+ (fib (dec n)) (fib (- n 2)))))
#'user/fib
user=> (dotimes [_ 3] (time (fib 38)))
"Elapsed time: 3927.97485 msecs"
"Elapsed time: 3722.368325 msecs"
"Elapsed time: 3828.55781 msecs"
nil
user=> ^D
$ java -jar ~/opt/clojure-1.3.0-RC0/clojure-1.3.0-RC0.jar
Clojure 1.3.0-RC0
user=> (defn fib ^long [^long n] (if (<= n 1) 1 (+ (fib (dec n)) (fib (- n 2)))))
#'user/fib
user=> (dotimes [_ 3] (time (fib 38)))
"Elapsed time: 803.010916 msecs"
"Elapsed time: 793.236553 msecs"
"Elapsed time: 791.748801 msecs"
nil
user=> 

確かに早くなっていますね。ところで我らが SBCL はどれぐらい速いのでしょ うか。

$ sbcl
This is SBCL 1.0.51, an implementation of ANSI Common Lisp.
More information about SBCL is available at <http://www.sbcl.org/>.

SBCL is free software, provided as is, with absolutely no warranty.
It is mostly in the public domain; some portions are provided under
BSD-style licenses.  See the CREDITS and COPYING files in the
distribution for more information.
* 
(defun fib (n)
  (declare (optimize (speed 3) (safety 0))
           (fixnum n))
  (if (<= n 1)
      1
      (the fixnum (+ (fib (1- n)) (fib (- n 2))))))

FIB
* (dotimes '3 (time (fib 38)))

Evaluation took:
  1.211 seconds of real time
  1.210000 seconds of total run time (1.200000 user, 0.010000 system)
  99.92% CPU
  1,932,215,688 processor cycles
  0 bytes consed

Evaluation took:
  1.205 seconds of real time
  1.210000 seconds of total run time (1.210000 user, 0.000000 system)
  100.41% CPU
  1,922,833,256 processor cycles
  0 bytes consed

Evaluation took:
  1.211 seconds of real time
  1.210000 seconds of total run time (1.210000 user, 0.000000 system)
  99.92% CPU
  1,933,261,128 processor cycles
  0 bytes consed

NIL

なぜか Clojure に負ける SBCL 。悔しいので詳しく調べてみます。とりあえず DISASSEMBLE してみましょう。

* (disassemble 'fib)
; disassembly for FIB
; 030680F2:       4883FA08         CMP RDX, 8                 ; no-arg-parsing entry point
;      0F6:       7F0A             JNLE L1
;      0F8:       B908000000       MOV ECX, 8
;      0FD: L0:   488BE5           MOV RSP, RBP
;      100:       5D               POP RBP
;      101:       C3               RET
;      102: L1:   488955F0         MOV [RBP-16], RDX
;      106:       488BCA           MOV RCX, RDX
;      109:       4883E908         SUB RCX, 8
;      10D:       488BDD           MOV RBX, RBP
;      110:       488D4424F0       LEA RAX, [RSP-16]
;      115:       4883EC40         SUB RSP, 64
;      119:       488BD1           MOV RDX, RCX
;      11C:       488918           MOV [RAX], RBX
;      11F:       488BE8           MOV RBP, RAX
;      122:       E8C8FFFFFF       CALL #x10030680EF
;      127:       488B55F0         MOV RDX, [RBP-16]
;      12B:       48894DF8         MOV [RBP-8], RCX
;      12F:       4883EA10         SUB RDX, 16
;      133:       488BCD           MOV RCX, RBP
;      136:       488D4424F0       LEA RAX, [RSP-16]
;      13B:       4883EC40         SUB RSP, 64
;      13F:       488908           MOV [RAX], RCX
;      142:       488BE8           MOV RBP, RAX
;      145:       E8A5FFFFFF       CALL #x10030680EF
;      14A:       488B55F8         MOV RDX, [RBP-8]
;      14E:       4801CA           ADD RDX, RCX
;      151:       488BCA           MOV RCX, RDX
;      154:       EBA7             JMP L0
NIL

至って単純ですし、これ以上に速くなるのが信じられません。参考として C で 書いたものも計測してみましょう。

$ cat fib.c
int fib(int n) {
    if (n <= 1)
        return 1;
    else
        return fib(n - 1) + fib(n - 2);
}

int main(int argc, char *argv[]) {
    fib(38);
    return 0;
}
$ gcc -O2 fib.c
$ time ./a.out
./a.out  1.01s user 0.00s system 98% cpu 1.026 total

Clojure のほうが速いですが、そんなことはありえないから -O3 で再挑戦し ます。

$ gcc -O3 fib.c
$ time ./a.out
./a.out  0.38s user 0.00s system 97% cpu 0.390 total

当然の結果です。長くなるので詳細は省きますが、両者の実行可能ファイルを objdump して比べてみると、 -O3 でコンパイルしたほうは明らかにコード サイズ量が大きくなっており、インライン化された形跡が見られます。たぶん これと同じことが Clojure vs. SBCL にも起きているのでしょう。実際に確か めてみます。

ところで Clojure には disassemble 関数とか、 javap のような decompile tool はないのでしょうか。いくら探しても見つからないので、皆困っ てないのかもしれませんが、 Clojure ほどの抽象化されたプログラミング言語 で、その手の解析ツールがないのは、結構致命的だと思ったりします。少なく とも僕は好きになれません。また、コンパイラに関しても、 Python で言うと ころのバイトコードを、クラスファイルに取り繕うだけのおもちゃみたいなコ ンパイラで、期待外れでがっかりしました。まあこれから改善されるのでしょ う。

以上のような状況ですから、 Clojure のコードを容易には解析できません。た だし、今回に関して言えば、 fib 関数がインライン化されているかどうかが 分かれば良いわけですから、それほど苦労はしませんでした。

まず、予想を確かめるために -XX:-Inline で実験します。ちなみにこのオプ ションはインライン化を無効にするものです。グローバルに無効になるので、 正確な解析にはなりませんが、ちょっとした目安にはなるでしょう。

$ java -XX:-Inline -jar ~/opt/clojure-1.3.0-RC0/clojure-1.3.0-RC0.jar
Clojure 1.3.0-RC0
user=> (defn fib ^long [^long n] (if (<= n 1) 1 (+ (fib (dec n)) (fib (- n 2)))))
#'user/fib
user=> (dotimes [_ 3] (time (fib 38)))
"Elapsed time: 3107.450674 msecs"
"Elapsed time: 3086.921525 msecs"
"Elapsed time: 3073.992303 msecs"
nil

すごく遅くなってますね。やはりインライン化は効いているようです。それで は実際にインライン化が効いているかを確かめましょう。そのためには -XX:+PrintInlining や -XX:+PrintAssembly を利用します。ただし、両者 ともデバッグビルドされた HotSpot JDK でしか利用できません。 OpenJDK 6 あるいは OpenJDK 7 のソースコードをダ ウンロードして、以下のようにビルドしてください。ちなみに僕は OpenJDK 7 をインストールしました。新しい物好きです。

$ unzip openjdk-7-*.zip
$ cd openjdk
$ make sanity
$ make debug_build
...
$ build/linux-amd64-debug/bin/java -version
openjdk version "1.7.0-internal-debug"
OpenJDK Runtime Environment (build 1.7.0-internal-debug-tomo_2011_09_24_13_54-b00)
OpenJDK 64-Bit Server VM (build 21.0-b17-jvmg, mixed mode)

まず -XX:-Inline と -XX:+PrintAssembly で fib 関数のアセンブリを確 認してみます。

$ ~/opt/openjdk/build/linux-amd64-debug/bin/java -XX:-Inline -XX:+PrintAssembly -jar ~/opt/clojure-1.3.0-RC0/clojure-1.3.0-RC0.jar
user=> (defn fib ^long [^long n] (if (<= n 1) 1 (+ (fib (dec n)) (fib (- n 2)))))
#'user/fib
user=> (fib 38)
;; fib 関数のアセンブリ
{method}
 - klass: {other class}
 - this oop:          0x00000000bebd81e8
 - method holder:     'user$fib'
 - constants:         0x00000000bebd7aa0 constant pool [104] for 'user$fib' cache=0x00000000bebd8838
 - access:            0x81000011  public final
 - name:              'invokePrim'
 - signature:         '(J)J'
 - max stack:         7
 - max locals:        3
 - size of params:    3
 - method size:       17
 - vtable index:      -2
 - i2i entry:         0x00007f87a323e060
 - adapter:           0x0000000002040c90
 - compiled entry     0x00007f87a32eeeb1
 - code size:         54
 - code start:        0x00000000bebd8190
 - code end (excl):   0x00000000bebd81c6
 - method data:       0x00000000bebd95b8
 - checked ex length: 0
 - linenumber start:  0x00000000bebd81c6
 - localvar length:   2
 - localvar start:    0x00000000bebd81ce
#
#  long/half ( user$fib:NotNull:exact *, long, half )
#
#r018 rsi:rsi   : parm 0: user$fib:NotNull:exact *
#r016 rdx:rdx   : parm 1: long
# -- Old rsp -- Framesize: 48 --
#r089 rsp+44: pad2, in_preserve
#r088 rsp+40: pad2, in_preserve
#r087 rsp+36: pad2, in_preserve
#r086 rsp+32: pad2, in_preserve
#r085 rsp+28: pad2, in_preserve
#r084 rsp+24: return address
#r083 rsp+20: Fixed slot 1
#r082 rsp+16: Fixed slot 0
#r093 rsp+12: spill
#r092 rsp+ 8: spill
#r091 rsp+ 4: spill
#r090 rsp+ 0: spill
#
000   N215: #   B1 <- BLOCK HEAD IS JUNK   Freq: 1
000     movl    rscratch1, [j_rarg0 + oopDesc::klass_offset_in_bytes()] # compressed klass
        cmpq    rax, rscratch1   # Inline cache check
        jne     SharedRuntime::_ic_miss_stub
        nop     # nops to align entry point

000
010   B1: #     B12 B2 <- BLOCK HEAD IS JUNK   Freq: 1
010     # stack bang
        pushq   rbp
        subq    rsp, #32        # Create frame
01c     movq    [rsp + #0], RDX # spill
020     cmpq    RDX, #1
024     jle     B12  P=0.500340 C=7351.000000
024
02a   B2: #     B22 B3 <- B1  Freq: 0.49966
02a     movq    R10, java/lang/Class:exact *    # ptr
034     movl    R11, [R10 + #124 (8-bit)]       # compressed ptr ! Field user$fib.const__3
038     movl    RBP, [R11 + #28 (8-bit)]        # compressed ptr ! Field  Volatileclojure/lang/Var.root
03c     MEMBAR-acquire ! (empty encoding)
03c     movl    R10, [RBP + #8 (8-bit)] # compressed klass ptr
040     NullCheck RBP
040
040   B3: #     B14 B4 <- B2  Freq: 0.499659
040     cmpl    R10, narrowoop: precise klass user$fib: 0x00007f879c19ac68:Constant:exact *     # compressed ptr
047     jne,u  B14  P=0.000000 C=-1.000000
047
04d   B4: #     B19 B5 <- B3  Freq: 0.499659
04d     decode_heap_oop_not_null RBP,RBP
04d     # checkcastPP of RBP
04d     movq    RSI, RDX        # spill
050     nop     # 3 bytes pad for loops and calls
053     call,static  clojure.lang.Numbers::dec
        # user$fib::invokePrim @ bci:21  L[0]=_ L[1]=rsp + #0 L[2]=_ STK[0]=RBP
        # OopMap{rbp=Oop off=88}
058
058   B5: #     B20 B6 <- B4  Freq: 0.499649
        # Block is sole successor of call
058     movq    RDX, RAX        # spill
05b     movq    RSI, RBP        # spill
05e     nop     # 1 bytes pad for loops and calls
05f     call,static  user$fib::invokePrim
        # user$fib::invokePrim @ bci:24  L[0]=_ L[1]=rsp + #0 L[2]=_
        # OopMap{off=100}
064
064   B6: #     B23 B7 <- B5  Freq: 0.499639
        # Block is sole successor of call
064     movq    [rsp + #8], RAX # spill
069     movq    R10, java/lang/Class:exact *    # ptr
073     movl    R11, [R10 + #124 (8-bit)]       # compressed ptr ! Field user$fib.const__3
077     movl    RBP, [R11 + #28 (8-bit)]        # compressed ptr ! Field  Volatileclojure/lang/Var.root
07b     MEMBAR-acquire ! (empty encoding)
07b     movl    R10, [RBP + #8 (8-bit)] # compressed klass ptr
07f     NullCheck RBP
07f
07f   B7: #     B15 B8 <- B6  Freq: 0.499639
07f     cmpl    R10, narrowoop: precise klass user$fib: 0x00007f879c19ac68:Constant:exact *     # compressed ptr
086     jne,us  B15  P=0.000000 C=-1.000000
086
088   B8: #     B18 B9 <- B7  Freq: 0.499639
088     decode_heap_oop_not_null RBP,RBP
088     # checkcastPP of RBP
088     movl    RDX, #2 # long (unsigned 32-bit)
08d     movq    RSI, [rsp + #0] # spill
091     nop     # 2 bytes pad for loops and calls
093     call,static  clojure.lang.Numbers::minus
        # user$fib::invokePrim @ bci:42  L[0]=_ L[1]=_ L[2]=_ STK[0]=rsp + #8 STK[1]=_ STK[2]=RBP
        # OopMap{rbp=Oop off=152}
098
098   B9: #     B17 B10 <- B8  Freq: 0.499629
        # Block is sole successor of call
098     movq    RSI, RBP        # spill
09b     movq    RDX, RAX        # spill
09e     nop     # 1 bytes pad for loops and calls
09f     call,static  user$fib::invokePrim
        # user$fib::invokePrim @ bci:45  L[0]=_ L[1]=_ L[2]=_ STK[0]=rsp + #8 STK[1]=_
        # OopMap{off=164}
0a4
0a4   B10: #    B16 B11 <- B9  Freq: 0.499619
        # Block is sole successor of call
0a4     movq    RSI, [rsp + #8] # spill
0a9     movq    RDX, RAX        # spill
0ac     nop     # 3 bytes pad for loops and calls
0af     call,static  clojure.lang.Numbers::add
        # user$fib::invokePrim @ bci:50  L[0]=_ L[1]=_ L[2]=_
        # OopMap{off=180}
0b4
0b4   B11: #    B13 <- B10  Freq: 0.499609
        # Block is sole successor of call
0b4     jmp,s   B13
0b4
0b6   B12: #    B13 <- B1  Freq: 0.50034
0b6     movl    RAX, #1 # long (unsigned 32-bit)
0b6
0bb   B13: #    N215 <- B11 B12  Freq: 0.999949
0bb     addq    rsp, 32 # Destroy frame
        popq   rbp
        testl  rax, [rip + #offset_to_poll_page]        # Safepoint: poll for GC

0c6     ret
0c6
0c7   B14: #    N215 <- B3  Freq: 1e-35
0c7     movl    RSI, #-34       # int
0cc     nop     # 3 bytes pad for loops and calls
0cf     call,static  wrapper for: uncommon_trap(reason='class_check' action='maybe_recompile')
        # user$fib::invokePrim @ bci:17  L[0]=_ L[1]=rsp + #0 L[2]=_ STK[0]=RBP
        # OopMap{rbp=NarrowOop off=212}
0d4     int3    # ShouldNotReachHere
0d4
0d9   B15: #    N215 <- B7  Freq: 1e-35
0d9     movl    RSI, #-34       # int
0de     nop     # 1 bytes pad for loops and calls
0df     call,static  wrapper for: uncommon_trap(reason='class_check' action='maybe_recompile')
        # user$fib::invokePrim @ bci:35  L[0]=_ L[1]=rsp + #0 L[2]=_ STK[0]=rsp + #8 STK[1]=_ STK[2]=RBP
        # OopMap{rbp=NarrowOop off=228}
0e4     int3    # ShouldNotReachHere
0e4
0e9   B16: #    B21 <- B10  Freq: 4.99619e-06
0e9     # exception oop is in rax; no code emitted
0e9     movq    RSI, RAX        # spill
0ec     jmp,s   B21
0ec
0ee   B17: #    B21 <- B9  Freq: 4.99629e-06
0ee     # exception oop is in rax; no code emitted
0ee     movq    RSI, RAX        # spill
0f1     jmp,s   B21
0f1
0f3   B18: #    B21 <- B8  Freq: 4.99639e-06
0f3     # exception oop is in rax; no code emitted
0f3     movq    RSI, RAX        # spill
0f6     jmp,s   B21
0f6
0f8   B19: #    B21 <- B4  Freq: 4.99659e-06
0f8     # exception oop is in rax; no code emitted
0f8     movq    RSI, RAX        # spill
0fb     jmp,s   B21
0fb
0fd   B20: #    B21 <- B5  Freq: 4.99649e-06
0fd     # exception oop is in rax; no code emitted
0fd     movq    RSI, RAX        # spill
0fd
100   B21: #    N215 <- B19 B20 B18 B17 B16  Freq: 2.4982e-05
100     addq    rsp, 32 # Destroy frame
        popq   rbp

105     jmp     rethrow_stub
105
10a   B22: #    N215 <- B2  Freq: 5.06295e-07
10a     movl    RSI, #-12       # int
10f     movq    RBP, RDX        # spill
112     nop     # 1 bytes pad for loops and calls
113     call,static  wrapper for: uncommon_trap(reason='null_check' action='make_not_entrant')
        # user$fib::invokePrim @ bci:17  L[0]=_ L[1]=RBP L[2]=_ STK[0]=#NULL
        # OopMap{off=280}
118     int3    # ShouldNotReachHere
118
11d   B23: #    N215 <- B6  Freq: 5.06274e-07
11d     movl    RSI, #-12       # int
122     movq    RBP, [rsp + #0] # spill
126     nop     # 1 bytes pad for loops and calls
127     call,static  wrapper for: uncommon_trap(reason='null_check' action='make_not_entrant')
        # user$fib::invokePrim @ bci:35  L[0]=_ L[1]=RBP L[2]=_ STK[0]=rsp + #8 STK[1]=_ STK[2]=#NULL
        # OopMap{off=300}
12c     int3    # ShouldNotReachHere
12c

次に -XX:+Inline した場合で fib 関数のアセンブリを確認してみます。

$ ~/opt/openjdk/build/linux-amd64-debug/bin/java -XX:+Inline -XX:+PrintAssembly -jar ~/opt/clojure-1.3.0-RC0/clojure-1.3.0-RC0.jar
user=> (defn fib ^long [^long n] (if (<= n 1) 1 (+ (fib (dec n)) (fib (- n 2)))))
#'user/fib
user=> (fib 38)
;; fib 関数のアセンブリ
{method}
 - klass: {other class}
 - this oop:          0x00000000bebced68
 - method holder:     'user$fib'
 - constants:         0x00000000bebce620 constant pool [104] for 'user$fib' cache=0x00000000bebcf3b8
 - access:            0x81000011  public final
 - name:              'invokePrim'
 - signature:         '(J)J'
 - max stack:         7
 - max locals:        3
 - size of params:    3
 - method size:       17
 - vtable index:      -2
 - i2i entry:         0x00007fd949404060
 - adapter:           0x0000000000ba7c90
 - compiled entry     0x00007fd9494b4eb1
 - code size:         54
 - code start:        0x00000000bebced10
 - code end (excl):   0x00000000bebced46
 - method data:       0x00000000bebd0158
 - checked ex length: 0
 - linenumber start:  0x00000000bebced46
 - localvar length:   2
 - localvar start:    0x00000000bebced4e
#
#  long/half ( user$fib:NotNull:exact *, long, half )
#
#r018 rsi:rsi   : parm 0: user$fib:NotNull:exact *
#r016 rdx:rdx   : parm 1: long
# -- Old rsp -- Framesize: 64 --
#r089 rsp+60: pad2, in_preserve
#r088 rsp+56: pad2, in_preserve
#r087 rsp+52: pad2, in_preserve
#r086 rsp+48: pad2, in_preserve
#r085 rsp+44: pad2, in_preserve
#r084 rsp+40: return address
#r083 rsp+36: Fixed slot 1
#r082 rsp+32: Fixed slot 0
#r097 rsp+28: spill
#r096 rsp+24: spill
#r095 rsp+20: spill
#r094 rsp+16: spill
#r093 rsp+12: spill
#r092 rsp+ 8: spill
#r091 rsp+ 4: spill
#r090 rsp+ 0: spill
#
000   N805: #   B1 <- BLOCK HEAD IS JUNK   Freq: 1
000     movl    rscratch1, [j_rarg0 + oopDesc::klass_offset_in_bytes()] # compressed klass
        cmpq    rax, rscratch1   # Inline cache check
        jne     SharedRuntime::_ic_miss_stub
        nop     # nops to align entry point

000
010   B1: #     B39 B2 <- BLOCK HEAD IS JUNK   Freq: 1
010     # stack bang
        pushq   rbp
        subq    rsp, #48        # Create frame
01c     movq    R8, RDX # spill
01f     cmpq    RDX, #1
023     jle     B39  P=0.500344 C=7273.000000
023
029   B2: #     B68 B3 <- B1  Freq: 0.499656
029     movq    R10, java/lang/Class:exact *    # ptr
033     movl    R11, [R10 + #124 (8-bit)]       # compressed ptr ! Field user$fib.const__3
037     movl    RBP, [R11 + #28 (8-bit)]        # compressed ptr ! Field  Volatileclojure/lang/Var.root
03b     MEMBAR-acquire ! (empty encoding)
03b     movl    R10, [RBP + #8 (8-bit)] # compressed klass ptr
03f     NullCheck RBP
03f
03f   B3: #     B62 B4 <- B2  Freq: 0.499656
03f     cmpl    R10, narrowoop: precise klass user$fib: 0x00007fd940329268:Constant:exact *     # compressed ptr
046     jne,u  B62  P=0.000000 C=-1.000000
046
04c   B4: #     B41 B5 <- B3  Freq: 0.499656
04c     movq    R10, #-9223372036854775808      # long
056     cmpq    RDX, R10
059     je     B41  P=0.000000 C=7240.000000
059
05f   B5: #     B6 <- B4  Freq: 0.499656
05f     movq    R10, RDX        # spill
062     decq    R10     # long
065
065   B6: #     B18 B7 <- B42 B5  Freq: 0.499656
065     movq    R11, java/lang/Class:exact *    # ptr
06f     movl    R11, [R11 + #124 (8-bit)]       # compressed ptr ! Field user$fib.const__3
073     cmpq    R10, #1
077     jle     B18  P=0.500344 C=7273.000000
077
07d   B7: #     B70 B8 <- B6  Freq: 0.249656
07d     movl    RBP, [R11 + #28 (8-bit)]        # compressed ptr ! Field  Volatileclojure/lang/Var.root
081     MEMBAR-acquire ! (empty encoding)
081     movl    R11, [RBP + #8 (8-bit)] # compressed klass ptr
085     NullCheck RBP
085
085   B8: #     B63 B9 <- B7  Freq: 0.249656
085     cmpl    R11, narrowoop: precise klass user$fib: 0x00007fd940329268:Constant:exact *     # compressed ptr
08c     jne,u  B63  P=0.000000 C=-1.000000
08c
092   B9: #     B46 B10 <- B8  Freq: 0.249656
092     decode_heap_oop_not_null RSI,RBP
095     # checkcastPP of RSI
095     movq    R11, #-9223372036854775808      # long
09f     cmpq    R10, R11
0a2     je     B46  P=0.000000 C=7240.000000
0a2
0a8   B10: #    B11 <- B9  Freq: 0.249656
0a8     movq    RDX, R10        # spill
0ab     decq    RDX     # long
0ae
0ae   B11: #    B83 B12 <- B47 B10  Freq: 0.249656
0ae     movq    [rsp + #8], R10 # spill
0b3     movq    [rsp + #0], R8  # spill
0b7     call,static  user$fib::invokePrim
        # user$fib::invokePrim @ bci:24  L[0]=_ L[1]=rsp + #8 L[2]=_
        # user$fib::invokePrim @ bci:24  L[0]=_ L[1]=rsp + #0 L[2]=_
        # OopMap{off=188}
0bc
0bc   B12: #    B71 B13 <- B11  Freq: 0.249651
        # Block is sole successor of call
0bc     movq    [rsp + #16], RAX        # spill
0c1     movq    R10, java/lang/Class:exact *    # ptr
0cb     movl    R11, [R10 + #124 (8-bit)]       # compressed ptr ! Field user$fib.const__3
0cf     movl    RBP, [R11 + #28 (8-bit)]        # compressed ptr ! Field  Volatileclojure/lang/Var.root
0d3     MEMBAR-acquire ! (empty encoding)
0d3     movl    R10, [RBP + #8 (8-bit)] # compressed klass ptr
0d7     NullCheck RBP
0d7
0d7   B13: #    B64 B14 <- B12  Freq: 0.249651
0d7     cmpl    R10, narrowoop: precise klass user$fib: 0x00007fd940329268:Constant:exact *     # compressed ptr
0de     jne,u  B64  P=0.000000 C=-1.000000
0de
0e4   B14: #    B48 B15 <- B13  Freq: 0.249651
0e4     decode_heap_oop_not_null RSI,RBP
0e7     # checkcastPP of RSI
0e7     movq    RDX, [rsp + #8] # spill
0ec     addq    RDX, #-2        # long
0f0     movq    R10, [rsp + #8] # spill
0f5     xorq    R10, RDX        # long
0f8     testq   R10, R10
0fb     jl     B48  P=0.000000 C=8268.000000
0fb
101   B15: #    B84 B16 <- B50 B48 B14  Freq: 0.249651
101     nop     # 2 bytes pad for loops and calls
103     call,static  user$fib::invokePrim
        # user$fib::invokePrim @ bci:45  L[0]=_ L[1]=_ L[2]=_ STK[0]=rsp + #16 STK[1]=_
        # user$fib::invokePrim @ bci:24  L[0]=_ L[1]=rsp + #0 L[2]=_
        # OopMap{off=264}
108
108   B16: #    B53 B17 <- B15  Freq: 0.249646
        # Block is sole successor of call
108     movq    R9, [rsp + #16] # spill
10d     addq    R9, RAX # long
110     movq    R11, [rsp + #16]        # spill
115     xorq    R11, R9 # long
118     testq   R11, R11
11b     jl     B53  P=0.000000 C=8899.000000
11b
121   B17: #    B19 <- B55 B53 B16  Freq: 0.249646
121     movq    R10, java/lang/Class:exact *    # ptr
12b     movl    R11, [R10 + #124 (8-bit)]       # compressed ptr ! Field user$fib.const__3
12f     movq    R8, [rsp + #0]  # spill
133     jmp,s   B19
133
135   B18: #    B19 <- B6  Freq: 0.25
135     movl    R9, #1  # long (unsigned 32-bit)
135
13b   B19: #    B69 B20 <- B17 B18  Freq: 0.499645
13b     movl    R10, [R11 + #28 (8-bit)]        # compressed ptr ! Field  Volatileclojure/lang/Var.root
13f     MEMBAR-acquire ! (empty encoding)
13f     movl    RCX, [R10 + #8 (8-bit)] # compressed klass ptr
143     NullCheck R10
143
143   B20: #    B65 B21 <- B19  Freq: 0.499645
143     cmpl    RCX, narrowoop: precise klass user$fib: 0x00007fd940329268:Constant:exact *     # compressed ptr
149     jne,u  B65  P=0.000000 C=-1.000000
149
14f   B21: #    B43 B22 <- B20  Freq: 0.499645
14f     movq    RCX, R8 # spill
152     addq    RCX, #-2        # long
156     xorq    R8, RCX # long
159     testq   R8, R8
15c     jl     B43  P=0.000000 C=8268.000000
15c
162   B22: #    B34 B23 <- B45 B43 B21  Freq: 0.499645
162     cmpq    RCX, #1
166     jle     B34  P=0.500344 C=7273.000000
166
16c   B23: #    B72 B24 <- B22  Freq: 0.249651
16c     movq    R10, java/lang/Class:exact *    # ptr
176     movl    R11, [R10 + #124 (8-bit)]       # compressed ptr ! Field user$fib.const__3
17a     movl    RBP, [R11 + #28 (8-bit)]        # compressed ptr ! Field  Volatileclojure/lang/Var.root
17e     MEMBAR-acquire ! (empty encoding)
17e     movl    R10, [RBP + #8 (8-bit)] # compressed klass ptr
182     NullCheck RBP
182
182   B24: #    B66 B25 <- B23  Freq: 0.24965
182     cmpl    R10, narrowoop: precise klass user$fib: 0x00007fd940329268:Constant:exact *     # compressed ptr
189     jne,u  B66  P=0.000000 C=-1.000000
189
18f   B25: #    B51 B26 <- B24  Freq: 0.24965
18f     decode_heap_oop_not_null RSI,RBP
192     # checkcastPP of RSI
192     movq    R10, #-9223372036854775808      # long
19c     cmpq    RCX, R10
19f     je     B51  P=0.000000 C=7240.000000
19f
1a5   B26: #    B27 <- B25  Freq: 0.24965
1a5     movq    RDX, RCX        # spill
1a8     decq    RDX     # long
1ab
1ab   B27: #    B85 B28 <- B52 B26  Freq: 0.24965
1ab     movq    [rsp + #8], RCX # spill
1b0     movq    [rsp + #0], R9  # spill
1b4     nop     # 3 bytes pad for loops and calls
1b7     call,static  user$fib::invokePrim
        # user$fib::invokePrim @ bci:24  L[0]=_ L[1]=rsp + #8 L[2]=_
        # user$fib::invokePrim @ bci:45  L[0]=_ L[1]=_ L[2]=_ STK[0]=rsp + #0 STK[1]=_
        # OopMap{off=444}
1bc
1bc   B28: #    B73 B29 <- B27  Freq: 0.249645
        # Block is sole successor of call
1bc     movq    [rsp + #16], RAX        # spill
1c1     movq    R10, java/lang/Class:exact *    # ptr
1cb     movl    R10, [R10 + #124 (8-bit)]       # compressed ptr ! Field user$fib.const__3
1cf     movl    RBP, [R10 + #28 (8-bit)]        # compressed ptr ! Field  Volatileclojure/lang/Var.root
1d3     MEMBAR-acquire ! (empty encoding)
1d3     movl    R10, [RBP + #8 (8-bit)] # compressed klass ptr
1d7     NullCheck RBP
1d7
1d7   B29: #    B67 B30 <- B28  Freq: 0.249645
1d7     cmpl    R10, narrowoop: precise klass user$fib: 0x00007fd940329268:Constant:exact *     # compressed ptr
1de     jne,u  B67  P=0.000000 C=-1.000000
1de
1e4   B30: #    B56 B31 <- B29  Freq: 0.249645
1e4     decode_heap_oop_not_null RBP,RBP
1e4     # checkcastPP of RBP
1e4     movq    RDX, [rsp + #8] # spill
1e9     addq    RDX, #-2        # long
1ed     movq    R10, [rsp + #8] # spill
1f2     xorq    R10, RDX        # long
1f5     testq   R10, R10
1f8     jl     B56  P=0.000000 C=8268.000000
1f8
1fe   B31: #    B86 B32 <- B58 B56 B30  Freq: 0.249645
1fe     movq    RSI, RBP        # spill
201     nop     # 2 bytes pad for loops and calls
203     call,static  user$fib::invokePrim
        # user$fib::invokePrim @ bci:45  L[0]=_ L[1]=_ L[2]=_ STK[0]=rsp + #16 STK[1]=_
        # user$fib::invokePrim @ bci:45  L[0]=_ L[1]=_ L[2]=_ STK[0]=rsp + #0 STK[1]=_
        # OopMap{off=520}
208
208   B32: #    B59 B33 <- B31  Freq: 0.24964
        # Block is sole successor of call
208     movq    R11, [rsp + #16]        # spill
20d     addq    R11, RAX        # long
210     movq    R10, [rsp + #16]        # spill
215     xorq    R10, R11        # long
218     testq   R10, R10
21b     jl     B59  P=0.000000 C=8899.000000
21b
221   B33: #    B35 <- B61 B59 B32  Freq: 0.24964
221     movq    R9, [rsp + #0]  # spill
225     jmp,s   B35
225
227   B34: #    B35 <- B22  Freq: 0.249994
227     movl    R11, #1 # long (unsigned 32-bit)
227
22d   B35: #    B40 B36 <- B33 B34  Freq: 0.499634
22d     movq    RAX, R9 # spill
230     addq    RAX, R11        # long
233     xorq    R9, RAX # long
236     testq   R9, R9
239     jge,s   B40  P=1.000000 C=8899.000000
239
23b   B36: #    B40 B37 <- B35  Freq: 2.38244e-07
23b     xorq    R11, RAX        # long
23e     testq   R11, R11
241     jge,s   B40  P=0.500000 C=-1.000000
241
243   B37: #    B80 B38 <- B36  Freq: 1.19122e-07
243     call,static  clojure.lang.Numbers::throwIntOverflow
        # clojure.lang.Numbers::add @ bci:23  L[0]=_ L[1]=_ L[2]=_ L[3]=_ L[4]=_ L[5]=_
        # user$fib::invokePrim @ bci:50  L[0]=_ L[1]=_ L[2]=_
        # OopMap{off=584}
248
248   B38: #    B40 <- B37  Freq: 1.1912e-07
        # Block is sole successor of call
248     movslq  RAX, RAX        # i2l
24b     jmp,s   B40
24b
24d   B39: #    B40 <- B1  Freq: 0.500344
24d     movl    RAX, #1 # long (unsigned 32-bit)
24d
252   B40: #    N805 <- B38 B36 B35 B39  Freq: 0.999978
252     addq    rsp, 48 # Destroy frame
        popq   rbp
        testl  rax, [rip + #offset_to_poll_page]        # Safepoint: poll for GC

25d     ret
25d
25e   B41: #    B82 B42 <- B4  Freq: 2.38254e-07
25e     movq    [rsp + #0], RDX # spill
262     decode_heap_oop_not_null RBP,RBP
262     # checkcastPP of RBP
262     nop     # 1 bytes pad for loops and calls
263     call,static  clojure.lang.Numbers::throwIntOverflow
        # clojure.lang.Numbers::dec @ bci:8  L[0]=_ L[1]=_
        # user$fib::invokePrim @ bci:21  L[0]=_ L[1]=rsp + #0 L[2]=_ STK[0]=RBP
        # OopMap{rbp=Oop off=616}
268
268   B42: #    B6 <- B41  Freq: 2.3825e-07
        # Block is sole successor of call
268     movslq  R10, RAX        # i2l
26b     movq    R8, [rsp + #0]  # spill
26f     jmp     B6
26f
274   B43: #    B22 B44 <- B21  Freq: 2.38249e-07
274     movq    R11, RCX        # spill
277     xorq    R11, #-3        # long
27b     testq   R11, R11
27e     jge     B22  P=0.500000 C=-1.000000
27e
284   B44: #    B81 B45 <- B43  Freq: 1.19125e-07
284     movq    [rsp + #0], R9  # spill
288     decode_heap_oop_not_null RBP,R10
28b     # checkcastPP of RBP
28b     call,static  clojure.lang.Numbers::throwIntOverflow
        # clojure.lang.Numbers::minus @ bci:27  L[0]=_ L[1]=_ L[2]=_ L[3]=_ L[4]=_ L[5]=_
        # user$fib::invokePrim @ bci:42  L[0]=_ L[1]=_ L[2]=_ STK[0]=rsp + #0 STK[1]=_ STK[2]=RBP
        # OopMap{rbp=Oop off=656}
290
290   B45: #    B22 <- B44  Freq: 1.19122e-07
        # Block is sole successor of call
290     movslq  RCX, RAX        # i2l
293     movq    R9, [rsp + #0]  # spill
297     jmp     B22
297
29c   B46: #    B79 B47 <- B9  Freq: 1.19045e-07
29c     movq    [rsp + #8], RSI # spill
2a1     movq    [rsp + #0], R10 # spill
2a5     movq    RBP, R8 # spill
2a8     nop     # 3 bytes pad for loops and calls
2ab     call,static  clojure.lang.Numbers::throwIntOverflow
        # clojure.lang.Numbers::dec @ bci:8  L[0]=_ L[1]=_
        # user$fib::invokePrim @ bci:21  L[0]=_ L[1]=rsp + #0 L[2]=_ STK[0]=rsp + #8
        # user$fib::invokePrim @ bci:24  L[0]=_ L[1]=RBP L[2]=_
        # OopMap{[8]=Oop off=688}
2b0
2b0   B47: #    B11 <- B46  Freq: 1.19043e-07
        # Block is sole successor of call
2b0     movslq  RDX, RAX        # i2l
2b3     movq    R8, RBP # spill
2b6     movq    R10, [rsp + #0] # spill
2ba     movq    RSI, [rsp + #8] # spill
2bf     jmp     B11
2bf
2c4   B48: #    B15 B49 <- B14  Freq: 1.19043e-07
2c4     movq    R10, RDX        # spill
2c7     xorq    R10, #-3        # long
2cb     testq   R10, R10
2ce     jge     B15  P=0.500000 C=-1.000000
2ce
2d4   B49: #    B77 B50 <- B48  Freq: 5.95213e-08
2d4     movq    RBP, RSI        # spill
2d7     call,static  clojure.lang.Numbers::throwIntOverflow
        # clojure.lang.Numbers::minus @ bci:27  L[0]=_ L[1]=_ L[2]=_ L[3]=_ L[4]=_ L[5]=_
        # user$fib::invokePrim @ bci:42  L[0]=_ L[1]=_ L[2]=_ STK[0]=rsp + #16 STK[1]=_ STK[2]=RBP
        # user$fib::invokePrim @ bci:24  L[0]=_ L[1]=rsp + #0 L[2]=_
        # OopMap{rbp=Oop off=732}
2dc
2dc   B50: #    B15 <- B49  Freq: 5.95202e-08
        # Block is sole successor of call
2dc     movslq  RDX, RAX        # i2l
2df     movq    RSI, RBP        # spill
2e2     jmp     B15
2e2
2e7   B51: #    B78 B52 <- B25  Freq: 1.19043e-07
2e7     movq    [rsp + #8], RSI # spill
2ec     movq    [rsp + #0], RCX # spill
2f0     movq    RBP, R9 # spill
2f3     call,static  clojure.lang.Numbers::throwIntOverflow
        # clojure.lang.Numbers::dec @ bci:8  L[0]=_ L[1]=_
        # user$fib::invokePrim @ bci:21  L[0]=_ L[1]=rsp + #0 L[2]=_ STK[0]=rsp + #8
        # user$fib::invokePrim @ bci:45  L[0]=_ L[1]=_ L[2]=_ STK[0]=RBP STK[1]=_
        # OopMap{[8]=Oop off=760}
2f8
2f8   B52: #    B27 <- B51  Freq: 1.1904e-07
        # Block is sole successor of call
2f8     movslq  RDX, RAX        # i2l
2fb     movq    R9, RBP # spill
2fe     movq    RCX, [rsp + #0] # spill
302     movq    RSI, [rsp + #8] # spill
307     jmp     B27
307
30c   B53: #    B17 B54 <- B16  Freq: 1.1904e-07
30c     xorq    RAX, R9 # long
30f     testq   RAX, RAX
312     jge     B17  P=0.500000 C=-1.000000
312
318   B54: #    B76 B55 <- B53  Freq: 5.95202e-08
318     nop     # 3 bytes pad for loops and calls
31b     call,static  clojure.lang.Numbers::throwIntOverflow
        # clojure.lang.Numbers::add @ bci:23  L[0]=_ L[1]=_ L[2]=_ L[3]=_ L[4]=_ L[5]=_
        # user$fib::invokePrim @ bci:50  L[0]=_ L[1]=_ L[2]=_
        # user$fib::invokePrim @ bci:24  L[0]=_ L[1]=rsp + #0 L[2]=_
        # OopMap{off=800}
320
320   B55: #    B17 <- B54  Freq: 5.9519e-08
        # Block is sole successor of call
320     movslq  R9, RAX # i2l
323     jmp     B17
323
328   B56: #    B31 B57 <- B30  Freq: 1.1904e-07
328     movq    R10, RDX        # spill
32b     xorq    R10, #-3        # long
32f     testq   R10, R10
332     jge     B31  P=0.500000 C=-1.000000
332
338   B57: #    B75 B58 <- B56  Freq: 5.952e-08
338     nop     # 3 bytes pad for loops and calls
33b     call,static  clojure.lang.Numbers::throwIntOverflow
        # clojure.lang.Numbers::minus @ bci:27  L[0]=_ L[1]=_ L[2]=_ L[3]=_ L[4]=_ L[5]=_
        # user$fib::invokePrim @ bci:42  L[0]=_ L[1]=_ L[2]=_ STK[0]=rsp + #16 STK[1]=_ STK[2]=RBP
        # user$fib::invokePrim @ bci:45  L[0]=_ L[1]=_ L[2]=_ STK[0]=rsp + #0 STK[1]=_
        # OopMap{rbp=Oop off=832}
340
340   B58: #    B31 <- B57  Freq: 5.95188e-08
        # Block is sole successor of call
340     movslq  RDX, RAX        # i2l
343     jmp     B31
343
348   B59: #    B33 B60 <- B32  Freq: 1.19038e-07
348     movq    R8, RAX # spill
34b     xorq    R8, R11 # long
34e     testq   R8, R8
351     jge     B33  P=0.500000 C=-1.000000
351
357   B60: #    B74 B61 <- B59  Freq: 5.95188e-08
357     call,static  clojure.lang.Numbers::throwIntOverflow
        # clojure.lang.Numbers::add @ bci:23  L[0]=_ L[1]=_ L[2]=_ L[3]=_ L[4]=_ L[5]=_
        # user$fib::invokePrim @ bci:50  L[0]=_ L[1]=_ L[2]=_
        # user$fib::invokePrim @ bci:45  L[0]=_ L[1]=_ L[2]=_ STK[0]=rsp + #0 STK[1]=_
        # OopMap{off=860}
35c
35c   B61: #    B33 <- B60  Freq: 5.95176e-08
        # Block is sole successor of call
35c     movslq  R11, RAX        # i2l
35f     jmp     B33
35f
364   B62: #    N805 <- B3  Freq: 1e-35
364     movl    RSI, #-34       # int
369     movq    [rsp + #0], RDX # spill
36d     nop     # 2 bytes pad for loops and calls
36f     call,static  wrapper for: uncommon_trap(reason='class_check' action='maybe_recompile')
        # user$fib::invokePrim @ bci:17  L[0]=_ L[1]=rsp + #0 L[2]=_ STK[0]=RBP
        # OopMap{rbp=NarrowOop off=884}
374     int3    # ShouldNotReachHere
374
379   B63: #    N805 <- B8  Freq: 1e-35
379     movl    RSI, #-34       # int
37e     movq    [rsp + #0], R8  # spill
382     movq    [rsp + #8], R10 # spill
387     call,static  wrapper for: uncommon_trap(reason='class_check' action='maybe_recompile')
        # user$fib::invokePrim @ bci:17  L[0]=_ L[1]=rsp + #8 L[2]=_ STK[0]=RBP
        # user$fib::invokePrim @ bci:24  L[0]=_ L[1]=rsp + #0 L[2]=_
        # OopMap{rbp=NarrowOop off=908}
38c     int3    # ShouldNotReachHere
38c
391   B64: #    N805 <- B13  Freq: 1e-35
391     movl    RSI, #-34       # int
396     nop     # 1 bytes pad for loops and calls
397     call,static  wrapper for: uncommon_trap(reason='class_check' action='maybe_recompile')
        # user$fib::invokePrim @ bci:35  L[0]=_ L[1]=rsp + #8 L[2]=_ STK[0]=rsp + #16 STK[1]=_ STK[2]=RBP
        # user$fib::invokePrim @ bci:24  L[0]=_ L[1]=rsp + #0 L[2]=_
        # OopMap{rbp=NarrowOop off=924}
39c     int3    # ShouldNotReachHere
39c
3a1   B65: #    N805 <- B20  Freq: 1e-35
3a1     movl    RSI, #-34       # int
3a6     movq    RBP, R8 # spill
3a9     movq    [rsp + #0], R9  # spill
3ad     movl    [rsp + #8], R10 # spill
3b2     nop     # 1 bytes pad for loops and calls
3b3     call,static  wrapper for: uncommon_trap(reason='class_check' action='maybe_recompile')
        # user$fib::invokePrim @ bci:35  L[0]=_ L[1]=RBP L[2]=_ STK[0]=rsp + #0 STK[1]=_ STK[2]=rsp + #8
        # OopMap{[8]=NarrowOop off=952}
3b8     int3    # ShouldNotReachHere
3b8
3bd   B66: #    N805 <- B24  Freq: 1e-35
3bd     movl    RSI, #-34       # int
3c2     movq    [rsp + #0], R9  # spill
3c6     movq    [rsp + #8], RCX # spill
3cb     call,static  wrapper for: uncommon_trap(reason='class_check' action='maybe_recompile')
        # user$fib::invokePrim @ bci:17  L[0]=_ L[1]=rsp + #8 L[2]=_ STK[0]=RBP
        # user$fib::invokePrim @ bci:45  L[0]=_ L[1]=_ L[2]=_ STK[0]=rsp + #0 STK[1]=_
        # OopMap{rbp=NarrowOop off=976}
3d0     int3    # ShouldNotReachHere
3d0
3d5   B67: #    N805 <- B29  Freq: 1e-35
3d5     movl    RSI, #-34       # int
3da     nop     # 1 bytes pad for loops and calls
3db     call,static  wrapper for: uncommon_trap(reason='class_check' action='maybe_recompile')
        # user$fib::invokePrim @ bci:35  L[0]=_ L[1]=rsp + #8 L[2]=_ STK[0]=rsp + #16 STK[1]=_ STK[2]=RBP
        # user$fib::invokePrim @ bci:45  L[0]=_ L[1]=_ L[2]=_ STK[0]=rsp + #0 STK[1]=_
        # OopMap{rbp=NarrowOop off=992}
3e0     int3    # ShouldNotReachHere
3e0
3e5   B68: #    N805 <- B2  Freq: 5.06291e-07
3e5     movl    RSI, #-12       # int
3ea     movq    RBP, RDX        # spill
3ed     nop     # 2 bytes pad for loops and calls
3ef     call,static  wrapper for: uncommon_trap(reason='null_check' action='make_not_entrant')
        # user$fib::invokePrim @ bci:17  L[0]=_ L[1]=RBP L[2]=_ STK[0]=#NULL
        # OopMap{off=1012}
3f4     int3    # ShouldNotReachHere
3f4
3f9   B69: #    N805 <- B19  Freq: 5.0628e-07
3f9     movl    RSI, #-12       # int
3fe     movq    RBP, R8 # spill
401     movq    [rsp + #0], R9  # spill
405     nop     # 2 bytes pad for loops and calls
407     call,static  wrapper for: uncommon_trap(reason='null_check' action='make_not_entrant')
        # user$fib::invokePrim @ bci:35  L[0]=_ L[1]=RBP L[2]=_ STK[0]=rsp + #0 STK[1]=_ STK[2]=#NULL
        # OopMap{off=1036}
40c     int3    # ShouldNotReachHere
40c
411   B70: #    N805 <- B7  Freq: 2.52971e-07
411     movl    RSI, #-12       # int
416     movq    RBP, R8 # spill
419     movq    [rsp + #0], R10 # spill
41d     nop     # 2 bytes pad for loops and calls
41f     call,static  wrapper for: uncommon_trap(reason='null_check' action='make_not_entrant')
        # user$fib::invokePrim @ bci:17  L[0]=_ L[1]=rsp + #0 L[2]=_ STK[0]=#NULL
        # user$fib::invokePrim @ bci:24  L[0]=_ L[1]=RBP L[2]=_
        # OopMap{off=1060}
424     int3    # ShouldNotReachHere
424
429   B71: #    N805 <- B12  Freq: 2.52966e-07
429     movl    RSI, #-12       # int
42e     movq    RBP, [rsp + #0] # spill
432     nop     # 1 bytes pad for loops and calls
433     call,static  wrapper for: uncommon_trap(reason='null_check' action='make_not_entrant')
        # user$fib::invokePrim @ bci:35  L[0]=_ L[1]=rsp + #8 L[2]=_ STK[0]=rsp + #16 STK[1]=_ STK[2]=#NULL
        # user$fib::invokePrim @ bci:24  L[0]=_ L[1]=RBP L[2]=_
        # OopMap{off=1080}
438     int3    # ShouldNotReachHere
438
43d   B72: #    N805 <- B23  Freq: 2.52966e-07
43d     movl    RSI, #-12       # int
442     movq    RBP, R9 # spill
445     movq    [rsp + #0], RCX # spill
449     nop     # 2 bytes pad for loops and calls
44b     call,static  wrapper for: uncommon_trap(reason='null_check' action='make_not_entrant')
        # user$fib::invokePrim @ bci:17  L[0]=_ L[1]=rsp + #0 L[2]=_ STK[0]=#NULL
        # user$fib::invokePrim @ bci:45  L[0]=_ L[1]=_ L[2]=_ STK[0]=RBP STK[1]=_
        # OopMap{off=1104}
450     int3    # ShouldNotReachHere
450
455   B73: #    N805 <- B28  Freq: 2.5296e-07
455     movl    RSI, #-12       # int
45a     nop     # 1 bytes pad for loops and calls
45b     call,static  wrapper for: uncommon_trap(reason='null_check' action='make_not_entrant')
        # user$fib::invokePrim @ bci:35  L[0]=_ L[1]=rsp + #8 L[2]=_ STK[0]=rsp + #16 STK[1]=_ STK[2]=#NULL
        # user$fib::invokePrim @ bci:45  L[0]=_ L[1]=_ L[2]=_ STK[0]=rsp + #0 STK[1]=_
        # OopMap{off=1120}
460     int3    # ShouldNotReachHere
460
465   B74: #    B87 <- B60  Freq: 5.95188e-13
465     # exception oop is in rax; no code emitted
465     movq    RSI, RAX        # spill
468     jmp,s   B87
468
46a   B75: #    B87 <- B57  Freq: 5.952e-13
46a     # exception oop is in rax; no code emitted
46a     movq    RSI, RAX        # spill
46d     jmp,s   B87
46d
46f   B76: #    B87 <- B54  Freq: 5.95202e-13
46f     # exception oop is in rax; no code emitted
46f     movq    RSI, RAX        # spill
472     jmp,s   B87
472
474   B77: #    B87 <- B49  Freq: 5.95213e-13
474     # exception oop is in rax; no code emitted
474     movq    RSI, RAX        # spill
477     jmp,s   B87
477
479   B78: #    B87 <- B51  Freq: 1.19043e-12
479     # exception oop is in rax; no code emitted
479     movq    RSI, RAX        # spill
47c     jmp,s   B87
47c
47e   B79: #    B87 <- B46  Freq: 1.19045e-12
47e     # exception oop is in rax; no code emitted
47e     movq    RSI, RAX        # spill
481     jmp,s   B87
481
483   B80: #    B87 <- B37  Freq: 1.19122e-12
483     # exception oop is in rax; no code emitted
483     movq    RSI, RAX        # spill
486     jmp,s   B87
486
488   B81: #    B87 <- B44  Freq: 1.19125e-12
488     # exception oop is in rax; no code emitted
488     movq    RSI, RAX        # spill
48b     jmp,s   B87
48b
48d   B82: #    B87 <- B41  Freq: 2.38254e-12
48d     # exception oop is in rax; no code emitted
48d     movq    RSI, RAX        # spill
490     jmp,s   B87
490
492   B83: #    B87 <- B11  Freq: 2.49656e-06
492     # exception oop is in rax; no code emitted
492     movq    RSI, RAX        # spill
495     jmp,s   B87
495
497   B84: #    B87 <- B15  Freq: 2.49651e-06
497     # exception oop is in rax; no code emitted
497     movq    RSI, RAX        # spill
49a     jmp,s   B87
49a
49c   B85: #    B87 <- B27  Freq: 2.4965e-06
49c     # exception oop is in rax; no code emitted
49c     movq    RSI, RAX        # spill
49f     jmp,s   B87
49f
4a1   B86: #    B87 <- B31  Freq: 2.49645e-06
4a1     # exception oop is in rax; no code emitted
4a1     movq    RSI, RAX        # spill
4a1
4a4   B87: #    N805 <- B82 B79 B83 B77 B84 B76 B81 B78 B85 B75 B86 B74 B80  Freq: 9.98603e-06
4a4     addq    rsp, 48 # Destroy frame
        popq   rbp

4a9     jmp     rethrow_stub
4a9

読み方がよく分かりませんが、明らかにコードサイズが大きくなってますね。

以上から fib 関数はインライン化されていることが分かりました。こんなに インライン化されては、さすがの SBCL でも敵いません。

結論： Clojure コンパイラがすごいんじゃなくて HotSpot がすごい。 まあで もプリミティブ型をちゃんとコンパイルするようになったのは偉いか。

ところで SBCL が再帰関数のインライン化を行わないのは、何か理由があるの でしょうか。僕が知る限り、インライン化にこれといった障壁はないと思うの ですが。

ocamlyacc で parameterized parser を作る方法

ocamlyacc で parameterized parser を作る方法を紹介します。かなり裏技的 なのであまり利用はすすめられないですが、やろうと思えば出来ることを示せ ればと思います。もちろん ocamlyacc 自体にそのような機能が入ればいいので すが、ああいった開発体制ですからあまり期待しないほうがいいと思います。 ちなみに ocamlyacc の優秀な代替として Menhir というものがありま す。 ocamlyacc が LALR なのに対して Menhir が LR(1) なので、完全な代替 とはなりませんが、件の parameterized parser に加え、さまざまな便利機能 をサポートしていて非常におすすめです。何気に OMake もデフォルトでサポー トしてますし（MENHIR_ENABLED=trueと書くだけ）。

では本題に入ります。まず次のような AST を考えてください。

(* ast.ml *)
type expr = Int of int
            | Add of expr * expr
            | Sub of expr * expr
            | Mul of expr * expr
            | Div of expr * expr

見ての通り単純な四則演算式を定義しています。プログラミング言語をパース するときなど、通常はもっと巨大な AST になります。また、そのようなパーサー は、パース時のエラーメッセージなどを分かりやすくするために、以下のよう に各ノードにファイルの位置情報などを付加することがよくあります。

(* ast.ml *)
type pos = Lexing.position

type expr = Int of int * pos
            | Add of expr * expr * pos
            | Sub of expr * expr * pos
            | Mul of expr * expr * pos
            | Div of expr * expr * pos

ところでこの expr に型パラメータを加えてやれば、より汎用的になると思いませんか？

(* ast.ml *)
type 'a expr = Int of int * 'a
               | Add of expr * expr * 'a
               | Sub of expr * expr * 'a
               | Mul of expr * expr * 'a
               | Div of expr * expr * 'a

これにより、ユーザーは必要に応じて自分で利用するデータを各ノードに格納 することが可能になります。例えば、ノード ID であったり、演算後の結果で あったりです。

しかしながら、このような AST を構成するパーサー、つまり parameterized parser は、 ocamlyacc では（直接的）にはサポートしていません。具体的に どこで問題になるかと言えば、mly ファイル内の %type 宣言で問題になり ます。 %type 宣言では以下のように、どこに書いても一意になるように型を 記述する必要があります。

(* parser.mly *)
%type <Lexing.position expr> expr

つまり以下のような記述を受け入れないということです。

(* parser.mly *)
%type <'a expr> expr

考えてみれば当たり前の話ですが、なかなか不便ですね。 ocamlyacc にはその 他にも以下のような不便なポイントがありますが、個人的にこれが一番不便で す。

1. トークン定義だけ別に生成できない。その結果、 lexer が parser に依存 するという意味不明な状態になる。
2. Embedded action が書けない。 yacc なパーサーからポートするときは、自 分で空ルールを作ってそこにセマンティックアクションを埋め込むという不 毛な作業が必要になる。

それでこれをどうやって解決するかといいますと、まず ast.ml に以下のよ うなコードを追加します。

(* ast.ml *)
module type Annot = sig
  type t
  val of_pos : Lexing.position -> t
end

module Pos : Annot = struct
  type t = Lexing.position
  let of_pos pos = pos
end

Annot はノードに付与する注釈のシグネチャで、 Pos はデフォルトの付与 情報を表すモジュールです。次に、 parser.mly のヘッダとフッタに以下の ようなコードを追加します。

/* parser.mly */
%{
  module Make (A : Ast.Annot) = struct
    open Ast
  (* ... *)
%}
/* ... */
%%
end

これで生成される Parser モジュールが が Make ファンクタを持つように なります。そして肝心の %type 宣言を以下のように記述します。

%type <A.t expr> expr

これで生成される Parser モジュールが parameterized parser になりまし た。ただ、このままでは OMake などから利用したときにコンパイルエラーにな ります。その原因は ocamlyacc が生成する parser.mli が、 parser.ml の内容と一致していないためです。実は parser.mli は ocamlc -i parser.ml > parser.mli のように生成されているわけではなく、単純な テンプレートを使って生成されています。そのため、こういうハックを使うと 対処できなくなるわけです。そこでメイクルールにもハックを入れて、 ocamlc で parser.mli を生成するようにします。ちなみに ocamlyacc に mli ファイルを生成しないオプションがあれば事は単純なのですが、当然そ んな便利機能ないわけでして、手の届かなさが惚れ惚れしますね。

(* OMakefile *)
parser.mli: parser.ml
$(OCAMLC) -i $< > $@

parser.ml: parser.mly
$(OCAMLYACC) -bgen_parser $(OCAMLYACCFLAGS) $<
mv gen_parser.ml $@
rm gen_parser.mli

やってることは、まず ocamlyacc で gen_parser というベース名でパーサー を生成したのち、 gen_parser.ml を parser.ml に改名して、 gen_parser.mli というゴミを消してから、最後に ocamlc で parser.mli を生成します。実はこれ、 parser.ml が依存するモジュール をあらかじめコンパイルする意図を OMake に伝えることができてないのですが、 どうやればいいのか分からないのでこのままにしています。詳しい人がいれば 教えてください。

以上の手順を踏めば parameterized parser を作ることが可能になるはずです。 ついでにおまけコードを載せておきます。僕は大体こういうテンプレートを使 います。

(* parse.ml *)
module Make (A : Ast.Annot) = struct
  module Parser = Parser.Make (A)

  let parse_from_lexbuf lexbuf =
    Parser.expr Lexer.token lexbuf

  let parse_from_string s =
    parse_from_lexbuf (Lexing.from_string s)

  let parse_from_channel c =
    parse_from_lexbuf (Lexing.from_channel c)

  let parse_from_file file =
    let c = open_in file in
      try
        let ast = parse_from_channel c in
          close_in c;
          ast
      with e ->
        close_in c;
        raise e
end
include Make (Ast.Pos)

以下のような感じで使います。

# Parse.parse_from_string "1+2*3";;
- : Lexing.pos expr = ...

自分の注釈でパーサーをパラメータ化するには以下のように書きます。

module NodeID : Annot = struct
  type t = int
  let counter = ref 0
  let of_pos _ = incr counter; !counter
end

module MyParse = Parse.Make (NodeID)

使い方は先と同じです。

# MyParse.parse_from_string "1+2*3";;
- : int expr = ...

なかなか便利ですね。

最後に拙作の ocaml-lang-ruby と ocaml-lang-python を紹介し ておきます。前者は Ruby コードのパーサーとプリティプリンタを、 OCaml で 実装したライブラリで、後者はそれの Python 版です。両者とも今回言及した テクニックを使って parameterized parser を作っています。参考になるか分 かりませんが、何か分からない点があればコードを眺めてみると良いと思いま す。