#:g1: X3J13/87-002のwith-slots

Posted 2022-08-06 23:13:40 GMT

今は亡きSun Common Lisp(Lucid Common LispのOEM)のマニュアル(1987)を眺めていたのですが、このマニュアルに記載されている内容は、CLtL2より前のオブジェクトシステム仕様でX3J13/87-002に基いているようです。
ちなみにCLtL2のオブジェクトシステムはX3J13/88-001、X3J13/88-002あたりの内容なのですが、CLtL2以前の資料はウェブに転がっていないので割合に貴重かもしれません。

さて、このマニュアルに出てくるwith-slotsの仕様が興味深かったので挙動を真似してみることにしました。

ANSI CLのwith-slots

(with-slots (slot-name ...) instance 
  body ...)

となっていますが、X3J13/87-002のものは、

(with-slots (instance  ...) 
  body ...)

となっており、ANSI CLが単一のインスタンスしか扱えないのに対し複数のオブジェクトを扱える形式です。さらにスロット名の明示的記述はせず、ボディ内で暗黙的に変数名として使用できるようです。

スロット名を明示的に指定しないとなると実行時のインスタンスから推測する他に術がなくなるのですが、そのような場合には:classオプションでクラスを明示することでコンパイル時やマクロ展開での問題は解消できるようです。

X3J13/87-002 のwith-slots

フォームの形式が違っていることについては上記でも述べましたが、ANSI CLとの大まかな動作の違いは、

あたりです。
ANSI CLの仕様と照らし合わせると、with-slotswith-accsessorsが合体したような形式かと思います。
試しにマクロ展開される内容を書き下してみると、下記のようなX3J13/87-002仕様のフォームは、

(in-package x3j13/87-002)

(defclass point (accessor-prefix-object) ((x :initform 0) (y :initform 0)) (:metaclass accessor-prefix-class) (:accessor-prefix point-))

(let ((p (make-instance 'point))) (with-slots ((p :prefix p- :class point :use-accessors T)) (incf p-x 42) (incf p-y 42) (list p-x p-y)))(42 42)

ANSI CLでは、下記のように書けるかと思います。

(let ((p (make-instance 'point)))
  (with-accessors ((p-x point-x)
                   (p-y point-y)) 
                  p
    (incf p-x 42)
    (incf p-y 42)
    (list p-x p-y)))(42 42) 

(let ((p (make-instance 'point))) (cl:with-slots (x y) p (symbol-macrolet ((p-x x) (p-y y)) (incf p-x 42) (incf p-y 42) (list p-x p-y))))(42 42)

ということで、大体の仕様はわかったので再現してみます。

;; zreclosはaccessor-prefix-classのために使用
(defpackage x3j13/87-002
  (:use zreclos c2cl alexandria)
  (:import-from #+lispworks hcl variable-information) 
  (:shadowing-import-from zreclos defclass)
  (:shadow with-slots defmethod))

#|| アクセサ経由での値の取得なのでクラスからアクセサを計算するユーティリティを定義 ||# (defun compute-slot-accessors (class) (let* ((cpl (class-precedence-list class)) (dslots (mappend (lambda (c) (class-direct-slots c)) cpl))) (mapcar (lambda (slot-name) (cons slot-name (let ((s (find slot-name dslots :key #'slot-definition-name))) (list (slot-definition-writers s) (slot-definition-readers s))))) (mapcar #'slot-definition-name (class-slots class)))))

#|| (compute-slot-accessors (find-class 'point)) → ((x ((setf point-x)) (point-x)) (y ((setf point-y)) (point-y))) ||#

#|| レキシカル変数からインスタンスのクラスを推定する必要がある ||# (defun find-variable-type (name env) (cdr (assoc 'type (nth-value 2 (variable-information name env)))))

#|| :use-accessors指定がT以外の場合はslot-valueへ展開 ||# (defmacro *with-slots (&environment env (&rest instance-form&options) &body body) (let ((binds (mapcan (lambda (inst) (destructuring-bind (var &key (prefix "") class (use-accessors T)) inst (if use-accessors (mapcar (lambda (bind) (destructuring-bind (slot ws rs) bind (declare (ignore ws)) (list (symbolicate prefix slot) `(,(car rs) ,var)))) (compute-slot-accessors (find-class (or class (find-variable-type var env))))) (mapcar (lambda (slot) (list (symbolicate prefix (slot-definition-name slot)) `(slot-value ,var ',(slot-definition-name slot)))) (class-slots (find-class (or class (find-variable-type var env)))))))) instance-form&options))) `(symbol-macrolet ,binds ,@body)))

(defmacro with-slots ((&rest instance-form&options) &body body) `(*with-slots (,@(mapcar (lambda (i) (etypecase i (cons i) (symbol (list i)))) instance-form&options)) ,@body))

#|| defmethod ボディ内でインスタンスのクラスがうまく特定できるように細工する(処理系依存:LispWorks) ||# #+lispworks (defun make-type-decl (gf form env) (multiple-value-bind (_0 _1 _2 _3 _4) (clos::expand-defmethod-1 gf (generic-function-name gf) (class-prototype (generic-function-method-class gf)) form env) (declare (ignore _0 _1 _2)) (mapcar #'list _3 _4))))

#+lispworks (defmacro defmethod (name (&rest binds) &body body &environment env) `(cl:defmethod ,name (,@binds) (declare ,@(make-type-decl (fdefinition name) (list binds body) env)) ,@body))

試してみる

大体のところは再現できたのでマニュアルに記載されている例を確認してみます。

まずは、pointクラスの定義。
X3J13/87-002では、defclass:accessor-prefixという指定が可能でした。
初期の頃は、defstructのような使い勝手が想定されていたようです。こちらはそういうメタクラスを定義してやれば再現可能です。

(defclass point (accessor-prefix-object)
  ((x :initform 0)
   (y :initform 0))
  (:metaclass accessor-prefix-class)
  (:accessor-prefix point-))

pointに対するmoveメソッドとボディ内でのwith-slotsの使用例です。
Flavorsや、CommonObjects等の既存のオブジェクトシステムではdefmethod内でインスタンスのスロットが変数名として記述できましたが、その辺りを意識しつつも総称関数のマルチメソッドにも対応したいという雰囲気を感じます。

(defgeneric move (p dx dy))
(defmethod move ((p point) dx dy)
  (with-slots (p) ;p is known as a point trom the method args
    (setf x (+ x dx) y (+ y dy)))) ; use accessor tunctions

(let ((p (make-instance 'point)))
  (move p 1 1)
  (describe p))
#<point 80102F35AB> is a point
x      1
y      1

より込み入った例ですが、複数のインスタンスを扱った際の名前の競合を解消する方法が示されています。
このような場合は、ANSI CIでは構文をネストする他ないのでより便利に記述できています。

(defgeneric make-same-height (p1 p2))
(defmethod make-same-height ((p1 point) (p2 point))
  ;; use :pretix to make distinction between the two points
  (with-slots ((p1 :prefix p1-) (p2 :prefix p2-))
    (setf p1-y p2-y)))

(let ((p1 (make-instance 'point))
      (p2 (make-instance 'point)))
  (setf (slot-value p2 'y) 42)
  (make-same-height p1 p2)
  (describe p1))
#<point 80101B052B> is a point
x      0
y      42

さらに複雑な例ですが、ネストした構造も記述できたようです。

(defmethod make-horizontal ((l line))
  ;; it is necessary to specify the class or point explicitly,
  ;; because there is no lexical way to determine it
  (with-slots (((left-point l) :class point :prefix left-)
               ((right-point l) :class point :pretix right-))
    (setf left-y right-y)))

恐らく上記のlineのクラス定義は、

(defclass line ()
  ((left-point :initform (make-instance 'point) :accessor left-point)
   (right-point :initform (make-instance 'point) :accessor right-point)))

のようなものかと思います。マクロ展開を想像するに、

(let ((l (make-instance 'line)))
  (with-slots ((l :class line))
    (with-slots ((left-point :class point :prefix left-)
                 (right-point :class point :prefix right-))
      (setf left-y right-y))))

のようになることが想定されますが、ネスト部の記述の暗黙のルールが不明瞭なので、今回は再現しません。
ネストすると、インスタンスのクラスが推定できないために、:classを指定する必要がある、とのことですが、defclassでもスロットに:type指定可能なので、そこから推定できるのではないかと思えなくもありません。

まとめ

X3J13のwith-slotsはなかなか便利な構文仕様なのですが、Common Lispのオブジェクトシステムの初期構想段階ではコンパイル時に色々確定させるのか、実行時にコードの字面の辻褄が合えば良いのかのポリシーがANSI CLよりは曖昧だったことが察せられる気はします。

Flavorsはオブジェクトシステムとしては当時のコンピュータリソースの制限からANSI CLよりずっと静的で、クラスの再定義の際には依存関係を適切に再コンパイルしなおしたりが必要なため開発体験としては適切に扱うのがやや難しいこともあったようです。
ANSI CLではその辺りのバランスが整えられたのだと思いますが、今度はスピードが遅いという認識が広まって今に至るという印象を持ちます。なかなか難しい。


HTML generated by 3bmd in LispWorks 8.0.1

comments powered by Disqus