nptclのブログ

Common Lisp処理系nptの開発メモです。https://github.com/nptcl/npt

make-load-formとは一体なんなんだ

make-load-formなんて誰も使ってないと思いますが説明します。
いまさらですけど、Common Lispって1994年に制定されているんですよね。
25年近く前の言語でマイナーな関数の説明なんて全く需要ないっすね。

それではmake-load-formを使ってみましょう。
これはCLOSオブジェクトをコンパイルするときに使うものです。

さっそくやってみます。
まずはクラスを作成します。

(defclass hello ()
  ((value :initarg :value)))

make-load-formは、このクラスを保存するのではなく、 インスタンスを保存するときに使います。
注意点としては、コンパイルするときとfaslをロードするときは 上記のクラスは存在していなければなりません。

コンパイルするファイルbbb.lispを用意します。

;; bbb.lisp
(setq *result* #.(make-instance 'hello :value 10))

リードマクロである#.は何のためについているのでしょうか。
これはread関数がファイルを読み込むときに実行するという機能です。
このようにしないとCLOSオブジェクトをコンパイルすることができないのです。

もし#.が無い状態の、

(setq *result* (make-instance 'hello :value 10))

コンパイルした場合は、 「make-instanceを実行する」というコードが生成されるため、 make-load-formは実行されません。
しかし、

(setq *result* #.(make-instance 'hello :value 10))

であれば、

(setq *result* #<HELLO #x0000000801D97631>)

のように展開されてコンパイルされるので、 式ではなくCLOSオブジェクト自体をコンパイルすることができます。

では、CLOSオブジェクトをどのようにコンパイルするかを宣言しましょう。
今回は例として、元々のvalueスロットの値が何であろうと 関係なく強制的に999を代入することにします。

(defmethod make-load-form ((x hello) &optional env)
  (declare (ignore env))
  `(make-instance 'hello :value 999))

最期に、変数*result*specialにしておきます。

(defvar *result*)

ではコンパイルします。

(compile-file #p"bbb.lisp" :output-file #p"bbb.fasl")

うまく行ったら実行です。

(load #p"bbb.fasl")

結果を確認します。

(format t "~A~%" (slot-value *result* 'value))
  -> 999

強制的に格納した999が返却されました。

以上の実行をまとめると次の通り。

ファイルbbb.lisp

;; bbb.lisp
(setq *result* #.(make-instance 'hello :value 10))

実行内容

(defvar *result*)

(defclass hello ()
  ((value :initarg :value)))

(defmethod make-load-form ((x hello) &optional env)
  (declare (ignore env))
  `(make-instance 'hello :value 999))

(compile-file #p"bbb.lisp" :output-file #p"bbb.fasl")
(load #p"bbb.fasl")

(format t "~A~%" (slot-value *result* 'value))

初期化を考える

これで動作自体は確認できたのですが、 強制的に999を格納するだけでは使い物になりません。
値を保存するためには、make-load-formの第2返却値を使います。
とりあえず例を示します。

(defmethod make-load-form ((x hello) &optional env)
  (declare (ignore env))
  (values
    `(make-instance 'hello)
    `(setf (slot-value ,x 'value) ,(slot-value x 'value))))

これがちょっとわかりづらい。
第1返却値の

`(make-instance 'hello)

は、単純に空のインスタンスを返却するコードです。
faslファイル実行時には、まず第1引数のフォームでオブジェクトを生成してから、 第2返却値のフォームにて値の設定を行います。

値の設定である、

`(setf (slot-value ,x 'value) ,(slot-value x 'value)))

は理解できるでしょうか。
まず実行してみた結果を例として挙げます。

(multiple-value-bind (x y)
  (make-load-form (make-instance 'hello :value 10))
  (format t "~S~%" x)
  (format t "~S~%" y))

実行結果

(MAKE-INSTANCE 'HELLO)
(SETF (SLOT-VALUE #<HELLO {1001AAF883}> 'VALUE) 10)

何なんだこれ、と思いませんか?
make-instanceで作成されたvalueの値を、 自分自身に代入するようなコードになっています。
それに何の意味が?

ここで覚えておかなければいけないのは、 make-load-formの引数が、第2返却値のフォーム内の 引数の役割になっているということです。
実際に第2返却値が実行される場合は、 第1返却値の

(MAKE-INSTANCE 'HELLO)

が実行されたインスタンスに置き換わります。

nptで実施している処理を元に説明します(たぶん合ってる!)。
第2返却値はlambda式に置き換えてしまっています。
上記の例の場合、

(make-load-form #<HELLO {1001AAF883})

の第2返却値

(SETF (SLOT-VALUE #<HELLO {1001AAF883}> 'VALUE) 10)

を、gensymであるgを用いて、 #<HELLO {1001AAF883}>からgへ置き換えます。

(SETF (SLOT-VALUE g 'VALUE) 10)

次に、lambda(g)をつなぎ合わせてlambda式を作ります。

(lambda (g)
  (SETF (SLOT-VALUE g 'VALUE) 10))

完成した式をcompile-file中でコンパイルしてやります。

ではfaslファイルが読み込まれたときの動作を示します。
まずはコンパイル時に生成したmake-load-formの第1返却値のコードを実行します。
つまり

(MAKE-INSTANCE 'HELLO)

を実行します。
結果を仮にggという変数に格納したとします。
こんな感じ。

(setq gg (MAKE-INSTANCE 'HELLO))

次にmake-load-formの第2返却値のlambda式を実行します。
つまり、

(lambda (g)
  (SETF (SLOT-VALUE g 'VALUE) 10))

を実行するので、

(funcall
  (lambda (g)
    (SETF (SLOT-VALUE g 'VALUE) 10))
  gg)

となります。
これでCLOSオブジェクトのコンパイルと実行は完了しました。

そんなめんどくさいことしたくない

make-load-formを作成するのは面倒ですよね。
そう言うあなたにうってつけなのがmake-load-form-saving-slots関数です。
これを使ってmake-load-formを宣言してみます。

(defmethod make-load-form ((x hello) &optional env)
  (make-load-form-saving-slots x :environment env))

これだけですべてのslotを保存してくれます。
便利ですね!
構造体であるstructure-objectなんかは標準で上記の設定がされているので、 何も考えずにコンパイルすることができます。
ごめんなさい、間違いです。
構造体も自分でmake-load-formを設定してください。

ではmake-load-form-saving-slotsが返却する内容はどんなものなのでしょうか?
完全に処理系依存ですがちょっと覗いてみましょう。

・sbcl
(SB-KERNEL::NEW-INSTANCE HELLO)
(SB-PCL::SET-SLOTS #<HELLO {10019C5F83}> (VALUE) 10)

・clisp
(ALLOCATE-INSTANCE (FIND-CLASS 'HELLO))
(PROGN (SETF (SLOT-VALUE #<HELLO #x00000008017C22F9> 'VALUE) '10)
 (INITIALIZE-INSTANCE #<HELLO #x00000008017C22F9>))

・ccl
(ALLOCATE-INSTANCE (FIND-CLASS 'HELLO))
(CCL::%SET-SLOT-VALUES '#<HELLO #x3020004B469D> '(VALUE) '(10))

・npt
(ALLOCATE-INSTANCE (FIND-CLASS (QUOTE HELLO)))
(NPT-SYSTEM::SET-SLOTS #<HELLO #x8012b85b0>
                       (QUOTE (VALUE))
                       (QUOTE (10)))

nptは自分で作ったはずなのに、こうなってるんだ!と驚きました。
ここでいう事じゃないですけど、QUOTEはちゃんと'になって欲しいものです。 (後で直します)

第1返却値に関してはほとんどallocate-instanceです。
これは規約の例にそう書いてあったことも大きいと思います。
sbclNEW-INSTANCEって何なんでしょうね?

第2返却値はみんな違っていますが、 やっていることはclispの内容そのままです。

今回はslotが1つしかないので出力内容も大人しめですが、 例えばdefclassで作ったクラスなんかを指定してやると、 standard-classslotが大量にあるため出力がかなり長くなります。
興味がある方は見てみたらどうでしょうか。

built-in-classは意味なし

built-in-classmake-load-formで指定しても、たぶん実行されません。

ファイルbbb.lisp

;; bbb.lisp
(format t "~A~%" 20)

実行手順

(defmethod make-load-form ((x integer) &optional env)
  (declare (ignore env))
  (+ x 222))

(compile-file #p"bbb.lisp" :output-file #p"bbb.fasl")
(load #p"bbb.fasl")

実行結果

20

つまりCLOSオブジェクト以外ではmake-load-formは実行されません。