#:g1: MOPでSoA

Posted 2019-12-17 17:58:29 GMT

構造体の配列を作成する方法として、

があるようですが、SoAの方が効率が良いらしいです。

Common Lispでいうと、インスタンスの配列を作成するか、インスタンスのスロットを配列にするかになりますが、MOP細工でインスタンスのスロットは配列にはせずに通常のままでSoAな構成にしてみよう、というのが今回の趣旨です。

といった風に構成してみました。
LispWorks依存ですが、standard-objectの構造はメジャーどころは大体一緒なので移植は簡単だと思います。

動作

(defclass 🐱 (soa-object)
  ((a :initform 0 :type bit :initarg :a)
   (b :initform #\. :type character :initarg :b)
   (c :initform nil :type boolean :initarg :c))
  (:metaclass soa-class)
  (:pool-size 0))

(instance# (class-prototype (find-class '🐱))) → 0

(class-slot-vectors (find-class '🐱))((a . #*) (b . "") (c . #()))

(set '🐱 (make-instance '🐱 :a 0 :b #\- :c T)) → #<🐱 40201E2BFB>

(mapcar (lambda (s) (cons (car s) (elt (cdr s) (instance# 🐱)))) (class-slot-vectors (find-class '🐱)))((a . 0) (b . #\-) (c . t))

(dotimes (i 100) (make-instance '🐱 :a 1 :b #\. :c nil)) → nil

(class-slot-vectors (find-class '🐱))((a . #*001111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111) (b . "-....................................................................................................") (c . #(nil t nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil)))

(with-slots (a b c) (make-instance '🐱 :a 1 :b #\. :c nil) (list a b c))(1 #\. nil)

実装

堅牢性に難ありですが、概念実証くらいにはなるかなというところです。

(defpackage "e477e14c-8275-5c00-82d3-82f8adcd1567"
  (:use :c2cl))

(in-package "e477e14c-8275-5c00-82d3-82f8adcd1567")

(defclass soa-class (standard-class) ((pool-size :initform 256 :accessor instance-pool-size :initarg :pool-size) (instance-index :initform 0 :accessor instance-index) (slot-vectors :initform nil :accessor class-slot-vectors)))

(defmethod validate-superclass ((c soa-class) (s standard-class)) T)

(defclass soa-object () () (:metaclass Soa-class))

(defun instance# (soa-object) (clos::%svref Soa-object 1))

(defmethod allocate-instance ((class soa-class) &rest initargs) (let* ((class (clos::ensure-class-finalized class))) (prog1 (sys:alloc-fix-instance (clos::class-wrapper class) (instance-index class)) (incf (instance-index class)))))

(defmethod shared-initialize ((instance soa-object) slot-names &rest initargs) (flet ((initialize-slot-from-initarg (class instance slotd) (let ((slot-initargs (slot-definition-initargs slotd)) (name (slot-definition-name slotd))) (loop :for (initarg value) :on initargs :by #'cddr :do (when (member initarg slot-initargs) (setf (slot-value-using-class class instance name) value) (return t))))) (initialize-slot-from-initfunction (class instance slotd) (let ((initfun (slot-definition-initfunction slotd)) (name (slot-definition-name slotd))) (unless (not initfun) (setf (slot-value-using-class class instance name) (funcall initfun)))))) (let ((class (class-of instance))) (dolist (slotd (class-slots class)) (unless (initialize-slot-from-initarg class instance slotd) (when (or (eq t slot-names) (member (slot-definition-name slotd) slot-names)) (initialize-slot-from-initfunction class instance slotd))))) instance))

(defun soa-instance-access (class obj key) (elt (cdr (assoc key (class-slot-vectors class))) (instance# obj)))

(defun (setf soa-instance-access) (val class obj key) (when (> (instance# obj) (1- (instance-pool-size class))) (setf (instance-pool-size class) (1+ (instance# obj))) (dolist (slot (class-slot-vectors class)) (adjust-array (cdr slot) (instance-pool-size class)))) (setf (elt (cdr (assoc key (class-slot-vectors class))) (instance# obj)) val))

(defmethod slot-value-using-class ((c Soa-class) inst slot-name) (soa-instance-access c inst slot-name))

(defmethod (setf slot-value-using-class) (newvalue (c Soa-class) inst slot-name) (setf (soa-instance-access c inst slot-name) newvalue))

(defmethod ensure-class-using-class :after ((class soa-class) name &rest initargs &key) (when (consp (instance-pool-size class)) (setf (instance-pool-size class) (car (instance-pool-size class)))) (setf (class-slot-vectors class) (mapcar (lambda (s) (cons (slot-definition-name s) (make-array (instance-pool-size class) :element-type (or (slot-definition-type s) T) :adjustable T :initial-element (funcall (slot-definition-initfunction s))))) (class-slots class))))

まとめ

Common LispはC風に効率よく構造体を配列に詰められないのか、等々の質問はたまにみかけるのですが、今回のように高次のデータ構造的に記述して低次のデータ構造にマッピングする方法もなくはないかなとは思います。
直截的な回答としてはFFIでメモリの塊をいじる方法などになりそうですが。


HTML generated by 3bmd in LispWorks 7.0.0

comments powered by Disqus