2015年の斑鳩

せっかくブログを作ったので斑鳩についても2015年のまとめ。

目標と進捗

特にデスクトップPCがお眠りになって以来、Lisp音ゲーにかまけてほぼサボっていました…*1

3400万という次なる理想に対する以下の小目標(後付け)はどれも道半ばといったところでしょうか。

  1. 解放合戦の残1秒パターンを通しに組み込む
    • 元は残7秒パターン
  2. 全体的な精度の向上
  3. C4外周パターン(途中まで)を通しに組み込む
    • 元は内周全滅パターン

解放合戦

点数目的というよりは、更新かかってる時に残1秒を狙えるぐらいの胆力がないと更新なんかできまい、という試練としての意味合いが強いです。また、通しに慣れることの一貫でもあります。現状はまだ成功率が低いです。個々のパーツはできてきてますが、練習量が絶対的に足りていません…。

参考に残7秒パターン解説。下記で残7秒になります。一回死んでも撃破が間に合うので、時間切れでボスボーナス0点の悲しさに耐えられない人にお勧めです。扇状弾の開始直後は弾がばらけていて個人的に苦手なので、いったん撃ちやめて避けに徹しています*2。60回のカウントは慣れると半自動でできるようになります。ちなみに、+5回吸うと残2秒ぐらいになります。

  • ショットは撃たない
  • 扇状弾が来るまでは解放を撃ち返す
  • 扇状弾が来たら60回は吸収に徹する
  • あとは撃破まで解放を撃ち返す(10回ほど)

精度向上

3400万に対して余裕のないパターンで(当面)挑むつもりなので、精度向上が重要になっています(3300万までは目標+100万ぐらいのパターンを使って多少のミスは許容という感じでしたが)。今までに比べ、反復練習で手に覚えさせる部分よりも、頭で考えてなんとかする部分を意識しました。再現性のあるバグは必ず直せるはずだ、という信念に基づいて頭を使ってました*3。おかげで2度同じミスをすると、「これは直せる!」と嬉しく思えるぐらいには脳回路ができあがってきました。

成果としては、全体にちょっと間を空けたぐらいならほぼ精度は落ちないぐらいの自信はついてきました。といっても、安定性の下限と上限を引き上げた感じなので、上限まで引っぱりあげるには密な反復練習しかないです。

個別に見るとC3は目に見えて効果が出ていて、今が一番安定しているような気がします。そのC3を含めても全体的にまだまだ不安ポイントは多いので、段々と潰していきたいです。

C4外周

3300万とれたらやろうとしていたC4外周(の一部)。内周全滅+30万ぐらいになりました。通しに組み込むには現実まだ厳しいかなというところで投入してみて、今は偶にうまくいく程度に安定してきました。まだ全体的な不安定さは残りますが、大体2, 3箇所ぐらいまで不安ポイントを絞れてきた感じです。

始めてしばらくは、これ自分の力量では安定する気がしないのだが…と思っていましたが、意外と芽は見えてくるものですね。

来年

大目的の3400万は変わっていないので引き続き前進です。

何よりも、早いところデスクトップPCを輪廻転生させて、家斑鳩環境を復活させないといけないですね…。

おまけ

斑鳩納めの結果

12月30日にHeyにて斑鳩納めをしてきました。3回プレイして納めは残6の3180万でした。更新いけるかもというペースで解放合戦に突入し、扇状弾に突っ込んで死にました。ついでにもう1回死にました。突入時に迷わず残1秒パターンを狙いにいけたというのはまあ収穫です。失敗してたらしょうがない訳ですが…。

f:id:eshamster:20151231030039j:plain:h500

投稿した動画

そういえば、こんなネタを投稿してました。見直してみるとテロップ直前は中々面白いパターンになってますね。あと、いつのまにか「C3の人」タグが付いてました w

www.nicovideo.jp


*1:早く修理出さないと、と半年ぐらい言ってます。

*2:30回程吸うと密度が安定して見易くなります

*3:目線やら意識の向け方やら位置取りやらタイミングやら。面白いところだと無意識にやった方が精度が良い場面もあって、そのための意識配分を考えた部分もあります。一番の具体例はC3のシャッター地帯ラストです。

マクロ展開時に副作用を起こすことの恐ろしさ

Lisp Advent Calendar 2015の23日目の記事です。

qiita.com

すごく及び腰でしたが、ずっと空いていたので、えいやで登録してみました。

マクロ展開時に副作用を起こすな危険、という内容です。

前書き

On Lisp: マクロのその他の落し穴によると、「Lispは,マクロ展開を生成するコードは 第3章で論じた意味で純粋に関数的であるものと予期している. 展開を行うコードは引数として渡された式にのみ依存すべきで, 値を返す他には周囲の世界に影響しようとすべきではない.」とあります。下線を言い換えると副作用を起こすなということになると思います。NG例の一つに、マクロの展開回数を数えようとしてグローバル変数 *nil!s* に触る以下の例が示されています。

(defmacro nil! (x)                   ; 誤り
  (incf *nil!s*)
  `(setf ,x nil))

正直に言うとその下にある説明では結局いつ困るのかピンと来ませんでした。が、Parenscriptをいじっていてこれで散々ハマった*1ので、勉強結果を展開してみます。次を伝えることが目標です。

  • どう恐ろしいのかという感覚
  • どうしてそうなるのかという理屈

大多数のLisperにとっては分かりきった話だろうと思いつつ、次のような感じで進めていきます。

  • 前座:Parenscriptの簡単な紹介
  • 怖さが伝わるかもしれない例
  • 解説
  • 実際にハマった話
  • まとめ

前座:Parenscriptの簡単な紹介

ParenscriptはCommon Lispの(サブセット)コードをJavaScriptコードに変換してくれるライブラリです。下のように ps:ps マクロの中にCommon Lispコードを書くとJavascriptコードを文字列として出力してくれます。

CL-USER> (ql:quickload :parenscript :silent t)
(:PARENSCRIPT)
CL-USER> (ps:ps (test-func 10 20))
"testFunc(10, 20);"
CL-USER> (ps:ps (funcall (lambda (a b) (+ a b))
                         10
                         20))
"(function (a, b) {
    return a + b;
})(10, 20);"

Lispとしては外せないマクロもサポートされていて、大きくは次の2つの方法で定義できます。

;; ps環境内でdefmacroを呼ぶ方法 
CL-USER> (ps:ps (defmacro test-macro (a b)
                  `(+ ,a ,b))
                (test-macro 10 20))
"10 + 20;"
CL-USER> (ps:ps (test-macro 20 30))   ; グローバルに定義される
"20 + 30;"

;; defpsmacro による方法
CL-USER> (ps:defpsmacro test-psmacro (&rest rest)
           `(* ,@rest))
TEST-PSMACRO
CL-USER> (ps:ps (test-psmacro 10 20 30))
"10 * 20 * 30;"

ps環境内でのdefmacroは内部的にはdefpsmacroを呼んでいます。このため、どちらも同じように使えます…だったら良かったのですが…。

何が起きるのか

Parenscript用のマクロ(以下、PSマクロ)定義を2種類紹介しました。これらはPSマクロを管理するグローバルな変数parenscript::*macro-toplevel*に登録されるタイミングが異なります。

  • ps環境内での defmacro: 展開「時」にマクロ定義が登録される
  • defpsmacro: 展開「後」にマクロ定義が登録される

従って、ps環境内での defmacro の方が展開時に副作用を起こすというまずい動作をしています。これが何を引き起こすのか見てみます。

準備

REPLや一つのスクリプトファイルで試していても中々起きない現象であるため、小さなプロジェクトを一つ起こして、quicklispの配下に置きます。

CL-USER> (ql:quickload :cl-project :silent t)
(:CL-PROJECT)
CL-USER> (cl-project:make-project (merge-pathnames #p"test-ps-eval-order" ql:*quicklisp-home*)
                                  :author "eshamster"
                                  :licence "MIT"
                                  :depends-on '(parenscript))
writing /home/esh/.roswell/impls/ALL/ALL/quicklisp/test-ps-eval-order/.gitignore
writing /home/esh/.roswell/impls/ALL/ALL/quicklisp/test-ps-eval-order/README.markdown
writing /home/esh/.roswell/impls/ALL/ALL/quicklisp/test-ps-eval-order/README.org
writing /home/esh/.roswell/impls/ALL/ALL/quicklisp/test-ps-eval-order/test-ps-eval-order-test.asd
writing /home/esh/.roswell/impls/ALL/ALL/quicklisp/test-ps-eval-order/test-ps-eval-order.asd
writing /home/esh/.roswell/impls/ALL/ALL/quicklisp/test-ps-eval-order/src/test-ps-eval-order.lisp
writing /home/esh/.roswell/impls/ALL/ALL/quicklisp/test-ps-eval-order/t/test-ps-eval-order.lisp
T

次に、できあがったsrc/test-ps-eval-order.lisp を編集して次のように2種類の方法でParenscript用のマクロを定義してみます。また、これらのマクロの展開結果を確認するため、print-ps関数を作成 & exportします。なお、eval-whenがないと(print (ps (test-defpsmacro)))の部分でマクロが動きませんが、本題ではないので詳細略です*2

gist.github.com

さらに、できるだけクリーンな環境で実行したいので、Roswellスクリプトを一つ起こして、上記のprint-ps関数を呼び出すコード(とParenscriptをロードするコード)を追加します。

# ※OSコンソール
$ cd 任意の場所
$ ros init execute.ros

gist.github.com

実行

さて実行です。

$ ./execute.ros
To load "test-ps-eval-order":
  Load 1 ASDF system:
    test-ps-eval-order
; Loading "test-ps-eval-order"
[package test-ps-eval-order]
----- From test-ps-eval-order::print-ps -----
"ok = 'expanded by test-defpsmacro';"
"ok = 'expanded by test-defmacro-in-ps';"

どちらの定義もパッケージ内部ではうまく動いているようです(下3行)。次はパッケージ外(execute.ros側)から呼び出すため、以下を修正します。

  • src/test-ps-eval-order.lispのexportに両マクロを追加
  • execute.rosのmain関数にこれらを呼び出すコードを追加
;; src/test-ps-eval-order.lisp
(defpackage test-ps-eval-order
  (:use :cl
        :parenscript)
  (:export :test-defpsmacro
           :test-defmacro-in-ps
           :print-ps))
;; execute.ros
(defun main (&rest argv)
  (declare (ignorable argv))
  (print-ps)
  (princ "----- From execute.ros ----")
  (print (ps (test-defpsmacro)))      ; ここと
  (print (ps (test-defmacro-in-ps)))  ; ここの2行はprint-ps関数と同じコード
  (fresh-line))

そして実行。

$ ./execute.ros
To load "test-ps-eval-order":
  Load 1 ASDF system:
    test-ps-eval-order
; Loading "test-ps-eval-order"
[package test-ps-eval-order]
----- From test-ps-eval-order::print-ps -----
"ok = 'expanded by test-defpsmacro';"
"ok = 'expanded by test-defmacro-in-ps';"
----- From execute.ros ----
"ok = 'expanded by test-defpsmacro';"
"ok = 'expanded by test-defmacro-in-ps';"

なんだ問題ないじゃないか…と思って、もう一度実行してみます。

$ ./execute.ros
To load "test-ps-eval-order":
  Load 1 ASDF system:
    test-ps-eval-order
; Loading "test-ps-eval-order"

----- From test-ps-eval-order::print-ps -----
"ok = 'expanded by test-defpsmacro';"
"ok = 'expanded by test-defmacro-in-ps';"
----- From execute.ros ----
"ok = 'expanded by test-defpsmacro';"
"testDefmacroInPs();"

なんということでしょう。1回目と異なり、execute.ros側だけps環境内のdefmacroで定義したtest-defmacro-in-psマクロが消えています(関数扱いされています)。

  • 同じように書いたのに結果が違う…
    • → 書いたコードをいくら眺めても原因が分からない
  • 2度実行すると結果が変わる…
    • → 再現条件に確信を持てないため、色々いじっても直ったのか判断できない

見た瞬間デバッグする気力が削られる要素に満ちています。

解説

どうしてこうなったかを解説し、さらに、現象を再現する小さなコードを書いて動作を眺めてみます。

どうしてこうなった

上記の2回連続実行の出力を良く見ると、本体であるprint-psの出力の手前に違いがあります。1回目は[package test-ps-eval-order]の出力がありますが2回目はありません。quicklisp/setup.lispを見てみると、これはコンパイル時のみ出力されるメッセージのようです*3

(defun macroexpand-progress-fun (old-hook &key (char #\.)
                                 (chars-per-line 50)
                                 (forms-per-char 250))
;; ~略~
             (show-package (name)
               ;; Only show package markers when compiling. Showing
               ;; them when loading shows a bunch of ASDF system
               ;; package noise.
               (when *compile-file-pathname*
                 (finish-line)
                 (show-string (format nil "[package ~(~A~)]" name))))

ここから、以下の違いにより1回目と2回目で結果が変わったと推測できます。マクロ展開時の副作用はバイナリには残らないことに注意します*4

  • 1回目:test-ps-eval-orderをコンパイル*5、続けてそれをロードしてexecute.rosを実行
    • コンパイルから実行までが同じ環境で行われる
    • → マクロ展開時の副作用(test-defmacro-in-psマクロの定義)はバイナリには残らないが、環境には残っている
    • test-defmacro-in-psマクロの定義がexecute.rosからも見える
  • 2回目:コンパイル済みのtest-ps-eval-orderをロードしてexecute.rosを実行
    • コンパイルと実行が異なる環境で行われる
    • → マクロ展開時の副作用はバイナリには残らないし、そのため環境にもロードされない
    • test-defmacro-in-psマクロの定義がexecute.rosからは見えない

結局のところマクロ展開時の副作用は、ライブラリに変更がない場合はコンパイルを省略しても結果は変わらない、という(妥当な)仮定を崩すことになります。

なお、その他2点の疑問は以下のように説明できます。

  • なぜ、test-ps-eval-orderライブラリ内部からは常にtest-defmacro-in-psが見えるのか
    • バイナリにはtest-defmacro-in-psマクロが既に展開された状態で記録されているため
      • ps:psマクロによるtest-defmacro-in-psマクロの展開もコンパイル時に行われる
  • なぜ、test-defpsmacroは常にどこからでも見えるのか
    • バイナリにParenscript用マクロ定義(= parenscript::*macro-toplevel*への登録)を行う処理自体が残るので、ロード時に定義が実行されるため

小さく再現してみる

解説のためというよりは、現象をより剥き出しにするための小さなコードを書いてみます。

2つのファイルを用意します。1つはライブラリのつもりでtest-lib.lispを、もう1つはこれを利用するアプリケーションのつもりでtest-app.rosスクリプトを用意します。

test-lib.lisp

(eval-when (:compile-toplevel :execute :load-toplevel)
  (defvar *hoge-func-list* nil))

(defmacro defhoge (name &body body)
  `(progn (pushnew ',name *hoge-func-list*)
          (defun ,name ()
            ,@body)))

(defmacro defhoge-wrong (name &body body)
  (pushnew name *hoge-func-list*)         ; 誤り
  `(defun ,name ()
     ,@body))

(defhoge lib 1)
(defhoge-wrong lib-wrong 2)

(defun print-all-hoge ()
  (dolist (hoge (reverse *hoge-func-list*))
    (format t "~A from ~A~%" (funcall hoge) hoge)))

外の環境に触れたくなるのは大抵define系マクロだろうと思い、test-lib.lispではdefhogeというhogeを定義するマクロを提供します。defhoge-wrongも同様ですが、マクロ展開時に登録を行うという間違った動作をします。また、それぞれを利用して2つのhogeliblib-wrongを定義します。さらに、hogeを登録順に出力するprint-all-hoge関数も提供します。

test-app.ros

#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#

(defvar *load-kind* 0) ; ここを書き換えて実行する: 0, 1, 2

(case *load-kind*
  (0 (load "test-lib.lisp"))
  (1 (compile-file "test-lib.lisp" :output-file "test-lib.fasl" :print nil :verbose nil)
     (load "test-lib.fasl"))
  (2 (load "test-lib.fasl"))
  (t (error "arg error")))

(defhoge app 10)
(defhoge-wrong app-wrong 20)

(defun main (&rest argv)
  (declare (ignorable argv))
  (print-all-hoge)
  (fresh-line))

test-app.rosでは上記のtest-lib.lispをロードして2つのhogeappapp-wrongを定義し、print-all-hogeを呼び出して登録済みhoge一覧を出力します。ロードは*load-kind*の値に応じて3種類のいずれかの方法で行います。

*load-kind*が0の場合:test-lib.lisp自体をロード

$ ./test-app.ros
1 from LIB
2 from LIB-WRONG
10 from APP
20 from APP-WRONG

*load-kind*が1の場合:test-lib.lispコンパイルし、続けてtest-lib.faslをロード

$ ./test-app.ros
2 from LIB-WRONG
1 from LIB
10 from APP
20 from APP-WRONG

*load-kind*が2の場合:コンパイル済みtest-lib.faslをロード(※事前に1のケースを動かすこと)

$ ./test-app.ros
1 from LIB
10 from APP
20 from APP-WRONG

ここまでの説明で原理は分かるはずなので解説は省略します。念のため、最初のtest-ps-eval-orderの例では、1回目の実行は*load-kind*が1の場合に、2回目の実行は*load-kind*が2の場合に相当します。なお、この例では*load-kind*を固定している限り、何度実行しても実行結果は変わりません。

余談ですが、hogeを記録する*hoge-func-list*defvarではなくdefparameterで定義すると、*load-kind*が1のときの結果が2の場合と同じになります。定義済みの変数を上書きするdefparameterと上書きしないdefvarの挙動の違いですね。

実際にハマった例

最後にこの記事の発端となったコードを。Parenscriptをもう少し便利に使えないかと色々実験をしているps-experimentというライブラリを作っています*6

github.com

この中で、ps環境下で利用できるdefstructのサブセットを作ったのですが、これを利用するコードでエラーが出て散々にハマりました。定義の一部を載せます。冒頭のパース系の関数の定義は本題と無関係なため省略します。

gist.github.com

コメントにありますが、アクセサの定義で利用しているdefmacroが問題です。ここで注意ですが、defpsmacroで定義したParenscript用のマクロは、結局ps環境下で展開されます。このため、defpsmacro下でのdefmacroはps環境下でのdefmacroと実質上同じものです。

アクセサがマクロ展開時に定義されてしまうため、このdefstructで定義した構造体を別のライブラリから使おうとすると、アクセサだけ見えない(ことがある)という問題に悩まされることになります(なりました)。

厄介なことに、この問題はps-experimentのテストでは検出されませんでした。テストでは同じ環境下でdefstructによる構造体定義とそのテストコードをロードするため、問題なく「動いてしまいました」。上記のtest-libとtest-appの例で言うと、test-app側でのdefhoge-wrongの利用に相当するケースです。

結局どうしたのかですが、ps環境下でのdefstructはデサポートすることにしました。代わりに、これをラップしてトップレベルで利用するために用意していたdefmacro.psマクロを直接提供することにしました。

gist.github.com

defxxx.ps系マクロはトップレベルでParenscript用の色々を定義するためにps-experimentで用意しているマクロ群です。全体として、defpsmacrodefmacroで、その他defxxxdefxxx.psで置き換えた以外、見た目に大きな違いはありません。

ただ、マクロ展開時にグローバルな値を読み込んでいる箇所があり、問題がないか気にしています。具体的には、include(スロット定義の継承)を実現するために、parse-defstruct-name-and-options*ps-struct-slots*(上記では省略)というグローバルなハッシュを読み込んでいます。このハッシュへのスロットの登録はregister-defstruct-slotsで行っています。eval-whenによる指定で、下記のようなコードをコンパイルしたときにも、childのマクロ展開よりも早い段階でparentの登録を行う形になっています(かつマクロ展開時の副作用を避けています)。ここのハッシュ読み込みは明らかに「純粋に関数的」でないため怪しいのですが、当面これで様子を見ようと思っています。

(defstruct parent a b)
(defstruct (child (:include parent)) c)

現状で見えている怪しげな動作というと、コンパイル→ロードとすると同じ定義が2度実行されるというものがあります。が、同じもので上書きするだけなので大抵問題ない…はず。ちなみに、この辺りの動作は上記test-lib, test-appにおいて、1. defhogeprogneval-whenに置き換える、2. pushnewpushで置き換える、3. *load-kind*を1に設定する、としてみると確認できます("1 from LIB"が2回出ます)。

記事を書くにあたり、参考にClozure CLのdefstructの実装を見てみたのですが、グローバルな環境への登録はあくまでロード時に行っており(%defstruct-do-load-time)、コンパイル時にはレキシカルな環境&environment envに一時的に登録することで副作用を避けているようです(define-compile-time-structure)。マクロ展開が「純粋に関数的」な動作をするようにかなり慎重に作られている様子が伺えます。注意ですが、まだ&environmentを理解し切れていないので嘘を言っているかもしれません。


まとめ:恐しさについて改めて

マクロ展開時に副作用を起こすことの恐ろしさは、原因を特定しにくいバグにつながる、というところにつきます。

マクロ展開時の副作用の結果は環境には残るため、Lispの利点であるインクリメンタルな開発の最中にはまず気づきません。さらに、テストを書いてクリーンな環境で実行していてもまだ気づかないケースも多いです。これは、上記のps-experimentのdefstructサブセットのように、自身では使わない外向けに提供する機能で起こりやすいです。そしてある日、実行条件に応じて結果が変わるような再現しにくいバグに遭遇します。

バグの原因特定を困難にする典型的な要因である、発見までに時間がかかることと、再現条件が分かりにくいことという両方を満たすわけです。自分はこのバグに遭遇してから見当違いの方向にも走りつつ数日苦しみました。

ということで、マクロ展開時の副作用には敏感になりましょう、と釈迦に説法をしたところで終わりにします。


*1:Parenscriptの仕様と関係なく勝手にハマった部分も多々ありますが、、とりあえず関係ある部分の紹介です

*2:eval-whenがdefpsmacro内で呼ばれていないのは、それはそれで問題なのですが、外付けで対処可能なため傷は浅いです。eval-when自体について参考になるのはこの辺り「macros - Eval-when uses? - Stack Overflow」でしょうか。なお、Parenscriptのこのコミット(リンク)でmasterは修正されていますが、quicklispの参照しているhttp://common-lisp.net/project/parenscript/release/parenscript-latest.tgzに反映されていないようです

*3:本題と関係ない調査メモ。HyperSpecによると、*compile-file-pathname*はcompile-file関数の実行中のみファイルパスが設定され、それ以外はnilにセットされるもののようです。また、macroexpand-progress-fun自体は、*macroexpand-hook*用のhook関数を返します。切り出したコードの少し下を見ると、defpackageマクロの展開時であることが内部関数show-packageを呼び出す条件の一つになっています。以上を合わせて、コンパイル時のみパッケージ名を(重複なく)出力する動作を実現しているようです。

*4:HyperSpecにあるexpansion functionの説明では"The value of the last form executed is returned as the expansion of the macro"と記述されています。

*5:上の例では、ここでコンパイルさせるためにtest-ps-eval-orderライブラリ側にわざとらしく変更を加えています :)

*6:参考記事:Parenscriptで遊んで見る (1) defun編 - eshamster’s diary

SBCLとCCLの違い:defstructのincludeにおけるスロット名の比較方法

Common Lispの構造体定義マクロdefstructでは、:includeで別の構造体のスロット名やその初期値を引継ぐことができます。このとき、下記の(a 100)のように初期値を上書きできます。

CL-USER> (defstruct parent (a 10) (b 20))
PARENT
CL-USER> (defstruct (child (:include parent (a 100))) c)
CHILD
CL-USER> (make-child)
#S(CHILD :A 100 :B 20 :C NIL)

:include内で存在しないスロット名を指定すると当然エラーになるわけですが、このときのスロット名の比較(存在するかを判定するための)の仕方がSBCLとClozure CL (CCL) *1で異なるようだったのでメモ。

gist.github.com

このRoswellスクリプトを走らせると、SBCLではエラーなく動きますが、

#S(TEST-STRUCT2 :SLOT1 100 :SLOT2 NIL)

CCLではslot1なんて知らんと言われてエラーになります(CLISPもこのパターンでした)。

Error: TEST-STRUCT has no SLOT1 slot, in (:INCLUDE TEST-STRUCT (SLOT1 100))

CCLで動かすためには、初期値を上書きする部分でpack-ainternされたslot1シンボルを指定する必要があります(pack-aの定義でslot1もexportするなど)。なお、exportしておく分にはSBCLでも問題なく動くので、必要な場合はexportしておくのが正しいと思います。

includeにおいて、SBCLではパッケージに依存しない形でスロット名を比較しており、CCLではパッケージに依存した形で比較しているようです。…で終わるのも悲しいので、それぞれの該当部分のソースもほんの少し見てみます。

まずSBCLのソースです。手元にあったバージョン1.2.15を見てみました。エラーメッセージから該当箇所は簡単に見つかります。:test #'string=と比較方法を指定しているので、確かにパッケージを含まないシンボル名のみで比較しているようです。

;; L768~@src/code/defstruct.lisp
(defun frob-dd-inclusion-stuff (dd)
;; ...(略)...
      (flet ((included-slot-name (slot-desc)
               (if (atom slot-desc) slot-desc (car slot-desc))))
        (mapl (lambda (slots &aux (name (included-slot-name (car slots))))
                (unless (find name (dd-slots included-structure)
                              :test #'string= :key #'dsd-name)
                  (error 'simple-program-error
                         :format-control "slot name ~S not present in included structure"
                         :format-arguments (list name)))
;; ...(略)...

次はCCLです。バージョンは1.9です*2。同じくエラーメッセージから探してみます。named-ssdなるマクロでスロットが存在するかを探していますが、最終的には下のようにeqで比較をしています。ということで、確かにパッケージを含む形で比較を行っているようです。

;; L42~@lib/defstruct-lds.lisp
(defmacro defstruct (options &rest slots &environment env)
;; ...(略)...
        (while slots
          (if (atom (car slots))
            (setq name (%car slots) args ())
            (setq name (%caar slots) args (%cdar slots)))
          (unless (symbolp name) (signal-program-error $XNotSym name))
          (unless (setq ssd (named-ssd name slot-list))
            (error "~S has no ~S slot, in ~S"
                   (sd-name sub-sd) name (cons :include include)))
;; ...(略)...
;;L74@lib/defstruct-macros.lisp
(defmacro named-ssd (name slot-list) `(assq ,name ,slot-list))

;; L402~@compiler/optimizers.lisp
(define-compiler-macro assq (item list)
  (let* ((itemx (gensym))
         (listx (gensym))
         (pair (gensym)))
    `(let* ((,itemx ,item)
            (,listx ,list))
      (dolist (,pair ,listx)
        (when (and ,pair (eq (car ,pair) ,itemx)) (return ,pair))))))

SBCLはスロット名なんてパッケージ関係ないよねという考え方…かと思いきや、with-slotsslot-valueではやっぱりパッケージを考慮しているので、なんだか半端です。この辺りも考え合わせると、SBCLのやり方が特殊という感じがします。どういった考えなんでしょう。

*1:単に普段利用している処理系というだけです

*2:古いですが、前に1.10を入れようとしたところ、手元のCentOS 6.5ではglibcか何かが古くて入らなかったため放置してます…

Common Lispでマクロ展開時エラーをテスト

前回記事の「Parenscriptで少し遊んで見る (5)defstruct編 - eshamster’s diary」ではdefstruc.psマクロ内で展開時のエラー処理を入れたので、テストも一緒に作っています。このときに、マクロ展開時のエラーをテストする方法が意外と見つからなかったのでメモ。探し方が悪いのか、そんなの当たり前でしょということで誰も書いていないのか。

CL-USER> (defmacro throw-error-macro (x)
           (if (numberp x)
               `(+ ,x 10)
               (error 'type-error)))
THROW-ERROR-MACRO

特に意味のないマクロですが、数値型を受けとると10を足す式を返し、それ以外の型を受けとると(展開時に)type-errorを投げます。この挙動をテストしたい訳ですが…

CL-USER> (ql:quickload :prove :silent t)
(:PROVE)
CL-USER> (prove:is-error (throw-error-macro nil) 'type-error)
;
; compilation unit aborted
;   caught 1 fatal ERROR condition
;   caught 1 ERROR condition
; Evaluation aborted on #<SIMPLE-ERROR "unbound condition slot: ~S" {1005EC7663}>.

というように、prove:is-errorが呼び出される前のコンパイル段階でエラーになるため、prove:is-errorでエラーを捕捉できません。マクロを実行時に評価できれば良いわけですが、実行時評価となればevalの出番です。

CL-USER> (prove:is-error (eval '(throw-error-macro nil)) 'type-error)(EVAL '(THROW-ERROR-MACRO NIL)) is expected to raise a condition TYPE-ERROR (got #<TYPE-ERROR {1003C91FE3}>) 
T
#<PASSED-TEST-REPORT RESULT: T, GOT: #<TYPE-ERROR {1003C91FE3}>, EXPECTED: TYPE-ERROR>

できました。一々evalやクォートを書くのが気持ち悪い場合、以下のようにprove-macro-expand-errorマクロを作成します。

CL-USER> (defmacro prove-macro-expand-error (code expected-error)
           `(prove:is-error (eval ',code) ,expected-error))
PROVE-MACRO-EXPAND-ERROR
CL-USER> (prove-macro-expand-error (throw-error-macro nil) 'type-error)(EVAL '(THROW-ERROR-MACRO NIL)) is expected to raise a condition TYPE-ERROR (got #<TYPE-ERROR {10044945E3}>)
T
#<PASSED-TEST-REPORT RESULT: T, GOT: #<TYPE-ERROR {10044945E3}>, EXPECTED: TYPE-ERROR>

言われてみれば当たり前な気がしますが、個人的にはevalを使う機会がなかったので中々出てこない発想でした。

ちなみに、元々は「リードマクロ入門、の10分の1歩ぐらい後か前 - eshamster’s diary」のコメントで教えて頂いたREPL環境でのリードマクロの試用方法から思い至ったため、(format nil "~S" ...)で文字列化してread-from-stringをしてevalするという無駄なことをしていました。一方で、リードマクロのエラーをテストしたい場合はread-from-stringを使えば良さそうです。

追記:macroexpand

g000001さんからmacroexpand(-1)の方が一般的とのコメントを頂きました。evalは汎用的過ぎるので、可能な限りより用途の限定されたもので代用するのが適切だと思いますが、macroexpand(-1)はまさにぴったりの用途ですね。Lispを勉強し始めてからは前より人のソースを見ることが増えましたが、まだまだ勉強不足でした。

ということで、macroexpand版です。見た目としてはevalmacroexpandに置き代わっただけです。

CL-USER> (prove:is-error (macroexpand-1 '(throw-error-macro nil)) 'type-error)(MACROEXPAND-1 '(THROW-ERROR-MACRO NIL)) is expected to raise a condition TYPE-ERROR (got #<TYPE-ERROR {10060A87D3}>) 
T
#<PASSED-TEST-REPORT RESULT: T, GOT: #<TYPE-ERROR {10060A87D3}>, EXPECTED: TYPE-ERROR>

;; マクロ化
CL-USER> (defmacro prove-macro-expand-error (code expected-error)
           `(prove:is-error (macroexpand ',code) ,expected-error))
PROVE-MACRO-EXPAND-ERROR
CL-USER> (prove-macro-expand-error (throw-error-macro nil) 'type-error)(MACROEXPAND '(THROW-ERROR-MACRO NIL)) is expected to raise a condition TYPE-ERROR (got #<TYPE-ERROR {1003246EA3}>) 
T
#<PASSED-TEST-REPORT RESULT: T, GOT: #<TYPE-ERROR {1003246EA3}>, EXPECTED: TYPE-ERROR>

Parenscriptで少し遊んで見る (5)defstruct編

Parenscript(PS)用にdefstructのサブセットを作った話です。例によってParenscript拡張の実験場、ps-experimentプロジェクトで実装を試みています。今回の記事時点のタグblog-play-ps-5をつけています。

github.com

前書き:Parenscript拡張の方針

ここまでと今回の内容を振り返ってみると、大体次のような方針で拡張を進めているようです(後付け)。

  • Common Lispとして書ける部分はそれなりにCommon Lispらしく
    • 理想を言えば、Common Lispコードとしてもそのまま動く
  • JavaScriptべったりなところはむしろよりJavaScriptらしく
    • xx.jsのようなライブラリに依存する部分

前者はdefun編や今回のdefstruct編、後者はドット記法編やキャメルケース編です。前者の「それなり」の範囲は感覚的になんとなく許せない範囲です。

今回で言うと、基本的なデータ構造がJSべったりなのはちょっと…と感じたわけです。

defstruct.psの実装方針

defstructを全面的にカバーするのはオーバースペックなので、defstruct.psの目標を次のように設定しました。

  • 作成時にスロットの初期化ができる
  • 型判定ができる
  • アクセサを生成する
  • 継承ができる
    • スロット名と初期値の継承ができる
    • 子構造体のインスタンスを親構造体のインスタンスとして判定できる
    • 親構造体のアクセサを利用できる

見ての通りdefstructの仕様からすると超のつくサブセットです。まずは想定範囲内では使えそうというところです。

使い方

できあがったものを上記の目標に沿って一通り動かしてみます。出力はprintの横に逐次コメントで書いているので省略します。

展開結果

(print (pse:with-use-ps-pack (:this)))で見られる展開結果のうち、childの部分だけ抜粋。アクセサはPS用のマクロとして別に管理されているため、JSコードとしては見えません。

function child() {
    this.a = 10;
    this.b = null;
    return this.c = 30;
};
function makeChild() {
    var _js4 = arguments.length;
    for (var n3 = 0; n3 < _js4; n3 += 2) {
        switch (arguments[n3]) {
        case 'a':
            a = arguments[n3 + 1];
            break;
        case 'b':
            b = arguments[n3 + 1];
            break;
        case 'c':
            c = arguments[n3 + 1];
        };
    };
    var a = 'undefined' === typeof a ? 10 : a;
    var b;
    var c = 'undefined' === typeof c ? 30 : c;
    var result = new child();
    result.a = a;
    result.b = b;
    result.c = c;
    return result;
};
function childP(obj) {
    return (obj instanceof child);
};
(function () {
    function tempCtor() {
        return null;
    };
    tempCtor.prototype = parent.prototype;
    child.superClass_ = parent.prototype;
    child.prototype = new tempCtor();
    return child.prototype.constructor = child;
})();

Parenscriptのキーワード引数の実装が少々不恰好ですが、現状ではJSコードへのコンパイル段階でどの関数を呼んでいるかを知るすべがないので、止むを得ないというところです。

実装

ps環境下でのdefstruct

一部を切り出し。まずは、(ps:ps (defstruct test (a 10) b))のように、ps環境下でdefstructを利用可能にするためのコード。一番下の(defpsmacro defmacro ...)が本体で、その上に補助関数をずらっと並べています。

見ての通りparse-defstruct-xxxがひたすら並んでいます*1。また、生成されたJavaScriptを見て文法エラーを見つけるのは辛そうなので、パース時のエラー処理を(それなりに)入れています。

JavaScript側の継承を実現する上では「Google流 JavaScript におけるクラス定義の実現方法」を参考にしました。最初はObject.setPrototypeOfを使ったお手軽な方法を使おうと考えていました。一連の流れをOperaChromiumエンジン)のコンソールで再現すると以下のようになります。

> function Parent () { this.a = 10; this.b = 20 };
  undefined
> function Child () { Parent.call(this); this.c = 30; };
  undefined
> Object.setPrototypeOf(Child.prototype, Parent.prototype); 
  Child {}
> var child = new Child();
  undefined
> child instanceof Parent;
  true

が、上記のサイトには互換性に問題ありと書かれていて、どうせ古いIEのことだろうとタカをくくっていたところ、テストに利用しているcl-javascriptで動きませんでした…。ということで、上記のコード(同サイトで紹介されているgoog.inherit実装のParenscript版)になりました。

また、スロット周りの継承を実現するために*ps-struct-slots*というグローバルなハッシュを用意しています。スロットそのものの継承だけであればJavaScriptのcall関数で十分ですが、CLライクなアクセサの定義を行なうために必要になります。

トップレベルでのdefstruct.ps

「使い方」のRoswellスクリプトの様に、トップレベルでPS用の構造体定義を可能にするためのマクロdefstruct.psを生成します。直接には3,4行目が該当のものです。

2015/11/30追記:よろしくないバグを見つけたので修正。あえて古いコードもコメントで残しましたが、On Lispにもある「値を返す他には周囲の世界に影響しようとすべきではない」の原則に反していました。元のコードでは、例えばdefun.psを使ったライブラリxyzを(ql:quickload :xyz)しても、関数が登録されていませんでした。さらに困ったことに、稀に登録されてることがありました…。この辺りの内部的な挙動はまだ理解し切れていませんが。

2015/12/5追記:defstruct.ps内でもregister-defstruct-slotsを呼ばないと上の追記と同じ問題が起こることが分かったのでこのコミットで修正。ちょっと汚いのでどうにかならないものか…。ちなみに、eval-whenは試行錯誤の痕跡でただの消し忘れです。

register-ps-func関数の詳細は第4回参照ですが、PSコードを出力する関数をグローバルに登録するものです。登録した関数はwith-use-ps-pack内(上記実行例参照)で呼び出されてPSコードを出力します(最終的にこのPSコードがJSコードを出力します)。

defstruct.psで構造体hogeを定義すると、hogeを定義するPSコードを出力する関数がこのregister-ps-funcで登録されます。この辺りはdefun.psdefvar.psでも共通のパターンであるため、def-ps-definerとしてマクロ化しました。

できていないもの

  • defstructの機能色々
    • 必要になったものから順次というスタンスです
  • 再定義時の動作
    • 現状は何も対策していないので、例えばスロットを消して再定義すると、消したスロットのゴミ(アクセサ)が残ります
    • HyperSpecを見ると"The consequences of redefining a defstruct structure are undefined." だそうですので非合法ではないですが、SBCLとCCLで試した限りではゴミ掃除ぐらいはしているようなので、踏襲した方が良いだろうと考えてます
      • なお、前者では非互換な再定義だと警告が出ました

Parenscript関連記事

Lisp-Parenscript カテゴリーの記事一覧 - eshamster’s diary

*1:S式≒リストのパースは本当に気軽にできますね

Parenscriptで少し遊んで見る (4)続・defun編

背景

第一回では、ps環境の外側でdefunするためのdefun+psを用意しました。そして、それをまとめてJavaScriptに出力するためのwith-import-ps-defマクロを作ったわけですが、出力する関数名を一々指定する必要がありました。

いったんはそこで妥協したのですが、実際に細かい関数をたくさん書いたときの面倒臭さや、複数ファイル(パッケージ)間での連携をどうするかという部分で実用上すぐに問題になるため、少し見直しました。

方針

以下、defun+ps, defun.psで定義した関数をPS関数と呼ぶことにします。

一つの理想はCommon Lispの柔軟なパッケージシステムを再現することだと思いますが、よく考えるとそこまでするのは無意味ではないかと思えてきます。次のような違いがあるためです。

  • (Common) Lisp: たくさんの関数を定義をしても、export, importするのは一部
  • Parenscript: たくさんのPS関数を定義したら、全てJavaScriptとして書き出す必要がある

第一回で重複書き出しの問題をどう避けるかが難しそうという話を書いたのですが、例えばいっそ定義されたPS関数を全て書き出す機能を用意する(それを何度も呼ぶ間違えはさすがに利用者の責任)、という乱暴な方法でも実用上は十分な解決方法になりえます。

ということで、以下の方針でdefun+psとwith-import-ps-defの改良を考えます。

  • JavaScriptに書き出す対象は大きな単位で指定し、関数単位での柔軟な操作は必要ない
    • 再利用性や今後の拡張性を考えてCommon Lispのパッケージを単位として採用する
    • 実現のために、グローバルな環境にPS関数の情報を持たせる

PS関数を管理する

(defparameter *ps-func-store* (make-hash-table))

(defun register-ps-func (name_)
  (symbol-macrolet ((target-lst (gethash *package* *ps-func-store*)))
    (unless (find name_ target-lst)
       (push name_ target-lst))))

(defun intern-ub (sym)
  (intern (format nil "~A_" (symbol-name sym))))

(defmacro defun+ps (name args &body body)
  (let ((name_ (intern-ub name)))
    (register-ps-func name_)
    `(defun ,name_ ()
       (ps
         (defun ,name ,args
           ,@body)))))

PS関数をグローバルに管理する構造として、*ps-func-store*を用意します。単なるハッシュで、パッケージをキーとし、関数(名)シンボルのリストを値として持ちます*1

実際に登録を担うのがregister-ps-func関数です。パッケージごとに関数名の重複を確認しており、未登録なら登録し、登録済みなら何もしません。これをdefun+psマクロから呼び出すことで、defun+psしたPS関数がそのパッケージに登録されます(要はdefunの場合と似たような動作)。

PS関数をprintする

登録したPS関数をJavaScriptとして吐き出すのがwith-use-ps-packマクロです。

; (interleave '(1 2 3) "a") => (1 "a" 2 "a" 3 "a")
(defun import-ps-funcs (ps-lst ps-body)
  (apply #'concatenate 'string
         (append
          (interleave (mapcar (lambda (elem) (funcall elem))
                              ps-lst)
                      "
")
          (list ps-body))))

(defmacro with-use-ps-pack (pack-sym-lst &body body)
  (with-gensyms (pack-lst func-lst)
    `(let* ((,pack-lst (if (equal (symbol-name (car ',pack-sym-lst)) "ALL")
                           (hash-table-keys *ps-func-store*)
                           (mapcar (lambda (sym)
                                     (let ((name (symbol-name sym)))
                                       (if (equal name "THIS")
                                           ,*package*
                                           (aif (find-package name)
                                                it
                                                (error "There is no package named \"~A\"." name)))))
                                   ',pack-sym-lst)))
            (,func-lst (flatten
                        (mapcar (lambda (pack)
                                  (reverse (gethash pack *ps-func-store*)))
                                ,pack-lst))))
       (import-ps-funcs ,func-lst (ps ,@(replace-dot-in-tree body))))))

次のようにパッケージのリストを指定すると、指定されたパッケージ内の関数を全て吐き出します。なお、特殊なキーワードとして:thisと:allを用意していて、:thisは自パッケージを指し示し、:allは*ps-func-store*で管理している全パッケージを指します。

=>
function f1(a, b) {
    return a + b;
};
function f2(b) {
    return f1(10, b);
};
function f3(a, b) {
    return a - b;
};
function f4(b) {
    return f2(200, b);
};
f1(a, b);

なお、全容は以下のps-experimetプロジェクトにあります。今回のfunction周りのコードはsrc/utils-func.lispです。結構いじりそうなので、一応タグとしてblog-play-ps-4をつけました。

github.com

できていないもの

依存性の登録・管理

依存性を登録しておくと、with-use-ps-packで一々指定しなくても依存するパッケージを自動で指定してくれるような機能です。複数プロジェクトをまたいでの利用を考えると、サブパッケージまで全部指定させるのは現実的ではないため、早めに作っておきたい機能です。

defvarなどもこの機能上に乗せる

JavaScriptに出力するグローバルな構造は一通りこの線上に乗せる必要があります。defvarはこの一例です。defstructはParenscriptに機能自体がないですが、簡易なサブセットぐらいは作って乗せたいです。なお、マクロ定義はJavaScriptとしては見えないので、現状通り別口 (Parenscriptのまま) で問題ありません。

名前空間の分割

PS関数をパッケージごとに管理はしているのですが、今のところJavaScript側にはパッケージ名なしの関数名しか出力しません*2。Parenscriptもパッケージシステムを再現しようとしているため乗っかろうとしたのですが、use-pacakgeやin-packageが望むものでなかった*3ため、とりあえず断念しました。自力で作成するには「Let Over Lambdaのnlet-tailがよく分からなかったのでメモ - eshamster’s diary」でも触れたコードウォークの問題があるため簡単ではなさそうです。必要なら取り組みたいですが、まずはこのままでも割りと実用にはなるかなと。


Parenscript関連記事

Lisp-Parenscript カテゴリーの記事一覧 - eshamster’s diary

*1:関数名のシンボルはパッケージ名付きでinternされるので、キーとしてパッケージを持たなくてもいいのですが、速度の上でも利便性の上でもより良いだろうと考えました

*2:このため、現状では他パッケージと関数名が被ったらエラーを出すのが親切かもしれないですが

*3:呼び出すときに必ずパッケージをつける必要がある。コードを見る限り、use-packageやin-packageがPS用に特殊なことをしているようには見えないので、使い方の問題ではないと見ています

Parenscriptで少し遊んで見る (3)キャメルケース編

リードマクロによるキャメルケース

今更ですが、Parenscriptでは大文字を表現するために、文字の直前にハイフンを置きます。

CL-USER> (ps (@ document get-element-by-id))
"document.getElementById;"

Common Lispでは通常シンボル名は大文字として解釈される(|Test|のようにすると大文字・小文字を区別可)ための処置で、上記の通り大抵は妥当な見た目になります。

ただ、WebGLでも触ってみようかと、その上に構築されたライブラリであるthree.jsのサンプルをParenscriptに置き換えていたのですが…、「THREE.WebGLRenderer」なるクラス名が出てきました。何かの嫌がらせかと思いましたが、そのまま書き下すと「(@ -t-h-r-e-e -web-g-l-renderer)」とさえないことになります(どちらかと言うと読むより書くのが辛い)。

THREE配下のクラスは他にもあるため、まずは下のようなマクロを書いて「(three -web-g-l-renderer)」のように凌ぎました。

(defmacro+ps three (&rest rest)
  `(@ -t-h-r-e-e ,@rest))

が、どうせなら局所的にキャメルケース(ないしは大文字小文字の区別)を許せないかと考えてみました。シンボル名を大文字として解釈するデフォルトリーダの動作を乗っ取る必要があるので、ここはリーダマクロの出番です。ということで、次のようにして「#j.TEST.WebGLRenderer#」という記述を可能にしてみます。

(eval-when (:compile-toplevel :load-toplevel :execute)
  (set-dispatch-macro-character
   #\# #\j
   (lambda (stream &rest rest)
     (declare (ignore rest))
     (let ((char (read-char stream)))
       (when (or (null char)
                 (not (char= char #\.)))
         (error "\".\" is required in the next of \"#j\"")))
     (let (chars)
       (do ((char (read-char stream) (read-char stream)))
           ((char= char #\#))
         (if (upper-case-p char)
             (progn (push #\- chars)
                    (push char chars))
             (push (char-upcase char) chars)))
       (intern (coerce (nreverse chars) 'string))))))

readを使っても大文字になったシンボルが返ってくるだけなので、read-charで一文字ずつ取り出して、大文字の場合は直前にハイフンを入れつつcharsにpushしていきます。これで、「#j.TEST.WebGLRenderer#」は「-t-h-r-e-e.-web-g-l-renderer」に変換され、さらに前回の"ps."マクロ内でこれを使うことで無事「(@ -t-h-r-e-e -web-g-l-renderer)」が得られます。

なお、キーワードに選んだ"j"はjavascriptの"j"です。また、最初は「#jTEST.WebGLRenderer#」("j"の後の"."なし)としても、大抵は次が大文字なので大丈夫じゃないか…と思ったのですが、意外と見にくかったので"."を必須としました。

試しに書いてみる

ここまでの3回で書いたマクロを使ってサンプルを書いてみます。なお、defun.psは第一回のdefun+psに第二回相当のドット記法を追加したものです。

対象とするのは「初心者でも絶対わかる、WebGLプログラミング<three.js最初の一歩> | HTML5Experts.jp」で紹介されているthree.jsのサンプル+αです。まず直接書いたものが以下です。

(defun.ps rotate-mesh (mesh)
  (with-slots ((rot rotation) (pos position)) mesh
    (rot.set 0
             (+ rot.y 0.01)
             (+ rot.z 0.01))
    (if is-keydown
        (pos.set 0 0 0)
        (pos.set (+ pos.x 0.05)
                 (+ pos.y 0.05)
                 0))))

(defun.ps main ()
  (let* ((scene (new (#j.THREE.Scene#)))
         (width 600)
         (height 400)
         (fov 60)
         (aspect (/ width height))
         (near 1)
         (far 1000)
         (camera (new (#j.THREE.PerspectiveCamera# fov aspect near far)))
         (renderer (new #j.THREE.WebGLRenderer#)))
    (camera.position.set 0 0 50)
    (renderer.set-size width height)
    (document.body.append-child renderer.dom-element)
    (let ((light (new (#j.THREE.DirectionalLight# 0xffffff))))
      (light.position.set 0 0.7 0.7)
      (scene.add light))
    (let* ((geometry (new (#j.THREE.CubeGeometry# 30 30 30)))
           (material (new (#j.THREE.MeshPhongMaterial# (create :color 0xff0000))))
           (mesh (new (#j.THREE.Mesh# geometry material))))
      (scene.add mesh)
      (labels ((render-loop ()
                 (request-animation-frame render-loop)
                 (rotate-mesh mesh)
                 (renderer.render scene camera)))
        (render-loop)))))

defun.psをそれぞれexpandして、ほぼ素のps相当であるdefun+psにしてみると、以下のようになります(見栄えを揃えるためにmacroexpandの結果を整形しています)。

(defun+ps rotate-mesh (mesh)
  (with-slots ((rot rotation) (pos position)) mesh
    ((@ rot set) 0
                 (+ (@ rot y) 0.01)
                 (+ (@ rot z) 0.01))
    (if is-keydown
        ((@ pos set) 0 0 0)
        ((@ pos set) (+ (@ pos x) 0.05)
                     (+ (@ pos y) 0.05)
                     0))))

(defun+ps main ()
  (let* ((scene (new ((@ -t-h-r-e-e -scene))))
         (width 600)
         (height 400)
         (fov 60)
         (aspect (/ width height))
         (near 1)
         (far 1000)
         (camera (new ((@ -t-h-r-e-e -perspective-camera) fov aspect near far)))
         (renderer (new (@ -t-h-r-e-e -web-g-l-renderer))))
    ((@ camera position set) 0 0 50)
    ((@ renderer set-size) width height)
    ((@ document body append-child) (@ renderer dom-element))
    (let ((light (new ((@ -t-h-r-e-e -directional-light) 0xffffff))))
      ((@ light position set) 0 0.7 0.7)
      ((@ scene add) light))
    (let* ((geometry (new ((@ -t-h-r-e-e -cube-geometry) 30 30 30)))
           (material (new ((@ -t-h-r-e-e -mesh-phong-material) (create :color 0xff0000))))
           (mesh (new ((@ -t-h-r-e-e -mesh) geometry material))))
      ((@ scene add) mesh)
      (labels
          ((render-loop ()
             (request-animation-frame render-loop)
             (rotate-mesh mesh)
             ((@ renderer render) scene camera)))
        (render-loop)))))

コードを劇的に短くするような改良ではないので微妙な差かもしれません。書いている分にはだいぶ書きやすいのですが。ただ、rotate-mesh関数については"@"が見た目の上でも非常に鬱陶しく、中身がすっと頭に入ってこないと感じますがどうでしょうか。

最後に、これを以下のような関数でjavascriptに出力します。なお、js-main内で使っているwith-use-ps-packは、第一回のwith-import-ps-defの改良(と信じている)版です。この辺りの話はまた次回に。

(defun js-main ()
  (with-use-ps-pack (this)
    (defvar is-keydown false)
    (window.add-event-listener "keydown" (lambda (e) (setf is-keydown true)))
    (window.add-event-listener "keyup" (lambda (e) (setf is-keydown false)))
    (window.add-event-listener "DOMContentLoaded" main false)))

結果は以下のとおりです。

function rotateMesh(mesh) {
    mesh.rotation.set(0, mesh.rotation.y + 0.01, mesh.rotation.z + 0.01);
    return isKeydown ? mesh.position.set(0, 0, 0) : mesh.position.set(mesh.position.x + 0.05, mesh.position.y + 0.05, 0);
};
function main() {
    var scene = new THREE.Scene();
    var width = 600;
    var height = 400;
    var fov = 60;
    var aspect = width / height;
    var near = 1;
    var far = 1000;
    var camera = new THREE.PerspectiveCamera(fov, aspect, near, far);
    var renderer = new THREE.WebGLRenderer;
    camera.position.set(0, 0, 50);
    renderer.setSize(width, height);
    document.body.appendChild(renderer.domElement);
    var light = new THREE.DirectionalLight(0xffffff);
    light.position.set(0, 0.7, 0.7);
    scene.add(light);
    var geometry = new THREE.CubeGeometry(30, 30, 30);
    var material = new THREE.MeshPhongMaterial({ 'color' : 0xff0000 });
    var mesh = new THREE.Mesh(geometry, material);
    scene.add(mesh);
    var renderLoop = function () {
        requestAnimationFrame(renderLoop);
        rotateMesh(mesh);
        return renderer.render(scene, camera);
    };
    return renderLoop();
};
var isKeydown = false;
window.addEventListener('keydown', function (e) {
    return isKeydown = true;
});
window.addEventListener('keyup', function (e) {
    return isKeydown = false;
});
window.addEventListener('DOMContentLoaded', main, false);

今回はほぼ1対1対応なので、JavaScriptに対する優位性は余りないかと思います。ただし、今回の範囲でもParenscriptのデフォルトマクロであるwith-slots(rotate-mesh関数内)は優位性を主張できる部分かと思います。同様にマクロを利用することで記述量を大幅に減らせる可能性があるというのがParenscriptの優位性と言えるでしょうか。

Lispそのものと同じで、本当にそうなのかは実際にもっと書いてみないと分からなさそうですが。

動作可能なサンプル

一応動作可能なサンプル(caveman2上で構築)は以下です。試す人もいないと思うのでおざなり解説ですが、quicklisp管理下にclone(submoduleのinit, updateも必要)後、(ql:quickload :caveman-sample)をし、(caveman-sample:start :port 8080)のようにすれば指定のポートで動作します。念のため、今回の記事時点でつけたタグは"blog-play-ps-3"です。

github.com

Parenscript関連記事

Lisp-Parenscript カテゴリーの記事一覧 - eshamster’s diary