オブジェクトシステム(CLOS) MOP

匿名クラスをつくりたい

匿名クラスは名前がNILのクラスとなり、standard-classのインスタンスとして作成できるでしょう。

(defclass foo ()
  ((x :initarg :x :accessor foo-x)))

;; fooを継承した匿名クラス FIXME
(let ((anon (make-instance 'standard-class
                           :direct-superclasses
                           (list (find-class 'foo))
                           :direct-slots
                           ;; スロット(Y)を追加
                           '((:name y)))))
  (let ((inst (make-instance anon :x 42)))
    (with-slots (y) inst
      (setf y 100)
      (list (foo-x inst) y))))
;=> (42 100)

;; 匿名クラス(a)を継承した匿名クラス(b)
(let* ((a (make-instance 'standard-class
                         :direct-superclasses '()
                         :direct-slots '((:name a :initargs (:a)))))
       (b (make-instance 'standard-class
                         :direct-superclasses (list a)
                         :direct-slots '((:name b :initargs (:b))))))
  (let ((inst (make-instance b :a 0 :b 1)))
    (describe inst)))
;->  #<#<STANDARD-CLASS NIL {101A8BC263}> {101A96F4B3}>
;      [standard-object]
;
;    Slots with :INSTANCE allocation:
;      A  = 0
;      B  = 1
;
;=>  No value

;; 複数生成された場合、class-nameはNILになるものの別々クラスとなる
(let ((anon1(make-instance 'standard-class
                           :direct-superclasses
                           (list (find-class 'foo))
                           :direct-slots
                           ;; スロット(Y)を追加
                           '((:name y))))
      (anon2 (make-instance 'standard-class
                            :direct-superclasses
                            (list (find-class 'foo))
                            :direct-slots
                            ;; スロット(Y)を追加
                            '((:name y)))))
  (let ((inst1 (make-instance anon1 :x 42))
        (inst2 (make-instance anon2 :x 97)))
    (with-slots (y) inst1
      (setf y 100)
      (list (foo-x inst1) 
            y
            (foo-x inst2)
            :class-name
            (list (class-name (class-of inst1))
                  (class-name (class-of inst2)))
            :class=
            (eq (class-of inst1)
                (class-of inst2))))))
;=>  (42 100 97 :CLASS-NAME (NIL NIL) :CLASS= NIL)

参考

• Metaobject Initialization Protocols