#:g1: AoSなインスタンス

Posted 2020-12-02 17:23:01 GMT

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

以前、MOPでSoAというのを試してみたのですが、今回はSoAの逆のAoSを試してみたいと思います。

AoSとは、構造体を並べた配列でArray of Structuresの略ですが、Common Lispにはdisplaced arrayという配列の一部を別の配列として利用する機能があるので、一本の巨大な配列を細切れにして分配してみます。

AoSを確保する部分とallocate-instaceが骨子ですが、その部分だけを抜き出すと下記のようになります。

(defparameter *aos* 
  (make-array (1- array-total-size-limit) :initial-element *slot-unbound*))

(defmethod allocate-instance ((class aos-slots-class) &rest initargs)
  (alloc-fix-instance (class-wrapper class)
                      (let* ((len (length (class-slots class)))
                             (obj (make-array len
                                              :displaced-to *aos*
                                              :displaced-index-offset (class-index class))))
                        (incf (class-index class) len)
                        obj)))

試してみる

インスタンスを定義してから10回make-instanceして、ストレージの配列を観察してみます。

(defclass foo (aos-slots-object)
  ((a :initform 'a)
   (b :initform 'b)
   (c :initform 'c))
  (:metaclass aos-slots-class))

(dotimes (i 10)
  (make-instance 'foo))

(subseq *aos* 0 30)
→ #(a b c a b c a b c a b c a b c a b c a b c a b c a b c a b c)

ストレージの配列のを眺めてしまうと、アクセス時に間違って混ざったりちゃいそうに見えますが、displaced arrayのお蔭でインスタンスは個別の領域のみアクセスしています。

実装

大体こんな感じになります。
インスタンスのストレージの中身の操作については、前回の定義を参照してください。 

(defclass aos-slots-class (standard-class)
  ((index :initform 0 :accessor class-index)))

(defmethod shared-initialize :after ((class aos-slots-class) slots &rest initargs)
  (setf (class-index class) 0))

(defclass aos-slots-object (standard-object)
  ()
  (:metaclass aos-slots-class))

(defmethod validate-superclass ((class aos-slots-class) (super standard-class))
  T)

(defparameter *aos* 
  (make-array (1- array-total-size-limit) :initial-element *slot-unbound*))

(defmethod allocate-instance ((class aos-slots-class) &rest initargs)
  (alloc-fix-instance (class-wrapper class)
                      (let* ((len (length (class-slots class)))
                             (obj (make-array len
                                              :displaced-to *aos*
                                              :displaced-index-offset (class-index class))))
                        (incf (class-index class) len)
                        obj)))

(defmethod slot-value-using-class
           ((class aos-slots-class) instance (slotd slot-definition))
  (elt (instance-slots instance)
       (slot-definition-location slotd)))

(defmethod (setf slot-value-using-class)
           (val (class aos-slots-class) instance (slotd slot-definition))
  (setf (elt (instance-slots instance)
             (slot-definition-location slotd))
        val))

(defgeneric initialize-slot-from-initarg (class instance slotd initargs))
(defmethod initialize-slot-from-initarg (class instance slotd initargs)
  (let ((slot-initargs (slot-definition-initargs slotd)))
    (loop :for (initarg value) :on initargs :by #'cddr
          :do (when (member initarg slot-initargs)
                (setf (slot-value-using-class class instance slotd)
                      value)
                (return T)))))

(defgeneric initialize-slot-from-initfunction (class instance slotd))
(defmethod initialize-slot-from-initfunction (class instance slotd)
  (let ((initfun (slot-definition-initfunction slotd)))
    (unless (not initfun)
      (setf (slot-value-using-class class instance slotd)
            (funcall initfun)))))

(defmethod shared-initialize 
           ((instance aos-slots-object) slot-names &rest initargs)
  (let ((class (class-of instance)))
    (dolist (slotd (class-slots class))
      (unless (initialize-slot-from-initarg class instance slotd initargs)
        (when (or (eq t slot-names)
                  (member (slot-definition-name slotd) slot-names))
          (initialize-slot-from-initfunction class instance slotd)))))
  instance)

まとめ

似たようなものを色々定義していますが、スロットを有するオブジェクトについては一つslotted-class&slotted-objectにまとめられそうです。

Lispにおいてスロットを有すると考えられるオブジェクトは沢山ありますが、

—あたりは統一的な操作体系でまとめられるでしょう。

定義が長いのでそのうちGitHub等にでも置こうかなと思います。

■

HTML generated by 3bmd in LispWorks 7.0.0

comments powered by Disqus