Clojure + Emacsな開発環境を作った on Docker
前回記事「Common Lisp開発環境 on Dockerの現状 - eshamster’s diary」の冒頭で少し書いていたように、Clojure開発用のDocker環境を作ってみました。そろそろいい加減にClojureScriptをいじってみようかというのが主な動機です。
Docker上に開発環境を起こすのはCommon Lispに続いてようやく2言語目なので、言語ごとの開発環境を量産するための知見（主にEmacsの設定をどう管理するか）を得るという副目標もあります。
先に完成品のリンクを貼っておきます。
目次
概要
次のような構成を目指します。
- Alpine Linux：軽量なLinux
- Leiningen：Clojureプロジェクトの色々な管理をするソフト（Node.jsで言うnpmのような位置付け）
- Emacs
1, 2に関しては公式のDockerイメージが提供されているので、DockerfileでFROM clojure:lein-2.8.1-alpineのようにするだけです。
3のEmacsの設定については下記を参考…というよりClojure部分についてはほぼそのままです。
そんなわけなので、正直余り書くこともなかったりします…。
Dockerfile
Dockerfileの記述ですが、上記の通りClojure (Leiningen) の設定については公式リポジトリからFROMするだけですし、Emacsについてもapkの標準リポジトリからとってくるだけで新しいもの（現在はバージョン25.3.1でした）がとれますし、特筆すべき点がないです…。
FROM clojure:lein-2.8.1-alpine
RUN apk update --no-cache
RUN apk add --no-cache emacs git
# --- install wget with certificate --- #
RUN apk add --no-cache ca-certificates wget openssh && \
update-ca-certificates
# --- user settings --- #
ARG emacs_home=/root/.emacs.d
ARG site_lisp=${emacs_home}/site-lisp
ARG dev_dir=/root/work
RUN mkdir ${emacs_home} && \
mkdir ${site_lisp} && \
mkdir ${dev_dir}
# --- run emacs for installing packages --- #
COPY init.el ${emacs_home}
RUN emacs --batch --load ${emacs_home}/init.el
# --- miscs --- #
WORKDIR /root
Emacsの設定
設定自体について
前述のようにClojure部分の設定については、ほぼ「新: Emacs を使うモダンな Clojure 開発環境 - Qiita」のままです。最低限使いそうなところだけピックアップして言った感じなので、差異や不足のある部分には大して意味はありません。意図的に変えたのは下記程度です（細かい話ですが…）。
company-mode（auto-completeの代替）のキーバインド- 個人的には
M-p,M-nでの候補選択に慣れているので、C-p,C-nへの割り当てはしていません - 個人的には
C-iはデフォルトの用途で頻繁に利用するので、候補の強制呼び出しのキーバインドは代わりにC-c C-iとしました
- 個人的には
RainbowDelimiters- 記事中にも「そこまでの効果はない」とありますが、実際昔使ってみたときに嬉しさを感じられなかったので外しました
全体は少し長いので現時点の設定へのリンクだけ貼っておきます。88行目の;; ----- Clojure ----- ;;というコメント以降（"auto settings"以降を除く）がClojure関連の設定になります。
https://github.com/eshamster/docker-clj-devel/blob/a3addf8c5dd58d1f2b6fbbd08a75b54aad4a9071/init.el
言語別環境の量産に向けた簡単な考察
さて、Common Lisp用環境を作るときは余り意識していませんでしたが、今回init.elの中で、共通設定*1とClojureの設定を分離しています（前述のように88行目前後が分かれ目）。もう少し踏み込んで、言語別のDocker環境（用のEmacs設定）を管理するためには下記のようにするのが良さそうだというのが今の考えです（実際やってみると変わりそうですが）。
- Emacs設定ファイル側
- 共通設定と言語別設定を別ファイルに分ける
- これらのロードには
init-loader（るびきちさんの紹介記事リンク）を利用するinit.el自体を触ることなく、特定の場所に（特定の形式で）追加の設定ファイルを置くだけで読み込み対象を変えられる、というのはDockerfileの記述と相性が良さそうです
- これらはDockerfile用リポジトリとは独立したリポジトリ上で管理する
- 複数言語を同時に利用するような環境が欲しくなった場合のことを考えると、共通設定だけでなく言語別設定もまとめて管理した方が良さそうです
- Dockerfile周辺側
実際に使うとき
実際に開発環境として利用する際にはもう少しローカルな設定が必要になりますが、これこそ以前書いたCommon Lisp用環境記事の同名の章と変わらないので、ポイントのコピペとファイルの貼り付けだけで終わりにします*2。
- ポイント
Dockerfile: ※横に利用するSSH鍵を置いておくこと
FROM eshamster/clj-devel:latest
# --- git settings --- #
RUN git config --global user.name "eshamster" && \
git config --global user.email "hamgoostar@gmail.com"
# --- ssh settings --- #
ARG user=root
ARG SSH_HOME=/root/.ssh
RUN mkdir ${SSH_HOME} && \
chmod 700 ${SSH_HOME}
USER root
COPY id_rsa ${SSH_HOME}
COPY id_rsa.pub ${SSH_HOME}
RUN chown ${user}:${user} ${SSH_HOME}/* && \
chmod 600 ${SSH_HOME}/*
# --- --- #
USER ${user}
RUN echo "export LANG=ja_JP.UTF-8" >> ${HOME}/.bashrc
RUN apk add --no-cache openssl-dev
setenv
export HOST_PORT=17381 export GUEST_PORT=18616 export RUN_NAME=clj export VOLUME=${HOME}/work/clojure
run.sh
#!/bin/bash set -eu . "${1:-$(dirname ${0})/setenv}" docker rmi $(docker images | awk '/^<none>/ { print $3 }') || echo "ignore rmi error" docker rm `docker ps -a -q` || echo "ignore rm error" name="clj_web_devel" docker build -t ${name} . docker run --name=${RUN_NAME} -p ${HOST_PORT}:${GUEST_PORT} \ -e "OPEN_PORT=${GUEST_PORT}" \ -e "HOST_PORT=${HOST_PORT}" \ -v ${VOLUME}:/root/work \ -it ${name} /bin/sh
*1:Common Lisp環境のものと実質は同じですが、use-packageを使ってリファクタリングしました
*2:これはこれでリポジトリ起こして管理した方が良いのだろうとは思っています。ただ、今回のように「（DBなしの）Web開発用の最低限の設定」程度であれば共通化できるのですが、例えば、PostgreSQLを使う環境用、Redisを使う環境用…と個別のアプリ向け設定が必要になってきたときにどう管理すべきか考えられてないので足踏みしてます
Common Lisp開発環境 on Dockerの現状
目次
前書き
あけましておめでとうございます。昨年は5件しか投稿していませんでしたが、今年はもっと増やす所存であります。
Clojureの開発環境をDocker上に作ったので記事にしようかと思い、1年以上前に書いたCommon Lisp + Emacs環境 on Dockerな記事を見直していたのですが、現状と合わないままになっていることに気付きました。そのままにして新しい環境について書くのも寝覚めが悪いので、アップデート状況を簡単に書きます。
何がどう変わったか
最初にDocker上での開発環境を作った時のものが上記の記事でした。ここではCentOS7ベースで作っていました。cl-devel (DockerHub)としてDockerHubにも上げています。
次に、上記の記事ではCommon Lispの実行環境（not 開発環境）をAlpine Linux*1ベースで作成しました。こちらはcl-baseと名付けています。
この記事で、開発環境もこの上に作り直したい…ということを言っていたのですが、現状はその通りになっています。つまり、Alpine + Common Lisp (with Roswell) + Emacs on Dockerな環境になっています。ただ、当時DockerHubに慣れていなかったばかりに、上述のcl-develはGitHubとの連動ができていなかったので、下記のようにcl-devel2として新しく作っています（作成後の連携は無理そうでした）。分かりにくくなるのでよろしくないのですが、念のため元の方も残しておこうかと…。
主には以上です。以下細部ですが、以前書いたものとそれほど変更はないです。
Dockerfile
Dockerファイルをべったり貼り付けておきます。入れているものなどはCentOSベースの時と変わっていません。詳細は非Dockerな開発環境を作った「 Common Lisp開発環境を新規に作ったのでメモ - eshamster’s diary （非Docker）」で書いていたものと大体同じです。
細かな部分で目立った違いとして、apkの標準リポジトリは割と新しいEmacsが入っているので、自力でEmacsをビルドする必要がなくなった点は結構助かりました。あとは、（ソース中にもコメントしてますが）Slime 2.20がうまく動かせそうになかったため、Slime 2.19を明示的に入れていますね…。どういう環境で起きるものなのかなど、きちんと調査できてないです。
init.elは余り変わっていないので省略します。Clojure環境を作るときにいくらか整理（リファクタリング）したので、そのうち反映する…つもりです。
FROM eshamster/cl-base:2.3
RUN apk update --no-cache
RUN apk add --no-cache emacs git w3m
# --- install wget with certificate --- #
RUN apk add --no-cache ca-certificates wget openssh && \
update-ca-certificates
# --- make work directory --- #
ARG work_dir=/tmp/work
RUN mkdir ${work_dir}
# --- user settings --- #
ARG emacs_home=/root/.emacs.d
ARG site_lisp=${emacs_home}/site-lisp
ARG emacs_docs=${emacs_home}/docs
ARG dev_dir=/root/work
RUN mkdir ${emacs_home} && \
mkdir ${site_lisp} && \
mkdir ${emacs_docs}
RUN ln -s ${HOME}/.roswell/local-projects ${dev_dir}
# --- install HyperSpec --- #
ARG hyperspec=HyperSpec-7-0
RUN cd ${work_dir} && \
wget -O - ftp://ftp.lispworks.com/pub/software_tools/reference/${hyperspec}.tar.gz | tar zxf - && \
mv HyperSpec ${emacs_docs}
# --- install slime-repl-color --- #
RUN cd ${site_lisp} && \
wget https://raw.githubusercontent.com/deadtrickster/slime-repl-ansi-color/master/slime-repl-ansi-color.el
# --- run emacs for installing packages --- #
# In slime 2.20, slime-restart-inferior-lisp fails when using ccl-bin.
# If changing lexical-binding in slime.el to nil, it could be solved.
# But in the settings, it fails when using sbcl-bin...
# So I decided to downgrade slime to 2.19
RUN cd ${emacs_home}/site-lisp && \
wget -O - https://github.com/slime/slime/archive/v2.19.tar.gz | tar zxf - && \
wget -O - https://github.com/purcell/ac-slime/archive/0.8.tar.gz | tar zxf -
COPY init.el ${emacs_home}
RUN emacs --batch --load ${emacs_home}/init.el
# --- miscs --- #
WORKDIR /root
実際に使うとき
「 Common Lisp開発環境 on Docker - eshamster’s diary 」の同名の章からあまり変わっていないです。ポイントは下記でした。
- gitの設定やSSH鍵のコピーなどパーソナルな設定をするためのDockerfileを作る
- ポートやボリュームの設定をした設定ファイルを作る（
setenv） - 上記を利用して起動するためのスクリプトを作る（
run.sh）./run.shでコンテナをビルド・起動した後は、コンテナ内の/root/work/lispフォルダで作業します
以下、変更点だけコメントして貼り付けていきます。
Dockerfile: ベースイメージを変更した点と、よく使うものをros installしておくようにした点が主な変更です。build前に、利用するSSH鍵を横に置いてください（こちらは変更点ではないですが、念のため）。
FROM eshamster/cl-devel2:3.5B
# --- git settings --- #
RUN git config --global user.name "<ユーザ名>" && \
git config --global user.email "<メールアドレス>"
# --- ssh settings --- #
ARG user=root
ARG SSH_HOME=/root/.ssh
RUN mkdir ${SSH_HOME} && \
chmod 700 ${SSH_HOME}
USER root
COPY id_rsa ${SSH_HOME}
COPY id_rsa.pub ${SSH_HOME}
RUN chown ${user}:${user} ${SSH_HOME}/* && \
chmod 600 ${SSH_HOME}/*
# --- --- #
USER ${user}
RUN ros install prove && \
ros install qlot && \
ros install ccl-bin && \
ros use ccl-bin
RUN echo "export PATH=${HOME}/.roswell/bin:${PATH}" >> ${HOME}/.bashrc
RUN echo "export LANG=ja_JP.UTF-8" >> ${HOME}/.bashrc
RUN apk add --no-cache openssl-dev
setenv: VOLUMEの設定をこちらに持ってきました
export HOST_PORT=17380
export GUEST_PORT=18616
export RUN_NAME=cl
export VOLUME=${HOME}/work/lisp
run.sh: 特に変更なし。横に一時環境を起こしたいときは、設定ファイルをもう一つ作って第一引数でそちらを指定すればよいです。
#!/bin/bash
set -eu
. "${1:-$(dirname ${0})/setenv}"
docker rmi $(docker images | awk '/^<none>/ { print $3 }') || echo "ignore rmi error"
docker rm `docker ps -a -q` || echo "ignore rm error"
docker build -t cl .
docker run --name=${RUN_NAME} -p ${HOST_PORT}:${GUEST_PORT} -e "OPEN_PORT=${GUEST_PORT}" -e "HOST_PORT=${HOST_PORT}" -v ${VOLUME}:/root/work/lisp -it cl /bin/sh
以上です。やはり簡単に環境作り直せるのはいいですね。なんだかんだでアップデートの時は何かと引っかかってそれなりに苦労しますが…。
Parenscript上でシンボルのインポートやエクスポートを模倣する
前書き
Lisp Advent Calendar 2017の20日目の記事です。
Common LispのサブセットコードをJavaScriptに変換するParenscriptというライブラリの上でそれらしい名前空間を導入してみた記事です。考え方や実装の整理・メモという意味合いが強いので、果たしてこれを読んで何かの役に立つのかは疑問ですが、Common Lispのパッケージ・シンボルシステムを利用したメタプログラミングについて考える一つの題材になる…かもしれません。
今回の話の発端ですが、まずParenscriptで不便に思ったところを適当に拡張した自作ライブラリps-experimentというものを作っています（quicklispリポジトリ未登録）。
かれこれ2年ほどいじっていて、割合この上で快適にプログラムを書けるようになってきたのですが、ふと名前の衝突を気にしながら書いていることに気付きました。というのも、グローバル変数や関数の定義をパッケージでグループ化するという程度の簡易パッケージシステムは導入していたものの、名前空間の分割までは行っていなかったためです。そこで、Common Lispのパッケージ・シンボルが持つ情報やJavaScriptのクロージャを使えば案外簡単にJavaScript上でシンボルのインポートやエクスポートを模倣できるのではないか、と思って試したところ意外と苦労したというような話です。
誤解のないように強調しておくと、今回の話はParenscript上に独自のパッケージ管理構文を作りこむような話ではなく、あくまで既存のCommon Lispのパッケージ・シンボルの情報を利用することで名前空間が分離されたJavaScriptコードを吐き出すという話です。
なお、該当のコミットは"cef5d6: Change to split namespace by package"になります（コミットログが割と本記事の要約）。
前提知識
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);"
参考：Parenscriptの持つ名前空間システム
参考程度の話ですが、Parenscript自身も名前空間システムを持っています。ps:ps-package-prefixというマクロを利用して、パッケージとそれに対応するプレフィックスを登録しておくというものです。すると、登録されたパッケージ下のシンボルをJavaScriptコードとして出力する際に、プレフィックスが付与されます。
実際のところ、これに素直に乗っかれば今回引っかかったような各種問題は発生しないはずです。が、下記の通り、該当するあらゆるシンボルにプレフィックスがついてしまうため余り見た目が良くない*1ですし、また曲がりなりにもJavaScriptにも名前空間を分ける仕組み（クロージャ）はあるにも関わらずそれを使っていない…という辺りが悶々とします。
CL-USER> (defpackage test-pack (:use :cl :parenscript)) #<Package "TEST-PACK"> CL-USER> (in-package :test-pack) #<Package "TEST-PACK"> TEST-PACK> (setf (ps-package-prefix "TEST-PACK") "some_prefix_") "some_prefix_" TEST-PACK> (ps (defvar x 100) (defun test (y) (let ((temp (+ x y))) (+ temp 100)))) "var some_prefix_x = 100; function some_prefix_test(some_prefix_y) { var some_prefix_temp = some_prefix_x + some_prefix_y; return some_prefix_temp + 100; };"
ps-experimentにおける従来のパッケージの扱い
もともとps-experimentでもパッケージの情報を少し使っていたのですが、せいぜいシンボルのグループ化と、package-use-listを利用した依存性解決程度でした。
簡単なRoswellスクリプトで利用イメージを書くと下のような感じです。defvar.psやdefun.psはパッケージ配下にJavaScript用の定義をひもづけるためにps-experimentで定義しているマクロです（なお、defvar.ps+やdefun.ps+とするとCommon Lisp用のコードも同時に出力されます）。最後にwith-use-ps-packマクロを利用して指定されたパッケージ（とそこから再帰的にuseされるパッケージ）配下のJavaScriptの定義を吐き出します。
#!/bin/sh #|-*- mode:lisp -*-|# #| exec ros -Q -- $0 "$@" |# (ql:quickload :ps-experiment) (defpackage pack-a (:use :cl :ps-experiment)) (defpackage pack-b (:use :cl :ps-experiment)) ;; ----- Package A ----- ;; (in-package :pack-a) (defvar.ps *num* 0) (defun.ps inc-num (x) (incf *num* x)) (defun.ps add (x y) (+ x y)) ;; ----- Package B ----- ;; (in-package :pack-b) ;; *num* in pack-a is not guarded (defun.ps dec-num (x) (incf *num* x)) ;; :this = :pack-b (defun main (&rest argv) (declare (ignorable argv)) (print (with-use-ps-pack (:pack-a :this) (inc-num (dec-num 10)))))
結果は下記の通りです。見ての通り、名前空間の情報は失われてフラットに関数を並べているだけです。
var NUM = 0; function incNum(x) { return NUM += x; }; function add(x, y) { return x + y; }; function decNum(x) { return NUM -= x; }; incNum(decNum(10));
大まかなアイディアについて
まずは、実装を抜きにして順次アイディアを検討していきます。実装はその後まとめて見ていきます。
※用語について：JavaScriptコードになった時点で「パッケージ」や「シンボル」は存在しないため、JavaScript側の説明では「Common Lispコードにおいてはパッケージ（シンボル）であったもの」などと呼ぶのが正確ですが、冗長なので特に区別せずに「パッケージ」、「シンボル」と呼びます（微妙に違和感はありますが、たぶん混乱はないだろう…）
基本的なアイディア
最初の方向性として、まずは下記を満たすことを考えます。
- パッケージ間での名前空間の分離
- シンボルのインポートの模倣
- インポートした別パッケージのシンボルを、プレフィックスなしに参照できる
- シンボルのエクスポートの模倣
- 自パッケージのエクスポートしたシンボルを、他パッケージから（プレフィックスつきで）参照できる
例えば、下記のパッケージ2つの単純なケースを考えます。
;; --- パッケージA --- ;; (in-package :cl-user) (defpackage :temp.pack-a (:use :cl :ps-experiment) (:export :ex-a1 :ex-a2)) (in-package :temp.pack-a) (defun.ps+ internal-fn (x) x) (defun.ps+ ex-a1 () (internal-fn 100)) (defun.ps+ ex-a2 () (internal-fn 200)) ;; --- パッケージB --- ;; (defpackage :temp.pack-b (:use :cl :ps-experiment) (:import-from :temp.pack-a :ex-a1) (:export :ex-b)) (in-package :temp.pack-b) (defun.ps+ internal-fn (x) (* x 2)) (defun.ps+ ex-b () (+ (ex-a1) (internal-fn 200)))
パッケージBに注目すると、パッケージAでエクスポートされたシンボルex-a1をインポートして利用しており、かつ、internal-fnというパッケージAにも（internalに）存在する名称の関数を定義しています。これを次のようにJavaScriptに変換すれば良さそうです。
/* --- パッケージA --- */ var temp_packA = (function() { /* (1) */ /* --- define objects --- */ function testA2() { return internalFn(200); }; function internalFn(x) { return x; }; function exA1() { return internalFn(100); }; function exA2() { return internalFn(200); }; /* --- extern symbols --- */ /* (2) */ return { 'exA1': exA1, 'exA2': exA2, }; })(); /* --- パッケージB --- */ var temp_packB = (function() { /* --- import symbols --- */ /* (3) */ var exA1 = temp_packA.exA1; /* --- define objects --- */ function internalFn(x) { return x * 2; }; function exB() { return exA1() + internalFn(200); }; /* --- extern symbols --- */ return { 'exB': exB, }; })();
- (1) 名前空間の分離を行うため、各パッケージ内の定義をクロージャで囲います。これで、例えば両パッケージに存在する
internalFn（internal-fn）の名前空間が分離されます - (2) シンボルのエクスポートを模倣するため、シンボルと同名の文字列をキー、シンボル自身を値としたハッシュを返します。これによって、例えば
temp_packAパッケージ内のexA1にはtemp_packA.exA1として外部からアクセスできるようになります。 - (3) シンボルのインポートを模倣するため、クロージャの冒頭で同名のローカル変数に外部パッケージでエクスポートされた変数を入れておきます。これで、パッケージB内からはプレフィックスなしに
temp.pack-a:exA1にアクセスできるようになります。
ここまでは（実装的にも）順調です。
インポートしていないシンボルの参照
上記はエクスポートしたシンボルをインポートして参照するだけのお行儀の良い例でした。しかし、周知の通りCommon Lispにおいては<パッケージ名>:<シンボル名>としてインポートしなくても（エクスポートされた）シンボルを参照できますし、<パッケージ名>::<シンボル名>とすればインターナルなシンボルに触ることもできます。特にここまでのアイディアでは後者を実現する手段がないため、対処が必要です。
インターナルなシンボルに触るコードを直接書くケースは余りないと思いますが、他パッケージのマクロを利用する場合、自パッケージでインポートしていないシンボルが展開されるということが普通に起こり得ます。
(defpackage :temp.pack-a (:use :cl) (:export :ex-macro)) (in-package :temp.pack-a) (defun internal-fn (x) x) (defmacro ex-macro (x) `(internal-fn ,x)) (defpackage :temp.pack-b (:use :cl) (:import-from :temp.pack-a :ex-macro)) (in-package :temp.pack-b) (defun internal-fn (y) (+ y 20)) (print (macroexpand-1 '(ex-macro (internal-fn 200)))) ;; -> (TEMP.PACK-A::INTERNAL-FN (INTERNAL-FN 200))
表面上パッケージBはインポートしたマクロex-macroを利用しているだけですが、実際にはマクロ展開時にインポートしていないシンボルtemp.pack-a::internal-fnがパッケージB上に展開されてしまいます。もちろん、Common Lispではprint結果のように、適切にパッケージが考慮されていることが分かります。
Parenscript上で同様のことを実現するためには次の2つの要素が足りません。
- 未エクスポートのシンボルを外から触れるようにする
- 未インポートのシンボルを識別して↑のシンボルを触るようなJavaScriptコードを出力する
イメージとしては次のようになります。まずはParenscript側のコード。
(in-package :cl-user) (defpackage :temp.pack-a (:use :cl :ps-experiment) (:export :ex-macro :ex-fn)) (in-package :temp.pack-a) (defun.ps+ internal-fn (x) x) (defun.ps+ ex-fn (x) x) (defmacro.ps+ ex-macro (x) `(internal-fn ,x)) (in-package :cl-user) (defpackage :temp.pack-b (:use :cl :ps-experiment) (:import-from :temp.pack-a :ex-macro)) (in-package :temp.pack-b) (defun.ps+ internal-fn (y) (+ y 20)) (defun.ps+ hoge () (ex-macro (internal-fn 200))) (print (with-use-ps-pack (:temp.pack-a :temp.pack-b)))
これが下記のようにJavaScriptに変換されれば良さそうです。
var temp_packA = (function() { /* --- define objects --- */ function internalFn(x) { return x; }; function exFn(x) { return x; }; /* --- extern symbols --- */ return { 'exFn': exFn, /* ★internalなシンボルを触れるようにする */ '_internal': { 'internalFn': internalFn, } }; })(); var temp_packB = (function() { /* --- define objects --- */ function internalFn(y) { return y + 20; }; function hoge() { /* ★外部のシンボルを識別してprefixをつける */ return temp_packA._internal.internalFn(internalFn(200)); }; /* --- extern symbols --- */ return { '_internal': { 'internalFn': internalFn, 'hoge': hoge, } }; })();
後ろで見るように、実装する上で、一通りのシンボルをエクスポートする部分は何ということはないのですが、未インポートシンボルの識別ではダーティな対処が必要になっています…。
（今のところ）最後の関門：Type Specifier
唐突ですが、よく知られているように、Common Lispにおいて変数と関数の名前空間は分離されています（Lisp-2）。また、それ以外に型（Type Specifier）の名前空間も分離されています。
;; ※Clozure CLで実行（各 def... の出力は省略） CL-USER> (defparameter x 100) CL-USER> (defun x ()) CL-USER> (defstruct x) CL-USER> (describe 'x) X Type: SYMBOL Class: #<BUILT-IN-CLASS SYMBOL> ;; --- 変数であり、関数であり、Type Specifierでもある --- Special Variable, Function, Type Specifier, Class Name INTERNAL in package: #<Package "COMMON-LISP-USER"> Print name: "X" Value: 100 Function: #<Compiled-function X #x30200190257F> Arglist: NIL Plist: NIL Class: #<STRUCTURE-CLASS X> ; No value
Common Lispにおいては下記のようにして使い分けられます。
x ; 変数としてのアクセス (x) ; 関数としてのアクセス ;; Type specifierとしてのアクセス（の一例） (let ((xx 'x)) (typep (make-x) xx)) ;; ※直接'xを書くこともできる
これらをParenscriptにかけると下記のようになります（ただし、Parenscriptでtypepは実装されていないため、ps-experiment側で（Parensript用マクロとして）補ったものです）。なお、JavaScript上では変数と関数の名前空間が分離されていないため、同時にはどれか一つしか成立しません。が、これは目をつむることにします*2。
x; /* 変数としてのアクセス */ x(); /* 関数としてのアクセス */ /* Type specifierとしてのアクセス */ (function () { var xx = 'x'; return (makeX() instanceof (typeof xx === 'string' ? eval(xx) : xx)); })();
さて、typepが変換されたものを見てみると非常に怪しげなものがあります。そう、evalです。なぜこんなものが必要になるのか…。Common Lispにおいて、プログラマが直接Type Specifierを指定する手段はシンボルの利用になります。一方で、Parenscriptを通すとシンボルはただの文字列に変換されます。しかし、JavaScriptの文字列は型を指示するものではありません。このため、evalによって型の情報にひもづけられた変数を取り出すことが必要になります。
これがどのように問題になるのかを次の例で考えてみます*3。
;; defpackage 省略 (in-package :pack-a) (defvar.ps+ *some-symbol-list* nil) (defun.ps+ find-typed-symbol (type-specifier) (find (lambda (sym) (typep sym type-specifier)) *some-symbol-list*)) (in-package :pack-b) (defstruct.ps+ test-st-b) (push (make-test-st-b) pack-a::*some-symbol-list*) (pack-a::find-typed-symbol 'test-st-b)
pack-a::find-typed-symbol内のtypepがポイントです。Common Lispとしては特に問題のないコードです。pack-bから'test-st-bというシンボルが渡ってきますが、シンボル自身がパッケージの情報を持っているため、問題なくpack-b::test-st-bにたどり着けます。一方、ここまで説明した形でJavaScriptに変換すると、'test-st-bシンボルは'test-st-b'という文字列に変換され、パッケージの情報が失われます。find-typed-symbolはこれを受け取るわけですが、pack-a名前空間にはtest-st-bなどというものは定義されていませんので、eval(type-specifier) すなわち eval('test-st-b')はエラーとなります。
なお、名前空間の分離をしていなかった世界では、test-st-bはグローバルに見えていたためこの問題は生じませんでした。また、Parenscriptの名前空間機能を素直に使った場合、'test-st-b'にはprefixがつけられてグローバルに見える名前になるため、やはりこの問題は生じません。
さて、この対処の方針は次のようになります。こうすると、上記の例で言えばfind-typed-symbolには型の実体が渡されるようになるため、evalが不要になります。
- Type Specifierが定義されるときにそのシンボルを記録する
- 幸いType Specifierが定義されるタイミングは限られています。まあ、現行のParenscript + ps-experimentでサポートしているのはdefstructだけですね…
- JavaScriptへの変換時に、Type Specifierを見つけたら問答無用でquoteを剥ぎ取る
- 例.
'test-st-b→(quoteをとる)→test-st-b→(JavaScriptへ変換)→testStB（文字列ではなく変数として出力される）
- 例.
これは、今までは変数＋関数の名前空間からなんとなく遊離していたType Specifierを明確に同一の名前空間に引き込む行為と解釈できそうです。解決方法として場当たり的すぎないか悩ましかったのですが、そう考えればそれなりに理のある対処ではなかろうかと思います。…結果だけ書くと割とシンプルなのですが、これを解決することに正当性があるのか（≒根本的に何が問題なのか）、実装の方針をどうすべきなのかという部分が非常に悩ましく、あやうく本稿のタイトルが「～模倣しようとしてうまくいかなかった話」になりかけた程のものではありました。
実装について
ここから先、上記で述べたアイディアの実装の話ですが、必要と思われる部分をかいつまんで説明していきます。小さな落とし穴が色々あることや、Parenscriptの関数を上書き（ps-experiment側で同じ関数を再定義）するなどというダーティな実装をしていることに目をつむれば、Common Lispのシンボルが持つ情報を利用することでベースは非常にシンプルに作れることが分かると思います。
なお、実装はおおむねps-experiment/src/package.lisp配下で行っています。また、該当のコミットは"cef5d6: Change to split namespace by package"になります（再掲）。
前置き：ps-experimentにおけるこれまでのパッケージ管理
※今回の変更の前に色々いじったので実は以下の説明と完全に一致するコミットは存在しなかったりします…。後ろの話につなげるための細部は架空な実装です。
まずは、単なるグループ化のためだけにパッケージを利用していた頃のパッケージ管理方法の概要について述べます。ポイントとなるのは、with-use-ps-packで出力するためのシンボルを独自に管理しておくという点です*4。この部分はこの後も同じです。
(defparameter *ps-func-store* (make-hash-table))
管理主体はこの*ps-func-store*です。これはパッケージをキーとしたハッシュになっており、値は次のような構造体のリストです。
(defstruct ps-func name-keyword ; シンボルを同名のキーワードにしたもの (func (lambda () ""))) ; これをfuncallするとJavaScriptコード（文字列）が返される
- 細かい話
name-keywordでキーワードでなく、シンボル自身を登録しておけば、（シンボル自身がパッケージの情報を持っているので）キーとしてのパッケージは不要です。が、今回はあった方が扱いやすそうですps-funcでいうname-keywordを2段目のキー、funcをその値とするような2重ハッシュとしないのは、できるだけ元の定義順を保存しておきたいためです*5
実装は省略しますが、defun.psなどはロード時に*ps-func-store*への登録を行います。このため、
(in-package :test-pack) (defun.ps test-fn (x) x)
としておくと、下記のようにしてtest-fnをJavaScript関数として書き出せます。
;; *ps-func-store*のパッケージプレフィックス略 (funcall (ps-func-func (find (lambda (ps-func) (eq (ps-func-name-keyword ps-func) :test-fn)) (gethash (find-package "TEST-PACK") *ps-func-store*)))) ;; --- 以下出力 --- ;; "function testFn(x) { return x; };"
例えば他にも、TEST-PACKパッケージ配下のものをすべて出力したければ下記のようにすればよいことになります。
(dolist (ps-func (gethash (find-package "TEST-PACK") *ps-func-store*)) (print (funcall (ps-func-func ps-func))))
基本的なインポート・エクスポート
まずは、基本的なインポート・エクスポート部分の実装です。「基本的アイディア」節の内容に加え、「インポートしていないシンボルの参照」節で述べたうちの「未エクスポートのシンボルを外から触れるようにする」まではまとめてやってしまいます。
基礎知識：シンボルからの情報取り出し
以降で主に利用するものは、シンボルの持つパッケージについての情報と「状態」についての情報の2つだけです。
パッケージの情報の取り出しは単にsymbol-package関数を利用するだけです（※以降、REPLの出力は適宜省略します）。
CL-USER> (defvar some-var 100) CL-USER> (symbol-package 'some-var) #<PACKAGE "COMMON-LISP-USER">
この情報は、あるパッケージから見えているシンボルが、自パッケージで定義したものか他パッケージからインポートしてきたものかを識別するのに使います。
CL-USER> (defpackage test-pack (:use :cl) (:export :aaa)) CL-USER> (defvar test-pack:aaa 100) CL-USER> (import 'test-pack:aaa) CL-USER> (symbol-package 'aaa) #<PACKAGE "TEST-PACK"> ; ← CL-USERパッケージの外から来たことが分かる
次に、シンボルの「状態」ですが、こちらはfind-symbol関数で簡単に取り出せます。
CL-USER> (defvar var-a 100) CL-USER> (defvar var-b 100) CL-USER> (export 'var-b) CL-USER> (find-symbol "VAR-A") VAR-A :INTERNAL ; ← これ CL-USER> (find-symbol "VAR-B") VAR-B :EXTERNAL ; ← これも
エクスポートしていない'var-aの状態は:internalで、エクスポートしている'var-bの状態は:externalとなっています。これを利用して、エクスポートされているシンボルなのかを判別します。なお、他パッケージからインポートしたシンボルも:internalとして扱われるため、「状態」を見てシンボルが自パッケージのものかを判別することはできません。このため、その判別はsymbol-packageを利用して行います（useしたものは、もう1つの状態である:inheritedとなるため判別はつくのですが、あえて:internalと分けて考える意味もないので、ここでは:externalか否かだけに注目します）。
インポート・エクスポートの実装
前置きが長かったですが、「基本的なアイディア」節で目標としていた次のものを実装していきます。
- パッケージ間での名前空間の分離
- シンボルのインポートの模倣
- シンボルのエクスポートの模倣
ついでに、「インポートしていないシンボルの参照」節で述べたうちの下記も実現しておきます。
- 未エクスポートのシンボルを外から触れるようにする
さて肝心の実装ですが、ここまでのsymbol-package, find-symbol、あるパッケージ内の全シンボルでループするdo-symbolsマクロさえ知っていればあとは簡単です。そのため、以降はコードを並べて中に必要なコメントを追記して流していきます。
まずは、インポート部分の実装です。今後もformatが（特にスペースの数や改行が決め打ちだったりで）汚いのですが読み流してください。
#| Create string like the following (The sort order is not stable): var symA = packageA.symA; var symB = packageA.symB; var symC = packageB.symC; |# (defun make-imported-js-symbols (pack) (let ((imported-lst nil)) ;; インポート対象シンボルの抽出 (do-symbols (sym pack) (let* ((target-pack (symbol-package sym)) ;; find-ps-funcは*ps-func-store*を探索する関数 (ps-func (find-ps-func sym target-pack))) ;; ★インポートすべきシンボルであるかの判定 ;; ;; 1. 他パッケージのシンボルか？ (when (and (not (eq target-pack pack)) ;; 2. *ps-func-store*に登録されたシンボルか？ ps-func ;; 3. （詳細略：Top LevelなFormを実現するためにps-funcに追加した情報) (ps-func-require-exporting-p ps-func)) (push sym imported-lst)))) ;; formatで頑張って文字列化（汚い） (format nil "~{~{var ~A = ~A.~A;~}~%~}" (mapcar (lambda (sym) ;; symbol-to-js-stringは読んで字のごとく。Parenscriptの持ち物 (let ((js-sym (symbol-to-js-string (make-keyword sym)))) (list js-sym ;; package-to...も読んでの通り。こちらはps-experiment実装 (package-to-js-string (symbol-package sym)) js-sym))) imported-lst))))
次はエクスポート部分の実装です*6。
#| Create string like the following (The sort order is not stable): return { 'externalSymA': externalSymA, 'externalSymB': externalSymB, _internal: { 'internalSymA': internalSymA, 'internalSymB': internalSymB, } }; |# (defun make-exported-js-symbols (pack) (let ((extern-lst nil) (internal-lst nil)) (flet ((keyword-to-js-string (key) (check-type key keyword) (symbol-to-js-string key))) ;; 自パッケージで定義したものが対象と分かっているので、 ;; do-symbolsを使わず*ps-func-store*から直接候補を取り出す (let ((ps-func-lst (gethash pack *ps-func-store*))) (dolist (ps-func ps-func-lst) (when (ps-func-require-exporting-p ps-func) (let ((key (ps-func-name-keyword ps-func))) ;; ★エクスポートされたシンボルかどうかのチェック ;; get-symbol-statusは内部でfind-symbolを呼んでいる (if (eq (get-symbol-status key pack) :external) (push (keyword-to-js-string key) extern-lst) (push (keyword-to-js-string key) internal-lst))))))) ;; 出力 ※(defvar *internal-symbol-prefix* "_internal") (format nil "return { ~{ '~A': ~:*~A,~%~} '~A': { ~{ '~A': ~:*~A,~%~} } };" extern-lst *internal-symbol-prefix* internal-lst)))
後は、これらと定義本体を合わせて出力すれば、1パッケージの完成です。仕上げ部分なので実装を載せますが、うわ汚い、と思ってスクロールするのが吉です。
(defun make-packaged-js (pack) (let ((ps-funcs (gethash pack *ps-func-store*))) (unless ps-funcs (return-from make-packaged-js nil)) (let ((js-pack-name (package-to-js-string pack)) ;; 定義本体。ここだけを出力すると、名前空間がなかった時の出力と同じになる (js-body (format nil "~{~A~%~}" (mapcar (lambda (ps-func) (funcall (ps-func-func ps-func))) (reverse ps-funcs))))) ;; ★(function() { ... })();とクロージャで囲うことで名前空間を分離している (format nil "var ~A = (function() {~%~{~A~%~}})();~%" js-pack-name (mapcar (lambda (str) (ppcre:regex-replace "\\s*$" (ppcre:regex-replace-all (ppcre:create-scanner "^" :multi-line-mode t) str " ") "")) (list "/* --- import symbols --- */" (make-imported-js-symbols pack) "/* --- define objects --- */" js-body "/* --- extern symbols --- */" (make-exported-js-symbols pack)))))))
メイン関数の実装
名前空間が分かれたことで、実はもう一ヶ所考慮が必要な場所があります。
with-use-ps-packは第一引数としてパッケージ名（キーワード）のリストをとり、body部にメインの処理を書くことができます。
(in-package :test-pack) (defvar.ps some-var 100) (with-use-ps-pack (:this) ; :this == :test-pack (alert some-var))
名前空間の分かれていなかった今までは、単にこのbody部をJavaScriptコードに変換してベタに置いておくだけで良かったです。しかし、名前空間の分かれた今、with-use-ps-packの呼ばれたパッケージの名前空間に明示的に置いてあげる必要があります。そうしないと、上の例では(alert some-var)においてsome-varへアクセスすることができません。
そこで、同パッケージ内に一時的にメイン関数相当の__psMainFunc__という関数を作ることにします。
(defmacro with-use-ps-pack (pack-sym-lst &body body) (with-gensyms (pack-lst) `(let* ((,pack-lst ... ;; 略：依存性解決をしてパッケージのリストを作る処理 )) ;; グローバル環境を汚さないように*ps-func-store*のコピーを作成 (*ps-func-store* (copy-ps-func-store))) ;; __psMainFunc__ を定義する ;; ※defun.psは同名・同引数で内部は空のCL関数を同時に定義してしまうので、defun.ps-onlyを利用 (defun.ps-only ,(intern "__PS-MAIN-FUNC__" *package*) () ,@body) (import-ps-funcs (make-package-list-with-depend ,pack-lst) ;; 末尾で__psMainFunc__を呼び出す (format nil "~A.~A.__psMainFunc__();" (package-to-js-string ,*package*) *internal-symbol-prefix*)))))
例えば、空の状態でwith-use-ps-packを呼び出すと次のようになります。
(in-package :pack-a) (with-use-ps-pack (:this))
var packA = (function() { /* --- import symbols --- */ /* --- define objects --- */ function __psMainFunc__() { return null; }; /* --- extern symbols --- */ return { '_internal': { '__psMainFunc__': __psMainFunc__, } }; })(); packA._internal.__psMainFunc__();
未インポートなシンボルの識別とプレフィックスの付与
「インポートしていないシンボルの参照」節で述べたように、未インポートのシンボルを参照している場合には、「基本的なアイディア」に加えて下記を実装することが必要でした。1つ目については前節で一緒に実装したので、この節では2つ目の実装を考えます。
- 未エクスポートのシンボルを外から触れるようにする
- 未インポートのシンボルを識別して↑のシンボルを触るようなJavaScriptコードを出力する
これを実現するためには、シンボルをJavaScript用の文字列に変換している場所で、パッケージ情報などを利用して適切なプレフィックスをつけてあげる必要があります。このためには、Parenscriptで最終的にシンボル名の変換を司っているps:symbol-to-js-stringを再定義するしかないだろうというのが現状の結論です。利用しているライブラリの関数を上書きするなど汚い話なので避けたいのは山々なのですが…。
書き換えたものが下記になります。*original-package*は後述しますが、基本的には*package*と同じく定義場所のパッケージを格納したものです。
(defun ps:symbol-to-js-string (symbol &optional (mangle-symbol-name? t)) ;; ※let*のsymbol-nameとidentiferは元の実装のまま。残りは追加 (let* (; 明示的にPSのobfuscationを利用していない限り、単なるシンボル名 (symbol-name (symbol-name (ps::maybe-obfuscate-symbol symbol))) ;; "some-symbol" -> "someSymbol"のように変換されたシンボル名 (identifier (if mangle-symbol-name? (ps::encode-js-identifier symbol-name) symbol-name)) (package (symbol-package symbol)) (same-name-symbol (when *original-package* (find-symbol (symbol-name symbol) *original-package*)))) (if *original-package* ;; こちらが追加の実装 ;; ★プレフィックスをつけるべきかの判定（詳細本文） (if (and (not (eq *original-package* package)) ;; Check if it is imported (or (null same-name-symbol) (not (eq symbol same-name-symbol))) ;; Check if it is registered as a ps-function (find-ps-func symbol package)) (let ((*original-package* nil) (package-name (package-to-js-string package))) ;; ★適切なプレフィックスの付与 (if (eq (get-symbol-status symbol package) :external) (concatenate 'string package-name "." identifier) (concatenate 'string package-name "." *internal-symbol-prefix* "." identifier))) identifier) ;; こちらはオリジナルの実装 (aif (ps-package-prefix (symbol-package symbol)) (concatenate 'string it identifier) identifier))))
判別部分は次を見てプレフィックス（パッケージ名）をつけるべきか判定しています。
- 自パッケージのシンボルではないこと（
(not (eq *original-package* package))） - そのシンボルをインポートしていないこと（
(or ...)）- 直接に判断する方法がないので次の2つの条件を見ています
- 自パッケージから同名のシンボルが見えない（
(null same-name-symbol)）、もしくは、 - 別パッケージの同名のシンボルが見えている（
(not (eq symbol same-name-symbol))）
- 自パッケージから同名のシンボルが見えない（
- 直接に判断する方法がないので次の2つの条件を見ています
*ps-func-store*で管理しているシンボルであること（(find-ps-func symbol package)）
後回しにしていた*original-package*ですが、所望の場所では必ず*package*がCL-USERパッケージに束縛されてしまうため、代替として用意したものです*7。なぜCL-USERが束縛されているかですが、これはps:psマクロ内で呼び出される出力用関数ps::parenscript-printの中でwith-standard-io-syntaxが利用されているためです。
この*original-package*への束縛を行っているのは、defvar.psやdefun.ps等で共通して利用しているps.です。
(defvar *original-package* nil) (defmacro ps. (&body body) `(let ((*original-package* ,*package*)) (macroexpand '(ps ,@(replace-dot-in-tree body)))))
ps.は元々ドット記法をサポートするためだけに導入したps:psのラッパーでした（参考：過去記事：Parenscriptで少し遊んで見る （2）ドット記法編）が意外なところで役に立ちました。ここで、ps:psを直接呼び出さずmacroexpandを挟んでいる点も今回変更が必要になった部分です。ps:psはマクロ展開時にJavaScriptコードを生成するという少々行儀の悪い作りになっているため、このように処理を遅らせないと*original-package*の束縛前にJavaScriptコードの生成処理が走ってしまいます。なお、この変更で割と不便になった点として、今まではSLIMEのマクロ全展開ショートカット（C-c M-m）で簡単にJavaScriptコードを確認できていたのですが、それができくなったという点があります（確認用の補助関数ぐらいは用意しないと…と思いつつまだしてません）。
Type Specifierの登録とquoteの剥ぎ取り
Type Specifierをパッケージ間で取り回すには下記の実装が必要でした。どちらも方針さえ決まってしまえば実装上難しい部分はありません。
- Type Specifierが定義されるときにそのシンボルを記録する
- JavaScriptへの変換時に、Type Specifierを見つけたら問答無用でquoteを剥ぎ取る
まずはType Specifierとなるシンボルの記録です。
(defparameter *ps-type-store* (make-hash-table)) (defun ps-type-p (symbol) (gethash symbol *ps-type-store*)) (defun register-ps-type (type-specifier) (check-type type-specifier symbol) (setf (gethash type-specifier *ps-type-store*) t))
記憶する場所としては*ps-type-store*というハッシュテーブルを用意します。シンボルをキーにgethashすると、Type Specifierであればt、そうでなければnilが返るというだけのものです（ps-type-p）。Type Specifierを生み出す側（現行のps-experimentではdefsturct.ps, defsturct.ps+のみ）はロード時にregister-ps-typeが呼び出されるようにしておくだけです（コード略：defstruct.psの実装は長く良い感じに抜き出せないので…）。
次に、quoteの剥ぎ取りです。自力でコードウォークをしてquoteを正しく探し出す…というのは非常に骨なので、ダーティ覚悟でParenscriptで実装されているquoteを上書きしてしまうことにします。
(ps::define-expression-operator quote (x) (flet ((quote% (expr) (when expr `',expr))) (ps::compile-expression (typecase x (cons `(array ,@(mapcar #'quote% x))) ((or null (eql [])) '(array)) (keyword x) ;; ★変更点はこのsymbol部分だけ、elseは元の実装のまま ;; Type Specifierは文字列化せずに返す。これでquoteを剥いだことになる。 (symbol (if (ps-type-p x) x (symbol-to-js-string x))) (number x) (string x) (vector `(array ,@(loop for el across x collect (quote% el))))))))
コメントのように変更点は1ヶ所だけです。リストや配列のquoteについても、各要素のquote処理は最終的にここに辿り着くため、これだけで対応できます。
終わりに
以上で、新たな構文を一切付け足すことなく、既存のパッケージ・シンボル情報を利用することで、JavaScript側での名前空間の分離を達成することができました。実際、ps-experimentの上に実装しているEntity Component Systemもどきライブラリのcl-ps-ecsでは一切書き換えは不要でしたし、さらにその上に実装しているWeb向け2Dゲームライブラリcl-web-2d-gameではエクスポート・インポートがいい加減であった部分の修正だけで事足りました（前者は全体がCommon Lispコードとしても動かせるので整っていたのですが、後者はJavaScriptコードとしてしか動かない部分が結構あるのでそこに抜けがありました）。
今回の機能変更で吐き出されるJavaScriptコードの量が一気に増えるので、そこは少々気がかりです（特に、大きいパッケージをuseしたりすると…）。説明を省きましたが、今回useしなくともインポートさえしていれば依存パッケージとみなすような変更もし加えたので、極力インポートを使うようにして不必要なuseをしないという地道な改善は可能です。いざとなったら、インポートの模倣はあきらめて、外部パッケージのシンボルはすべてパッケージプレフィックス付きで呼ぶようにすれば、いくらかは短くなるかもしれません。
ひとまず、当面はまだ見ぬ問題に怯えながら使っていってみようと思います。
関連過去記事
- Parenscriptで遊んで見る (1) defun編 - eshamster’s diary：ps-experiment黎明期の記事です（(5)まであります）
- 「Parenscript」でググると割と上の方に来たりするのですが、気になったところをつまんでいるだけで余り役に立たないこれが上に来てしまうのはなんか申し訳ない気分になります…
- 木構造の親子関係を考慮したソート - eshamster’s diary：パッケージ間の依存性解決コードを書くため、問題を一般化して考えてみた記事
- なお、同記事内では循環参照をエラーにする方法と適当にやり過ごす方法を書きましたが、ps-experiment上では前者までを実装しています
- Three.jsなWebアプリをCommon Lispで書く話 - eshamster’s diary：昨年のAdvent Calendar記事。「終わりに」で触れたcl-ps-ecsやcl-web-2d-gameについて
- [Common Lisp] システム内のパッケージ間の関係をグラフ化 - eshamster’s diary：最初に
do-symbolsを使ったのはこの頃でした
付録：最終的な出力例
Roswellコード：
#!/bin/sh #|-*- mode:lisp -*-|# #| exec ros -Q -- $0 "$@" |# (ql:quickload :ps-experiment) (defpackage pack-a (:use :cl :ps-experiment) (:export :inc-num :negate)) (defpackage pack-b (:use :cl :ps-experiment) (:import-from :pack-a :inc-num)) ;; ----- Package A ----- ;; (in-package :pack-a) (defvar.ps *num* 0) (defun.ps inc-num (x) (incf *num* x)) (defun.ps negate (x) (* x -1)) ;; ----- Package B ----- ;; (in-package :pack-b) (defstruct.ps test-st) (defun.ps dec-num (x) (inc-num (pack-a:negate x))) ;; :this = :pack-b (defun main (&rest argv) (declare (ignorable argv)) (print (with-use-ps-pack (:this) (list 'test-st 'some-sym pack-a::*num*))))
JavaScriptコード（printの出力抜き出し）：
var packA = (function() { /* --- import symbols --- */ /* --- define objects --- */ var NUM = 0; function incNum(x) { return NUM += x; }; function negate(x) { return x * -1; }; /* --- extern symbols --- */ return { 'incNum': incNum, 'negate': negate, '_internal': { 'NUM': NUM, } }; })(); var packB = (function() { /* --- import symbols --- */ var incNum = packA.incNum; /* --- define objects --- */ function testSt() { return this; }; function makeTestSt() { var _js2 = arguments.length; for (var n1 = 0; n1 < _js2; n1 += 2) { switch (arguments[n1]) { }; }; var result = new testSt(); return result; }; function testStP(obj) { return (obj instanceof testSt); }; function decNum(x) { return incNum(packA.negate(x)); }; function __psMainFunc__() { return [testSt, 'someSym', packA._internal.NUM]; }; /* --- extern symbols --- */ return { '_internal': { 'testSt': testSt, 'makeTestSt': makeTestSt, 'testStP': testStP, 'decNum': decNum, '__psMainFunc__': __psMainFunc__, } }; })(); packB._internal.__psMainFunc__();
*1:あくまで本体はParenscript側のコードなので、JavaScript側の見た目は重要でないといえばそうなのですが…
*2:えー、と思うかもしれませんが、まずはパッケージ間の名前空間分離が目的ですので…
*3:実を言うと、(symbol-value 'x)として値を取り出すとか、(funcall (symbol-function 'x) )として関数を呼び出すような、シンボルを直接扱う操作をされると変数や関数でも同じ問題が起きます…。が、普通やらないでしょうということで制限としておきます
*4:シンボルを使ってメタなことをやろうとする場合はよくやる手段なのではないかと思います
*5:パッケージ自体の定義順序は、ここで保存しておく必要はありません。出力時に依存性を考慮して並び替えるためです
*6:細かい割りに長い話なので脚注。Common Lispではエクスポートの有無に関わらず
*7:なお、*original-package*のおかげでifのelse側に元の実装を残せたのですが、これは副産物でした
斑鳩における解放の挙動について ～C2虎鶫第二ジェネレータ～
前書き
斑鳩について少し気になることがあったので考察してみた記事です。動機としては、単なる興味が大半なので攻略の役に立つかは分かりません…。
解放の挙動が1回転多めにくるりんって回る条件なんやろ？解放のコトわかってるようでわかってないんよなあ… pic.twitter.com/sjn9Ckcmma
— シャモ (@shamo_tx) 2017年12月2日
気になったのはこのツイートです。C2の虎鶫（敵の名称、斑鳩内で最もサイズが小さい敵）第二ジェネレータで起こる解放の挙動について言及しています。頻度的にはそれほどでないので無視していましたが、確かに時々起こる挙動で、頭の隅に引っかかってはいました。せっかくこうして動画が手に入ったので少し考えてみた次第です。
解放挙動の基本
※この章は表面的に推測しただけなので間違っている可能性は大いにあります
解放の割り当て
解放の各本がどの敵に割り当たるかというところが今回一番重要な部分だと考えています。結論から言うと、距離の近い敵から特定の順で割り当たっているようです*1。
画像は動画から引き抜いたもので12本のフル解放です。説明のために左下から順に番号を振ります（9と11、10と12がほぼ重なっているので少々見分けづらいですが、よく見ると少し膨らんで見えると思います）。
まず、敵が全員解放1本で倒せる場合を考えると、最も距離の近い敵が1番の解放、次に近い敵が2番の解放…と近い敵から上の順番で解放が割り当たっていくようです。次に、倒すのに複数本必要な敵がいる場合ですが、そうした敵に対しては倒せるまで連続して割り当たるようです（5,6,7,…のように）。
全て割り当てても解放が余っている場合の挙動は分かっていないです…。余った解放に対して、上記の割り当てを再度行うのが自然そうではありますが未検証です。
追尾の挙動
追尾の基本的な挙動としては、対象のいる方向に角度を変えつつ前に進むというシンプルな形がベースのようです。このとき、最大旋回角度は固定で、角度が離れているときは速度を落とす（角度が近いときは逆に上げる）ことでいつまでも敵の周りを回り続けることを回避しているようです*2。
今回の挙動というよりは、対策を考えるうえで気に留めておく価値がありそうなのは、発射後一定時間は速度が一定もしくは加速している（上記の速度減少が起こらない）ということと、番号が上の解放ほど初速が大きいというあたりでしょうか*3。
余談ですが、上記の挙動はあくまで基本であり、カッコよさとプレイのしやすさのバランスをとるために相当色々な工夫が入っているようです。前に色々調べていたのですが半端なところで放置してしまっています…。
今回の場合
さて、ようやく今回の場合についてです。上記のように解放の割り当てが一番問題と考えています。そこで、動画を繰り返し見てどの解放がどこに飛んでいるかを見てみました。結果は上の画像の通りです。？がついていないものはほぼ間違いないだろうというもの、ついているものは若干自身がないが正しいだろうというものです*4。少なくとも偶奇（＝左右どちらから発射されたか）は正しいと思っています。
ここで重要なのは、例のくるりと解放が回ってしまった敵に9番が割り当たっていることです。9番の解放は左側では上から2番目の解放であり、初速が非常に速いです。このため、減速に時間がかかる→中々敵に照準が合わない→ぐるぐる回るということになったのではないかと推測します。
なぜ9番という高い番号が割り当たったか、別の言い方をすると、なぜ真ん中のジェネレータの方が若い番号が割り当たったのかを考えてみます。上の画像では解放箇所から広がる同心円に注目しています。これを見ると、例の虎鶫とジェネレータがほぼ同じ距離にあったことが分かります*5。見た目上は正直どちらが近いか判断がつかないですが、「近い敵ほど若い番号が割りつく」ことを考えると、ジェネレータの方がわずかに近かったようです。このため、より若い番号の解放がジェネレータに（２つも！）消費されてしまったと考えられます。
ここからは推測ですが、今回のケースは虎鶫とジェネレータの距離関係が非常に近いという稀なケースで、たいていの場合は虎鶫の方が近いのだと思います。より若い番号の解放を割り当てることだけ考えるのであれば、より左側で解放を行えばよいという結論になります。そうすると、若い番号 = 初速の遅い解放が割り当たるため、今回の現象も起きにくくはなるはずです。ただし、本当にまったく起こらないのか…というところは自身がないです。
*1:本題ではないので脚注ですが、いったん割り当たった敵が変更されることはないようです。そのため、対象の敵が先にショットで倒れたなどの場合はそのまま飛び去ります。ただ、たまに画面外から戻ってくるような挙動を見せることがあるので、疑問は残ります
*2:最大旋回角の方が変わっている可能性もあるのですが、どちらが正しいか決定的なところは見えていないです。見た目の速度が違う解放でも旋回角度は同じように見えたという程度の根拠で、実際に速度が変わっているのだろうと考えた程度の根拠です。
*3:細かいことを言うと、1と2や5と6のように左右対称な解放の初速は同じです
*4:消去法で10番が決まりますが、特に注目していなかったので振っていません
*5:距離の計算を、中心点で行っているのか、より広い範囲で行っているのか確証がなかったのですが、今回の挙動を見ると後者で決まりのようです
木構造の親子関係を考慮したソート
前置き
Common Lisp（サブセット）をJavaScriptコードに変換するParenscriptを色々拡張しているps-experimentで以前パッケージもどきを追加したことがありました。
単にuse-packageしているパッケージをたどっていって、その配下で定義したParenscript用関数をすべてJavaScriptに変換するという代物です。このときに、パッケージの出力順については「まあJavaScriptで出力順序が影響するケースも少ないだろうし、問題が起きた時に考えよう…」と思っていたのですが、とうとう問題が起きたので真面目に考えてみたというのが今回の発端です*1。
この出力順の問題は、一般化するとパッケージをノード、use-packageの関係をエッジ（useしている側が親、されている側が子）とした木構造として捉えられます。このノードを以下の条件を満たすように一列に並び替えます。
- 親ノードは子ノードよりも後ろに配置される
面倒なのは一つの子ノードが複数の親ノードを持つ可能性がある可能性や、循環参照が存在する可能性があるため、単なる深さ優先探索では不十分という点です。ひとまずは(1)親ノードは1つだけで循環参照も存在しないという条件から始めて、(2)循環参照はなしで親ノードを複数持てる場合、(3)循環参照をエラーにする場合、(4)循環参照を許可する場合*2と徐々に条件を厳しくして考えていきます。
たぶん世界中で100万人は考えたことのある問題です。
準備
コード込みで考えていきたいので、道具となる構造体や関数を定義しておきます。なおこの記事全般に言えることですが、コードは読み飛ばしてもだいたい意味は通る…はずです。
パッケージの依存関係処理に使いたいというのがそもそもの発端であったため、汎用に使えるようにgenericを定義しておきます。
(defgeneric get-node-name (node)) ; プリント用 (defgeneric node-equalp (node1 node2)) ; ノード間の等値比較 (defgeneric get-children (node)) ; 子ノードの取得
単純なnode構造体とメソッドを作成します。
(defstruct node name children) (defmethod get-node-name ((node node)) (node-name node)) (defmethod node-equalp ((node1 node) (node2 node)) (eq (node-name node1) (node-name node2))) (defmethod get-children ((node node)) (node-children node))
次に、実験用に木を簡単に構成するための補助関数を作成します。木の定義は((:parentA :childA1 :childA2) (:parentB :childB1 :childB2) ...)のように簡単に書けるようにします。例えば、上図の木の場合は次のように書き下します。
(defparameter *simple-tree* '((:a :b :c) (:c :d :e) (:d :f :g)))
これを、親子関係（node-children）を設定しながらnode構造体のリストにするのがmake-treeです。なおaifやitはanaphoraライブラリのものです。
(defun make-tree (parent-children-pair) (let ((node-pool (make-hash-table)) (result nil)) (flet ((ensure-node (name) (check-type name keyword) (aif (gethash name node-pool) it (setf (gethash name node-pool) (make-node :name name))))) (dolist (pair parent-children-pair) (let ((parent (ensure-node (car pair)))) (dolist (child-name (cdr pair)) (push (ensure-node child-name) (node-children parent))) (push parent result)))) (dolist (node result) (setf (node-children node) (nreverse (node-children node)))) result))
また、与えられたノードのリストの子供をたどって、重複なしに全てのノードを一列に並べる関数linearize-all-nodesを用意します*3。
(defun linearize-all-nodes (node-list) (let ((result nil)) (labels ((rec (node) (unless (some (lambda (target) (node-equalp target node)) result) (push node result) (dolist (child (get-children node)) (rec child))))) (dolist (node node-list) (rec node))) result))
本題
段階1：親ノードを一つしか持てず循環参照も存在しない木の場合
まずは1番単純な、親ノードを一つしか持てず循環参照も存在しない、下図のような木を考えます。
こうした木の場合は一番上のノードを取り出して、そこから深さ優先探索を行うだけで問題ありません。この制約下では、深さ優先探索で子ノードが親ノードよりも先に訪問されることはないためです。
(defun sort-tree-node-simply (node-list) (let ((top-node (find-if (lambda (target) ;; If the target is not child of any node, it is a top node. (notany (lambda (parent) (some (lambda (child) (node-equalp target child)) (get-children parent))) node-list)) node-list))) (assert top-node) ;; linealize-all-nodes が深さ優先探索であることを仮定しています。汚いですがまあ前座なので… (linearize-all-nodes (list top-node))))
ソートした結果を表示するための関数（以降使いまわします）を作って結果を見てみると、正しくソートされていることが分かります。
(defun print-result (tree sort-fn) (format t "~A~%" (mapcar #'get-node-name (funcall sort-fn (make-tree tree))))) (print-result *simple-tree* #'sort-tree-node-simply) ;; -> (E G F D C B A)
段階2：複数の親を許すが循環参照は存在しない木の場合
次に、循環参照はないものの、ノードに複数の親を持つことを許した木を考えます。下図の例では、ノードFはAとDの2つの親を持ちます。
(defparameter *duplicated-tree* (make-tree '((:a :b :f :c) (:c :d :e) (:d :f :g) (:f :h :i))))
これを段階1の深さ優先ソートで出力してみると…
(print-result *duplicated-tree* #'sort-tree-node-simply) (E G D C I H F B A)
子であるFが出てくる前にDが出てきてしまっています。その親子関係まで見ると"DC"と"IHF"を入れ替えないと正しい結果にならないことが分かります。複数の親を許したために、A→Fというより早く探索されるパスができてしまったためにうまくいかなくなりました。
そこで、全ノードのリストからソート済みリストへ移すときに、既に子ノードがすべて後者の移されているかをチェックする機構を入れる必要があります。あとは、全ノードリストからチェックを通るものを一つずつピックアップしてソート済みリストに持っていくだけです。第1段階で仮定していたような、全ノードの取得部分linearize-all-nodesが深さ優先探索であるという仮定もいらなくなります。
;; 子ノードが全てソート済みリストに入っているかをチェックする ;; （ここではまだ関係ありませんが、自己参照は無視しています） (defun all-children-are-processed (node processed-node-list) (every (lambda (child) (or (node-equalp node child) ; Ignore self dependency (find child processed-node-list :test #'node-equalp))) (get-children node))) (defun sort-tree-node-with-duplication (node-list) (labels ((rec (rest-nodes result) (aif (find-if (lambda (node) (all-children-are-processed node result)) rest-nodes) (rec (remove it rest-nodes :test #'node-equalp) (cons it result)) result))) (reverse (rec (linearize-all-nodes node-list) nil))))
結果を見ると、今度はノードDとCの前にI, H, Fが全て出てきており、正しい順番にソートされることが分かります。
(print-result *duplicated-tree* #'sort-tree-node-with-duplication) ;; -> (B E G I H F D C A)
段階3：循環参照を検知してエラーにする
次は循環参照の存在する木を考えます。下図は「F→G→D→F→G→D→…」の循環参照が存在する木です。
(defparameter *circular-tree1* '((:a :b :f :c) (:f :h :g) (:g :d) (:d :f) (:c :d :e)))
循環参照部分は「親ノードは子ノードよりも後ろに配置される」という条件を決して満たせないため、検知してエラーにする必要があります。なお、試しに前節のsort-tree-node-with-duplicationで並び替えてみると…循環参照を形成するF, G, Dの他、それらに依存するA, Cも巻き込まれて出力されません。
(print-result *circular-tree1* #'sort-tree-node-with-duplication) ;; -> (B E H)
さて、まずは循環参照を検出する関数extract-circular-nodesを作成します。内部関数recが本体になりますが、深さ優先探索で木を探索しながら、トップから現在ノードまでの経路をtraverse-listに格納しています。新たに辿ろうとした子ノードがtraverse-listに既に含まれていた場合、循環参照が存在することが分かります。また、このときtraverse-listの先頭から同リスト内の子ノードまでが循環経路になります（コード上ではtraverse-listをreverseしてmemberで子ノード以降を取り出すという操作をしています）。この辺りのアイディアは、後述のASDFでの循環参照検知方法を参考にしています（というよりそのままです）。なお、自己参照も循環参照の一種ではありますが、害はないので素通しにしています。
(defun extract-circular-nodes (node-list) (labels ((rec (current-node traverse-list) (setf traverse-list (cons current-node traverse-list)) (dolist (child (get-children current-node)) (unless (node-equalp current-node child) ; Ignore self dependency (when (find child traverse-list :test #'node-equalp) (let ((result (member child (reverse traverse-list) :test #'node-equalp))) (return-from rec result))) (let ((next-result (rec child traverse-list))) (when next-result (return-from rec next-result))))) nil)) ;; ※通過済みのノードであってもチェックすることになるので ;; さすがにちょっとバカっぽいループです… (dolist (node node-list) (awhen (rec node nil) (return-from extract-circular-nodes it)))))
後はこれを利用して循環参照をエラーにするチェック関数を用意して、sort-tree-node-with-duplicationの手前に設置すれば、循環参照をエラーにするsort-tree-node-checking-circularの完成です。
(defun check-circular-dependency (node-list) (awhen (extract-circular-nodes node-list) (error "There is (a) circular dependency: ~A" (mapcar #'get-node-name it)))) (defun sort-tree-node-checking-circular (node-list) (check-circular-dependency (linearize-all-nodes node-list)) (sort-tree-node-with-duplication node-list))
次のように、循環参照を検知してエラーにしつつ、そうでなければsort-tree-node-with-duplicationと同等のソート性能を持つことが分かります。
(print-result *duplicated-tree1* #'sort-tree-node-checking-circular) ;; -> (B E G I H F D C A) (print-result *circular-tree* #'sort-tree-node-checking-circular) ;; -> （次のようなエラーを出力）There is (a) circular dependency: (F G D)
余談：ASDFにおける循環参照検知
ここで余談ですが、今回パクった参考にしたASDFのコードについてです。
ASDFでは.asdファイルにdefsystemでシステムを定義しますが、ここで各モジュールを構成するファイル間の依存関係を定義します。asdf:load-system時にはこれを見て、循環参照があればエラーにしています。実際にエラーを検知してエラーを出力しているのはasdf.lispの下記call-while-visiting-actionです。なお、これは1ノード分の処理であり、木の探索自体はより上位の関数で実行します。
若干用語を補足します。
action: 今回で言うノードに当たるようですaction-list: 今回でいうtraverse-listで、現在の通過経路が入ったリストですaction-set:actionをキーとし、ブール値を値とするハッシュです。ここでは通過経路にt、それ以外にnilを入れているようです*4
循環参照の検知をしているのは(gethash action action-set)で、通過経路に現在のactionがあるかを判定しています。検知した場合は、循環参照エラーにします。このとき、action-listをreverseしてmemberで現在のaction以降を取り出すことで、循環経路を取り出しています。…というように、ハッシュを使っている以外はそのまま参考にしました。
;; ※ASDF 3.1.5のコードより (defmethod call-while-visiting-action ((plan plan-traversal) operation component fun) (with-accessors ((action-set plan-visiting-action-set) (action-list plan-visiting-action-list)) plan (let ((action (cons operation component))) (when (gethash action action-set) (error 'circular-dependency :actions (member action (reverse action-list) :test 'equal))) (setf (gethash action action-set) t) (push action action-list) (unwind-protect (funcall fun) (pop action-list) (setf (gethash action action-set) nil)))))
段階4：循環参照ノードをグループ化して解決する
※警告：この段階4は実用性が微妙なくせに説明がとても長いです…
循環参照がある時点で基本的におかしいので、即エラーの段階3まででも良い気もします。ただ、ASDFにおけるファイル間の循環参照とは違い、パッケージ間の循環参照については検知される契機がないため、どこかでやらかしているライブラリがあると詰む可能性が考えられます。そのため、将来的な逃げ道のために循環参照をある程度いなして解決する方法を考えておきます。
ここで、改めて循環参照の存在する木を眺めてみると、循環参照をグループ化して一つの塊だと思えばうまくいきそうです。つまり、FGDを1つのグループと見て、FGDはHに依存し、AとCはそれぞれFGDに依存しているといった具合です。そして、同じグループに属するノードの出力順は任意で良いことにします。さて、図を見ながら考えると、グループやグループ間の等値性、グループ間の依存は下記のように定義できそうです*5。なお、ノードとグループを別個に扱うのは面倒そうなので、ノード1つの「塊」もグループとして扱うことにします。
- 定義：グループ
- 1つ以上のノードから構成され、かつ、
- 2つ以上のノードが存在する場合、グループ内の全ノードを含む循環参照が存在する
- 要は循環参照をグループ化しますということです
(defstruct node-group nodes ; グループを構成するノードのリスト children ; 子グループのキャッシュ ; （後述の「グループ間の依存」の定義に従い、依存するグループを集めたもの） )
- 定義：グループの等値比較
- グループAとグループBが等値であるとは、構成するノードが同じであることを言う
- 1つのノードは必ずある1つのグループだけに属しているという制約を設けるため、実際にはノードが1つでも一致すれば等値です
- グループAとグループBが等値であるとは、構成するノードが同じであることを言う
(defmethod node-equalp ((node1 node-group) (node2 node-group)) (let ((first-node (first (node-group-nodes node1)))) ;; An empty group is not allowed. (assert first-node) (find first-node (node-group-nodes node2) :test #'node-equalp)))
- 定義：グループ間の依存
- グループAがグループBに依存しているとき、グループAに含まれるノードの子ノードのうち、少なくとも1つがBに含まれる
(defun group-depend-p (target base) (some (lambda (base-node) (some (lambda (target-node) (find target-node (get-children base-node) :test #'node-equalp)) (node-group-nodes target))) (node-group-nodes base)))
（きちんと証明する能がないですが…）こうした定義から下記の性質を持つ点が重要です。
性質
- グループはノードとしての性質（等値比較ができる、子供を定義できる）を満たす
- 循環参照する複数のグループに属するノードを集めることで、一つのグループを構成できる
- 同一グループ内の任意の2ノードは循環参照している
- つまりグループ内のノード間では上下関係を決定できません
- 循環参照の関係にないグループA, Bがあり、かつAがBに依存しているとき、Bの全てのノードはAのどのノードから見ても（一方向の）子孫ノードである
- 平たく言えば、ノード間の親子（先祖/子孫）関係はグループ化しても保存されるということです
これらの性質を利用すると、下記のような手順で「循環参照を塊とみなしたソート」を実現できます
手順
- ノードのリストから、各ノードを要素とするグループのリストを作成する
- グループのリストから（自己参照でない）循環参照を探す。なければ手順5へ飛ぶ
- 性質1により、ノード用の循環参照検知関数をそのまま利用できる]
- 手順2で見つけた循環参照グループからノードを取り出して一つのグループにまとめ（性質2による）、元のグループは破棄する
- この操作によりリストの要素が減るので、無限ループにならない
- 手順2へ戻る
- グループをノードとみなし（性質1による）、段階2：複数の親を許すがループは存在しない木の場合に従ってソートする
- 手順5でソートされた順にグループを取り出し、含まれるノードを取り出してリストとする。このリストのノードは正しくソートされている（性質4による）
- 同一グループ内のノードの順序は任意でよい（性質3による）
手順1～4の実装は次のようになります。
;; ※循環参照グループをまとめる際に親子関係が変わるため、 ;; 再計算用の関数を用意 (defun calc-group-children (group group-list) (remove-if (lambda (target) (not (group-depend-p target group))) group-list)) (defun recalc-groups-children (group-list) (dolist (group group-list) (setf (node-group-children group) (calc-group-children group group-list))) group-list) ;; 手順3: 循環参照するグループ内のノードを一つのグループにまとめる (defun gather-ciruclar-node-group (circular-list group-list) (let ((new-group (make-node-group :nodes (apply #'append (mapcar (lambda (group) (node-group-nodes group)) circular-list))))) (recalc-groups-children (cons new-group (remove-if (lambda (group) (find group circular-list :test #'node-equalp)) group-list))))) ;; 手順1～4の一連の操作: グループ間の全ての循環参照をまとめあげる (defun make-group-resolving-circular (all-node-list) (labels ((rec (group-list) (aif (extract-circular-nodes group-list) (rec (gather-ciruclar-node-group it group-list)) group-list))) (rec (recalc-groups-children (mapcar (lambda (node) (make-node-group :nodes (list node))) all-node-list)))))
後は手順5に従い、make-group-resolving-circularの結果をsort-tree-node-with-duplicationに渡すことでグループ間のソートは完了です*6。
(defun sort-tree-node-with-circular (top-node-list) (sort-tree-node-with-duplication (make-group-resolving-circular (extract-all-nodes-by-dfs top-node-list))))
なお、見た目としてはグループをまとめたままの方が分かり易いため、以降では手順6（グループ内ノードのフラット化）を省略して出力します。
上記の循環参照する木をソートした結果を見ると、グループDFGがまとまり、またそれらに依存するA, Cは後から出てくるなど正しくソートできています。
((B) (E) (H) (D F G) (C) (A))
また、複数の循環参照を含む木でうまく動くかを確認するため、2つほど例を見てみます。
(defparameter *circular-tree2* '((:a :b :f :c) (:f :h :g) (:g :d :x) (:d :f) (:c :d :e) (:x :y) (:y :z) (:z :x))) ;; → ((B) (E) (H) (X Y Z) (D F G) (C) (A))
(defparameter *circular-tree3* '((:a :b :f :c) (:f :h :g) (:g :d :x) (:d :f) (:c :d :e) (:x :y :g) (:y :z) (:z :x))) ;; → ((B) (E) (H) (X Y Z D F G) (C) (A))
なお、グループ自体もノードとしての性質を満たすため、グループを要素としたグループを（再帰的に）作成できるはずですが、特に実用的な価値はないと思われます。
コード全体
最後に、全コードを貼り付けます。
Sort nodes in tree according to their dependencies …
Roswellスクリプトとして実行でき、下記を出力します。
$ ./sort-tree-node-with-circular.ros -------------------- --- Sort simply --- -------------------- *SIMPLE-TREE*: ((A B C) (C D E) (D F G)) -> (E G F D C B A) *DUPLICATED-TREE*: ((A B F C) (C D E) (D F G) (F H I)) -> (E G D C I H F B A) -------------------- --- Sort considering duplicated parent --- -------------------- *SIMPLE-TREE*: ((A B C) (C D E) (D F G)) -> (B E G F D C A) *DUPLICATED-TREE*: ((A B F C) (C D E) (D F G) (F H I)) -> (B E G I H F D C A) *CIRCULAR-TREE1*: ((A B F C) (F H G) (G D) (D F) (C D E)) -> (B E H) -------------------- --- Sort checking circular --- -------------------- *DUPLICATED-TREE*: ((A B F C) (C D E) (D F G) (F H I)) -> (B E G I H F D C A) *CIRCULAR-TREE1*: ((A B F C) (F H G) (G D) (D F) (C D E)) ERROR: There is (a) circular dependency: (F G D) -------------------- --- Sort considering circular --- -------------------- *SIMPLE-TREE*: ((A B C) (C D E) (D F G)) -> ((F) (G) (D) (E) (C) (B) (A)) *DUPLICATED-TREE*: ((A B F C) (C D E) (D F G) (F H I)) -> ((H) (I) (F) (G) (D) (E) (C) (B) (A)) *CIRCULAR-TREE1*: ((A B F C) (F H G) (G D) (D F) (C D E)) -> ((E) (B) (H) (F G D) (C) (A)) *CIRCULAR-TREE2*: ((A B F C) (F H G) (G D X) (D F) (C D E) (X Y) (Y Z) (Z X)) -> ((E) (B) (H) (X Y Z) (F G D) (C) (A)) *CIRCULAR-TREE3*: ((A B F C) (F H G) (G D X) (D F) (C D E) (X Y D) (Y Z) (Z X)) -> ((E) (B) (H) (D F G X Y Z) (C) (A)) -------------------- --- (Test self dependncy) --- -------------------- *TREE-TO-TEST-SELF-DEPENDENCY*: ((A A B F C) (C C D E) (D F G) (F H I)) -> (B E G I H F D C A) *TREE-TO-TEST-SELF-DEPENDENCY*: ((A A B F C) (C C D E) (D F G) (F H I)) -> (B E G I H F D C A) *TREE-TO-TEST-SELF-DEPENDENCY*: ((A A B F C) (C C D E) (D F G) (F H I)) -> ((H) (I) (F) (G) (D) (E) (C) (B) (A))
以上
*1:具体的には、ps-experimentで実装しているdefstructのサブセットで問題が起こりました。includeした場合に継承関係をつけるコードを出力するのですが、このコードが親となる構造体の定義よりも先に出てきてしまうと、うまく継承関係を定義できないようでした
*2:「親ノードは子ノードよりも後ろに配置される」をそのままでは満たせないため、少し条件を緩和して考えます
*3:パッケージの親子関係をたどるケースを考えると、最初に全てのパッケージが並んでいるのではなく、起点となるいくつかのパッケージを与えられるのが普通だと思います。ソートの中で徐々に展開しても良さそうですが、最初にすべて並べてしまった方が簡単そうなのでこうした関数を用意しています
*4:循環参照のチェックが終わると、action-setのキーの集合が全actionのリストとなる辺り賢いです。そこまで見ていないのですが、この後ロードを行う際にここでロード済みか否かを管理するのではないかと予想しています。ちなみに、ハッシュの値としてnilを入れておく（≒キーが存在しないことと同等に扱う）手法の実用的な価値をイメージできていなかったのですが、初めて分かった気がします
*5:というように「グループ」を素直に扱えば解決できるという所に行きつくまでに、実はすごい迷走してました…
*6:万全を期するのであれば、循環参照が確かに解消されたことを確認するために、check-circular-dependencyを入れた方が良いです
[小ネタ] アルファマップを生成するRoswellスクリプト
小ネタ。アルファマップを生成するRoswellスクリプトを作成したメモです。
Three.jsのように、透過画像を表示するためには（画像自体のアルファ値は無視して）アルファマップと呼ばれる、透過具合をグレースケールで表した画像（黒が完全透過で白が完全不透明）を要求するものがあります。
このアルファマップを一々手で作成するのは面倒なので、元画像（PNG）のアルファ値を読み取ってアルファマップを生成するスクリプトを書いてみました。こんな感じに使います。
$ ./create-alpha-map.ros -i ab.png -o ab-alpha.png
Before (ab.png):
After (ab-alpha.png):
スクリプト自体は40行程度の簡単なものです。
Create an alpha map png from a png file
画像処理ライブラリであるopticlとコマンドライン引数処理ライブラリであるCL-CLIのおかげで、思いの外簡単に書けた次第です。今回はどちらも基本的な部分しか使っていませんが…。
CL-CLIについて何点か。サブコマンドの定義など高度な機能も持っているようですが、基本的には上記のようにオプションを定義したリスト（*options*）を作成してcl-cli:parse-cliに渡すだけです。ちょっとした注意点として、この関数はコマンドライン引数の1要素目にコマンド自体が入ることを想定しているようですが、Roswellのargvには含まれていないので適当に空文字を追加しています（(cl-cli:parse-cli (cons "" argv) *options*)）。
また、cl-cli:helpで下記のように自動でヘルプを生成してくれるのも嬉しいです。
$ ./create-alpha-map.ros
NIL
[ OPTIONS ]
Global options:
-i,--input-path <file> [Required] Input image file path
-o,--output-path <file> Input image file path (default:
/tmp/temp.png)
PostgreSQL (POSTGRES) におけるLisp
前書き
LispからPostgreSQLを扱う記事…ではなく、PostgreSQLの歴史に見え隠れするLispについての調査もどき記事です。
発端は次のようなものです。仕事柄PostgreSQLのメーリスやソースを見たり見なかったりするのですが、今年の1月にRustgreSQLというスレッドがありました。PostgreSQLをRust言語にポーティングするような話はないのかという 何を言っているんだこいつは 話題です。あり得るとしてもせいぜいC++だろうとか、いまだにC99ですらなっていないのに…*1とか、PostgreSQLのC言語の使い倒しっぷりを考えると死ぬほど非現実的だよとか、大変好意的な返信が並ぶ中、Robert Haas *2 の以下の発言が目を惹きました。
I'm tempted to snarkily reply that we should start by finishing the conversion of PostgreSQL from LISP to C before we worry about converting it to anything else.
なんとPostgreSQLの歴史上Lispで書かれていた時期があるようです。当時はへーと思って終わっていたのですが、ふと思い出して気になったので調べてみたという次第です。
PostgreSQLのソースにおけるLispの残滓
現行のPostgreSQLのソースにLispらしき痕跡があるのかを少し見てみます。Robert Haasは上記の発言に続いてこう言っています。
There are various code comments that imply that it actually was LISP at one time and I can certainly believe that given our incredibly wasteful use of linked lists in so many places.
論点は2つで、1つ目はコメントにLISPであった名残が見られることで、もう1つは現行のPostgreSQLがリンクリストを過剰に利用している原点はLispだろうということです。
前者の例としてgram.yのコメントを挙げています。
* HISTORY * AUTHOR DATE MAJOR EVENT * Andrew Yu Sept, 1994 POSTQUEL to SQL conversion * Andrew Yu Oct, 1994 lispy code conversion
確かにLispからコンバートしたと書かれています。このスレッドには書かれていませんが、似たようなものとして命名規則にもLispの名残が見られます。リスト操作用のヘッダはsrc/include/nodes/pg_list.hですが、ここを眺めてみると…
/* ※下記実際には行が離れていますが、一々省略記号を書くのも面倒なので続けて引用しています */ #define NIL ((List *) NULL) extern List *lappend(List *list, void *datum); extern List *lcons(void *datum, List *list); define nconc(l1, l2) list_concat(l1, l2) #define nth(n, list) list_nth(list, n)
Lispだ…。なお、残念ながらcarやcdrはありませんでした。
もう1つの論点であるリンクリストの多用についてですが…確かにあちこちリストだらけだなという程度で、余りLispっぽい印象を受けたことがないです…。とりあえずLispでプロトタイプを書くとリスト濫用になるよねというのは分かるのですが。
補足：POSTGRESとPostgreSQL
本題である、実際にPostgreSQLがLispで書かれていた時代について…の前に、用語の補足です。今では「ポストグレス」と言えばPostgreSQLのことですが、実はPOSTGRESという前身となるデータベースが存在しています。詳しい歴史はWikipediaのPostgreSQLの記事などにありますが、概要は下記の通りです。以降の話題であるLisp時代を直接に経験しているのはこのPOSTGRESの方になります。
- POSTGRES
- PostgreSQL
実際にLispで書かれていた時代
さて、現在の名残は前述の通りですが、実際にLispで書かれていた当時のことが分かるものとして下記の2つが見つかりました。
- 文献1: 1990年のストーンブレーカー博士の論文：THE IMPLEMENTATION OF POSTGRES (PDF)
- 「5.3. Programming Language Used」に言語選択に関する記載があります
- 文献2: メーリスのスレッド：Re: [HACKERS] Historical trivia (was Re: First Major Open Source Database)
- 投稿者は当時の開発者の一人のようです
お互い微妙に情報が足りないので、適宜両者を参照して進めていきます。
まず、そもそもLispが選択された動機についてです。これは文献1に記載があります。だいぶ端折って説明すると、CはIngresで使ったから真新しさがないし、C++はまだ安定した処理系がないし、他に検討した言語も諸々の理由で落とした結果Lispが残ったようです。ポジティブな理由としては、リスト処理（≒木構造処理）が得意なLispはオプティマイザや推論エンジン（？）が作りやすいのではないかと考えたそうです。
Lispといってもどの方言なのか書いてないのですが、それは文献2の方に記載があります。それによると、Franz Lispを使っていたとのことです。この辺りの古い方言は馴染みがないのですが…、g000001さんの「レトロLisp探検: Franz Lisp」などを見るとC言語との連携性の高さに特徴があるようです。POSTGRESの初版は結果的にLispが17000行、C言語が63000行となったそうです（文献1）が、最初の選択の時点でその辺りが斟酌されたのかは分かりません。なお、結果的にC言語を併用することになったのは、メモリ周りなどの低レイヤの処理を扱うにはやはり一日の長があったからとのことです（文献1）。
横道ですが、Franz Lispを作っていたFranz社は、現在では主要な商用Common Lisp処理系の一つであるAllegro Common Lispで知られています。この処理系が登場したのが1986年でPOSTGRESプロジェクトの発足とちょうど同じ年です。もう少しPOSTGRESプロジェクトの発足が遅ければCommon Lispが使われていたのかもしれません。
本題に戻って、次にLispがどの部分で使われたのか、すなわち前述のLisp17000行とC言語63000行の内訳はどうなっていたかです。これも文献1には記載がなく、、文献2の方に記載があります。parser（クエリの解析）、optimizer（実行計画の作成、plannerとも）、executor（その名の通り実際に実行する人）辺りがLispで作られていたようです。…ただ、parserに関しては、
steven wrote and maintained the parser, which was always written using lex/yacc (i.e., C) but had to generate (in C!) a lisp parse tree.
と書いてあり、lex/yaccからLispコードを生成したということなんでしょうか…？
最後に、当時は確かに存在していたLispコードがなぜ消滅することになったのか…ですが、文献1によるとLisp選んだのは完全に失敗だったねという評価になったからのようです（哀しい…）。最大の理由は、2言語の混ぜ合わせはとにかくデバッグが辛かったというところにあるとのことです。他に、大きな欠点として下記3つを挙げています。
- メモリ使用量が大き過ぎる
- 全体として、走らせるだけで4MBものメモリを使うことになってしまった（数値に時代を感じます）
- DBとしてはガベージコレクタの動作は許容しがたい
- GCが動かないように頑張ったそうです
- 遅い
- Lispエキスパートがいればなんとかなったのかも知れないが…とは補足しています
なお、（Lisp単体の範囲では）生産性の高さという部分で恩恵もあったようですが、言語自体よりはインタラクティブなデバッガなど環境面の素晴らしさにによるものだろうと評価しています。
in late 1989, jeff goh wrote a postgres-specific lisp->C translator that automated most of the conversion.
そんな訳で1989年にはコンバータが作られてLispコード消滅の運びとなりました（文献2）*3。
以上、PostgreSQL (POSTGRES) におけるLispの歴史の調査でした。
*1:移植性の問題で過去に却下されたようです。代表的なところではVisual C++がC99サポートし始めたのがようやく2013年…
*2:PostgreSQLの主要なコミッターの一人です
*3:上の方で引用したコードのコメントでは1994年となっているのが不思議ですが、文献1の書かれた時期を考えても1989年が実際にコンバートされた時期で、1994年はまた別の契機のように思います
