cl-yesql hacks or asdf extension.

対象読者

• cl-yesqlのユーザ。
• asdfの拡張に興味のあるCLer。

Introduction.

cl-yesqlを愛用しているのですが、気に食わない点として独自のシステムビルダを使用している点が挙げられます。 できればCommon Lisp界のデファクトスタンダードシステムビルダであるasdfでビルドしたい。

個人的にasdfの魅力の一つは、ファイルやライブラリの依存を一ヶ所にまとめて書ける点にあると思っています。 （なのでpackage-infered-systemは好みでない。） この点は特に（将来の自分を含む）第三者がシステムの全体像をざっくり把握したい場合役立ちます。

そんなわけでSQLファイルもasdファイルのdefsystemフォームに記したい。

たとえば以下のようなディレクトリ構造のプロジェクトがあるとします。

+ myproject.asd
+ src
   |--- package.lisp
   |--- main.lisp
   |--- util.lisp
+ sql
   |--- user.sql
   |--- entry.sql

defsystemフォームはたとえば以下のように書きたい。

(defsystem "myproject"
  :components ((:module "src"
                :components
                ((:file "package")
                 (:file "util" :depends-on ("package"))
                 (:file "main" :depends-on ("util" "package"))))
               (:module "sql"
                :depends-on ("src")
                :components ((yesql "user")
                             (yesql "entry")))))

本稿ではこれを実現するためのコードを備忘録として記しておきます。

asdf:source-file

まず必要になるのは独自のcomponentクラスです。 asdfは様々なcomponentクラスを提供してくれています。

cl-yesqlではSQLファイルを書くことになります。 またそれらSQLファイルはcl-yesql:importによりLisp環境に関数群としてロードされます。 すなわちSQLファイルは形を変えたLispソースコードとみなせます。

そのようなソースコードファイルはasdf:source-fileで表します。

(defclass yesql (asdf:source-file) ()
  (:default-initargs :type "sql"))

:default-initargsでファイルの拡張子をsqlに指定している点要注目。

* (asdf:file-type (make-instance 'yesql :name "dummy")) => "sql"

asdf:perform

asdf:source-fileを継承したcomponentクラスを定義した場合、asdf:compile-opとasdf:load-opに特定化されたasdf:performメソッドを各々定義しなくてはなりません。

(defmethod asdf:perform ((o asdf:compile-op) (c yesql))
  :TODO)
(defmethod asdf:perform ((o asdf:load-op) (c yesql))
  :TODO)

Compiling with universal.lisp

Lispファイルをコンパイルする場合、asdfはasdf::perform-lisp-compilation関数を使っています。

問題は我々が扱っているファイルはSQLファイルであってLispファイルではない点です。

cl-yesqlが依存している埋め込み言語モジュールシステムであるvernacularではuniversal.lispファイルを使いこの問題を解決しています。

大変興味深いので解説します。

univesal.lisp

universal.lispの中身は大変短いので引用しましょう。

#.vernacular/specials:*program-preamble*
#.vernacular/specials:*program*

ご覧の通り読み込み時に変数を参照するだけです。

universal.lispファイルがcl:compile-fileに渡されると、Lispはファイルの中身を読み込もうとします。

読み込み時評価である#.というディスパッチマクロがあるので変数を評価します。 これら変数は動的なスペシャル変数ですので、その次点で束縛されている値が読み込み時評価の結果としてLisp環境に読み込まれます。

すなわち変数に(defun main () (print :hello))というリストが束縛されていれば、あたかもファイルに(defun main () (print :hello))と書かれてあるかのようにLispは解釈します。

これにより、SQLファイルをLisp関数群としてコンパイルするにあたり、各SQLファイルに対応したLispファイルを作る必要なく、ただ一枚universal.lispファイルがありさえすれば後は逐次任意のフォームを変数に束縛するだけで事足ります。

賢い。

compile-op

コンパイルは以下のようになります。

(defmethod asdf:perform ((o asdf:compile-op) (c yesql))
  (progv (list (uiop:find-symbol* '#:*program-preamble* '#:vernacular/specials)
               (uiop:find-symbol* '#:*program* '#:vernacular/specials))
         (list :TODO :TODO)
    (asdf::perform-lisp-compilation o c)))

パッケージvernacular/specialsはasdファイルのロード時には未だ存在していないので、cl:progvを使ってメソッド呼び出し時に動的に束縛を作る点、また、uiop:find-symbol*でメソッド呼び出し時にシンボルを探している点、要注目。

load-op

ロードは以下のようになります。

(defmethod asdf:perform ((o asdf:load-op) (c yesql))
  (asdf::perform-lisp-load-fasl o c))

asdf:input-files, asdf:output-files and operation object.

コンパイルやロードを行うためには、componentオブジェクトからしかるべきpathnameを作れなければいけません。 asdfは入/出力用のpathnameを取り出すためのメソッドasdf:input-files、asdf:output-filesを提供しています。

既定の振る舞いは以下のようになります。

;;;; For compile.
* (asdf:input-files 'asdf:compile-op (asdf:find-component :myproject '("sql" "user")))
=> (#P"/home/hyotang666/.roswell/local-projects/myproject/sql/user.sql")

* (asdf:output-files 'asdf:compile-op (asdf:find-component :myproject '("sql" "user")))
NIL
T

;;;; For load.
* (asdf:input-files 'asdf:load-op (asdf:find-component :myproject '("sql" "user")))
=> (#P"/home/hyotang666/.roswell/local-projects/myproject/sql/user.sql")

* (asdf:output-files 'asdf:load-op (asdf:find-component :myproject '("sql" "user")))
NIL
T

通常は難しく考えずこれらメソッドを実装すればよろしゅうございます。

今回われわれがコンパイルしたいのはつまるところLispなので、asdfが持つ内部関数を便利に使わせてもらいましょう。 asdfに多くの仕事を任せることで、Lisp処理系依存による多くの問題を肩代わりさせられます。

(defmethod asdf:output-files ((o asdf:compile-op) (c yesql))
  "Generate output fasl pathnames."
  (asdf::lisp-compilation-output-files o c))

上記メソッドの追加により、振る舞いは以下のようになります。

;;;; For compile.
* (asdf:input-files 'asdf:compile-op (asdf:find-component :myproject '("sql" "user")))
=> (#P"/home/hyotang666/.roswell/local-projects/myproject/sql/user.sql")

* (asdf:output-files 'asdf:compile-op (asdf:find-component :myproject '("sql" "user")))
(#P"/home/hyotang666/.cache/common-lisp/sbcl-2.2.0-linux-x64/home/hyotang666/.roswell/local-projects/myproject/sql/user.fasl")
T

;;;; For load.
* (asdf:input-files 'asdf:load-op (asdf:find-component :myproject '("sql" "user")))
(#P"/home/hyotang666/.cache/common-lisp/sbcl-2.2.0-linux-x64/home/hyotang666/.roswell/local-projects/myproject/sql/user.fasl")

* (asdf:output-files 'asdf:load-op (asdf:find-component :myproject '("sql" "user")))
NIL
T

コンパイルのための出力ファイルとロードのための入力ファイルが変わった点要注目。

さて、ここからが厄介です。 我々は出力ファイルパスの生成にasdf::lisp-compilation-output-filesを使いました。 そしてasdf::lisp-compilation-output-filesはasdf:input-filesの振る舞いに依存しています。

ですが、われわれがasdf::perform-lisp-compilation経由でcl:compile-fileに渡したいのはuniversal.lispへのファイルパスです。 すなわちasdf:input-filesの返り値をあるときはSQLファイル、あるときはuniversal.lispと状況によって切り替えたい。 通常そのような場合は、たとえば引数でフラグを渡して切り替えるなどするのですが、asdf:input-filesはasdfの総称関数であって自前のものではないのでAPIシグネチャの変更などはできません。 なら、スペシャル変数を宣言し、その値によって振る舞いを切り替えたいところですが、残念ながらasdf:input-filesはメモ化されているのでこの手段も取れません。

よって今回は新たにcompile-yesql-opというoperationオブジェクトを導入することで対応します。

(defclass compile-yesql-op (asdf:compile-op) ())

(defmethod asdf:input-files ((o compile-yesql-op) (c yesql))
  "Return universal file path."
  (list (make-pathname :name "universal"
                       :type "lisp"
                       :defaults (asdf:system-source-directory
                                   (asdf:find-system :vernacular)))))

振る舞いは以下のようになります。

* (asdf:input-files 'compile-yesql-op (asdf:find-component :myproject '("sql" "user")))
=> (#P"/home/hyotang666/.roswell/lisp/quicklisp/dists/quicklisp/software/vernacular-20211020-git/universal.lisp")

* (asdf:output-files 'compile-yesql-op (asdf:find-component :myproject '("sql" "user")))
(#P"/home/hyotang666/.cache/common-lisp/sbcl-2.2.0-linux-x64/home/hyotang666/.roswell/lisp/quicklisp/dists/quicklisp/software/vernacular-20211020-git/universal.fasl")
T

asdf:input-filesがuniversal.lispになったのは歓迎ですが、asdf:output-filesがuniversal.faslなのはいただけません。 クラスにスロットを追加し、対応しましょう。

(defclass compile-yesql-op (asdf:compile-op)
  ((op :accessor op))) ; <--- this!

(defmethod output-files ((o compile-yesql-op) (c yesql))
  (asdf:output-files (op o) c))

呼び出しがわ、すなわちasdf:performの実装は以下のようになります。

(defmethod asdf:perform ((o asdf:compile-op) (c yesql))
  (progv (list (find-symbol* '#:*program-preamble* '#:vernacular/specials)
               (find-symbol* '#:*program* '#:vernacular/specials))
    (list :TODO :TODO)
    (let ((op (asdf:make-operation 'compile-yesql-op)))
      (setf (op op) o)
      (asdf::perform-lisp-compilation op c))))

operationオブジェクトの作成にはasdf:make-operationを使わねばならないとマニュアルにありますので、スロットの値はオブジェクト作成後にsetfするかたちで行っています。

Generate lisp functions.

残すはTODOの中身です。

vernacular/specials:*program-preamble*はNILに束縛することとします。 ここはdefpackageやらin-packageフォームやらに束縛するべきものですが、今回は使いません。

vernacular/specials:*program*はvernacular/lang:expand-moduleの返り値をゴニョゴニョしたprognフォームで束縛することとします。

筆者はvernacularというライブラリの振る舞いに明るくありません。 本当はもっといいやり方があるような気がしています。

ですがわずかながらソースを掘り返した結果、vernacularはoverlordというビルドシステムと密接に結びついており、asdfとの結合がうまく行かなそうでした。

今回は多少無理やりな方法で、やりたいことを実現します。

vernacular/lang:expand-moduleはcl-yesql/postmodern:module-prognフォームを生成します。 （“#lang cl-yesql/postmodern”の場合。）

フォームのcdr部にはcl-yesql/postmodern:defqueryフォームが詰まっています。 cl-yesql/postmodern:defqueryマクロはdefunフォームを生成するマクロです。

cl-yesql/postmodern:module-prognマクロを展開させてしまうとvernacularの内部に深く入り込む必要が生じてしまうようでした。

cl-yesql/postmodern:defqueryフォームさえあればわれわれが行いたいことは可能なようですので、思い切ってcl-yesql/postmodern:module-prognマクロはcl:prognで置き換えることとします。

cl-yesql/postmodern:defqueryフォームの第一引数はdefunフォームの第一引数となるべきシンボルで、不幸にもcl-yesql/postmodernパッケージにインターンされてしまっています。 これを強引にmyprojectパッケージにインターンさせることとします。 これでSQLファイルに書かれたコードは無事Lisp関数となり、すべてmyprojectパッケージにインターンされます。

なお、vernacularはこの編のインターン周りをより丁寧に行ってくれているようです。 ですがそのためにコードが著しく複雑になっているようなので筆者は把握するのを諦めました。

asdf:performメソッドは以下のようになります。

(defmethod asdf:perform ((o asdf:compile-op) (c yesql))
  (progv (list (uiop:find-symbol* '#:*program-preamble* '#:vernacular/specials)
               (uiop:find-symbol* '#:*program* '#:vernacular/specials))
    (list nil `(progn ,@(loop :for (op name . rest)
                              :in (cdr (uiop:symbol-call '#:vernacular/lang '#:expand-module
                                                         (asdf:component-pathname c)))
                          :collect `(,op ,(intern (symbol-name name) '#:myproject)
                                         ,@rest))))
    (let ((op (asdf:make-operation 'compile-yesql-op)))
      (setf (op op) o)
      (asdf::perform-lisp-compilation op c))))

なお、vernacular/lang:expand-moduleはパス名からシステム名とパッケージ名を推測するようで、失敗するとエラーを投げます。 これに対応するためにはoverlord:set-package-baseを呼ぶ必要があります。 残念ながらoverlord:set-package-baseはマクロでuiop:symbol-callが使えないので、最終手段としてevalを使います。

(defmethod asdf:perform :before ((o asdf:compile-op) (c yesql))
  (eval
  `(,(uiop:find-symbol* '#:set-package-base '#:overlord)
     ,(make-pathname :directory (list :relative (asdf:component-name (asdf:component-parent c))))
     ,(asdf:primary-system-name c))))

実装は以上です。 これで冒頭のasdファイルをロードすることができるようになっているはずです。

SQL関数をmyprojectパッケージにインターンさせるため、“sql”モジュールを“src”モジュールに:depends-onさせるのがコツです。

cl-yesqlをasdfに統合させるissueもあるので、こんなの自前で書かなくてもよくなると嬉しいのにな。

今回のコードはここにまとめておきます。