#:g1: 多次元配列で隠しスロット

allocate-instance Advent Calendar 2020 9日目の記事です。

以前、初期MOPの文献で、隠しスロットの実例としてスロットにfacetをつけるというのを紹介しましたが、こちらの例では隠しスロットは、本スロットと交代の並びで追加されるので、本スロットの位置×2で位置を求めたりしていました。

• MOPで隠しスロットの実現

しかし、ストレージを一次元配列ではなく、多次元配列にしてしまえば、値のインデックスはそのままで指定の次元アクセスすれば対応した場所にアクセスできて便利なのではないかと思ったので、試してみました。

(defpackage "493c1b0d-ff75-5a3a-9872-43d488f33914"
  (:use c2cl slotted-objects))

(in-package "493c1b0d-ff75-5a3a-9872-43d488f33914")

(defclass faceted-slot-class (slotted-class) 
  ())

(defclass faceted-slot-object (slotted-object) 
  ()
  (:metaclass faceted-slot-class))

(defconstant slot-dim 0)

(defconstant facet-dim 1)

(defmethod allocate-instance ((class faceted-slot-class) &rest initargs)
  (declare (ignore initargs))
  (allocate-slotted-instance (class-wrapper class)
                          (make-array `(2 ,(length (class-slots class)))
                                      :initial-element (make-unbound-marker))))

(defmethod slot-value-using-class ((class faceted-slot-class) instance (slotd slot-definition))
  (aref (instance-slots instance) slot-dim (slot-definition-location slotd)))

(defmethod (setf slot-value-using-class) (value (class faceted-slot-class) instance (slotd slot-definition))
  (setf (aref (instance-slots instance) slot-dim (slot-definition-location slotd))
        value))

(defun facet-missing (instance facet-name)
  (error "The facet ~S is missing from the object ~S" facet-name instance))

(defun slot-facet (instance slot-name)
  (aref (instance-slots instance) 
        facet-dim
        (slot-definition-location 
         (or (find slot-name (class-slots (class-of instance)) :key #'slot-definition-name)
             (facet-missing instance slot-name)))))

(defun (setf slot-facet) (value instance slot-name)
  (setf (aref (instance-slots instance) 
              facet-dim
              (slot-definition-location 
               (or (find slot-name (class-slots (class-of instance)) :key #'slot-definition-name)
                   (facet-missing instance slot-name))))
        value))

動作

(defclass zot (faceted-slot-object)
  ((a :initform 42)
   (b :initform 43)
   (c :initform 44))
  (:metaclass faceted-slot-class))
(describe (make-instance 'zot))
⇒
#<zot 41601B9CD3> is a zot
a      42
b      43
c      44
;;; facetに値を設定
(let ((o (make-instance 'zot)))
  (setf (slot-facet o 'a) 'facet-a)
  (setf (slot-facet o 'b) 'facet-b)
  (setf (slot-facet o 'c) 'facet-c)
  (mapcar (lambda (s)
            (list (slot-value o s)
                  (slot-facet o s)))
          '(a b c)))
→ ((42 facet-a) (43 facet-b) (44 facet-c)) 

まとめ

やはりスロットに一対一で対応するような隠しスロットには一本のベクタで配置を工夫するよりは、多次元配列の方が安直に実装できます。
スロットにフラグを持たせる場所としては便利そうですが、さて実用的にはどうなのか……。

■

HTML generated by 3bmd in LispWorks 7.0.0