CLOSでオブジェクトのクラスを変更する

Common LispのオブジェクトシステムであるCLOSには、実行時にオブジェクトのクラスを変更する機能や、クラスを再定義するとそのクラスのオブジェクトが新しいクラスのオブジェクトへ変更されるという機能があるそうです。

それぞれの動作を制御するためのメソッドが update-instance-for-different-class と update-instance-for-redefined-class です。

ともに関数名が35文字で、Common Lispの仕様上最長の関数名です。ちなみに、変数名を含めれば least-positive-normalized-double-float などの38文字が最長であるようです。

;;;; update-instance-for-different-class
(defclass class-a ()
  ((a :accessor a-of :initarg :a)
   (b :accessor b-of :initarg :b))
  (:default-initargs :a 1 :b 2))

(defclass class-b ()
  ((a :accessor a-of :initarg :a)
   (c :accessor c-of :initarg :c))
  (:default-initargs :a 10 :c 30))

;; クラスclass-aのオブジェクトを作る。
(defvar obj (make-instance 'class-a))
(describe obj)
;; #<CLASS-A {DB18DD9}>
;;   [standard-object]
;; Slots with :INSTANCE allocation:
;;   A  = 1
;;   B  = 2

;; オブジェクトの暮らすをclass-bに変更する
;; スロット名が同じである場合、そのスロットの値はそのままのようだ
(change-class obj 'class-b)
(describe obj)
;; #<CLASS-B {E38F199}>
;;   [standard-object]
;; Slots with :INSTANCE allocation:
;;   A  = 1
;;   C  = #<unbound slot>

;; オブジェクトのクラスをclass-aに変更する。
;; キーワードパラメータ:bに値を渡す。
(change-class obj 'class-a :b 99)
(describe obj)
;; #<CLASS-A {E38F199}>
;;   [standard-object]
;; Slots with :INSTANCE allocation:
;;   A  = 1
;;   B  = 99

;;; オブジェクトを変換するメソッド
;;; 直接呼ぶことはしない。change-classが呼ばれたときに裏で呼ばれる。
(defmethod update-instance-for-different-class ((prev class-a) (new class-b) &key)
  (setf (a-of new) (a-of prev)
	(c-of new) (b-of prev)))

;; objのクラスをclass-bに変更する。
;; update-instance-for-different-classで定義したとおり、
;; class-aでのスロットbの値が、class-bでのスロットcにセットされた。
(change-class obj 'class-b)
(describe obj)
;; #<CLASS-B {E38F199}>
;;   [standard-object]
;; Slots with :INSTANCE allocation:
;;   A  = 1
;;   C  = 99

;;;; update-instance-for-redefined-class
(defclass class-c ()
  ((hoge :accessor hoge-of :initarg :hoge)
   (fuga :accessor fuga-of :initarg :fuga))
  (:default-initargs :hoge 'a :fuga 'b))

;; クラスclass-cのオブジェクトを作る
(defvar o (make-instance 'class-c))
(describe o)
;; #<CLASS-C {E0E2DA1}>
;;   [standard-object]
;; Slots with :INSTANCE allocation:
;;   HOGE  = A
;;   FUGA  = B

;; class-cを再定義する。
(defclass class-c ()
  ((hoge :accessor hoge-of :initarg :hoge))
  (:default-initargs :hoge 'c))

;; 再定義後、class-cのオブジェクトにアクセスすると、
;; 新しいクラスのオブジェクトへ変換される。
;; :default-initargsの値ではなく、
;; 古いクラスのスロットの値が使われるようだ。
(describe o)
;; #<CLASS-C {E405751}>
;;   [standard-object]
;; Slots with :INSTANCE allocation:
;;   HOGE  = A


(defclass class-c ()
  ((hoge :accessor hoge-of :initarg :hoge)
   (fuga :accessor fuga-of :initarg :fuga))
  (:default-initargs :hoge 'e :fuga 'f))

;; 再定義後のクラスへ変換する際に動作するメソッドを定義する。
(defmethod update-instance-for-redefined-class :before
    ((obj class-c) added deleted plist &key)
  (setf (fuga-of obj) 1000))

;; スロットfugaの値はupdate-instance-for-redefined-classで
;; セットした値になる。
(describe o)
;; #<CLASS-C {E4707B1}>
;;   [standard-object]
;; Slots with :INSTANCE allocation:
;;   HOGE  = A
;;   FUGA  = 1000