(defstruct (field (:conc-name f.))
  name init type)


(defmethod field ((slot-def sb-mop:effective-slot-definition))
  (make-field :name (sb-mop:slot-definition-name slot-def)
              :init (sb-mop:slot-definition-initform slot-def)
              :type (sb-mop:slot-definition-type slot-def)))


(defstruct soa-meta
  base-fields
  base-name soa-name getter-name setter-name)


(defun soa-meta (base-struct)
  (let ((base-name (sb-mop:class-name base-struct)))
    (make-soa-meta
     :base-name base-name
     :soa-name (intern (format nil "SOA-~a" base-name))
     :getter-name (intern (format nil "~a-SOAREF" base-name))
     :setter-name (intern (format nil "%~a-SET-SOAREF" base-name))
     :base-fields (mapcar #'field
                          (sb-mop:class-slots base-struct)))))


(defun define-constructor (meta)
  (with-slots (soa-name base-fields) meta
    `(defstruct (,soa-name
                 (:constructor ,soa-name (len)))
       ,@(loop for field in base-fields
               collect `(,(f.name field)
                         (make-array len :initial-element ,(f.init field)
                                         :element-type ',(f.type field))
                         :type (simple-array ,(f.type field) (*)))))))


(defun define-accessors (meta)
  (with-slots (getter-name setter-name base-name base-fields) meta
    `(progn
       (declaim (inline ,getter-name ,setter-name))
       (defun ,getter-name (instance index)
         (let ((ret (make-instance ',base-name)))
           ,@(loop for f in base-fields
                   collect
                   `(setf (slot-value ret ',(f.name f))
                          (aref (slot-value instance ',(f.name f))
                                index)))
           ret))
       (defun ,setter-name (instance index value)
         ,@(loop for f in base-fields
                 collect
                 `(setf (aref (slot-value instance ',(f.name f))
                              index)
                        (slot-value value ',(f.name f)))))
       (defsetf ,getter-name ,setter-name))))


(defmacro define-soa-type (base-struct)
  (let ((meta (soa-meta (find-class base-struct))))
    `(progn
       ,(define-constructor meta)
       ,(define-accessors meta))))




;; tests

(defstruct (pt (:constructor pt (x y)))
  (x 0 :type (unsigned-byte 8))
  (y 0 :type fixnum))

(define-soa-type pt)



(soa-pt 10)

The object is a STRUCTURE-OBJECT of type SOA-PT.
X: #(0 0 0 0 0 0 0 0 0 0)
Y: #(0 0 0 0 0 0 0 0 0 0)


(pt-soaref (soa-pt 10) 2)

The object is a STRUCTURE-OBJECT of type PT.
X: 0
Y: 0


(let ((pts (soa-pt 10)))
  (setf (pt-soaref pts 2)
        (pt 30 40))
  pts)

The object is a STRUCTURE-OBJECT of type SOA-PT.
X: #(0 0 30 0 0 0 0 0 0 0)
Y: #(0 0 40 0 0 0 0 0 0 0)



(macroexpand-1 '(define-soa-type pt))

(PROGN
 (DEFSTRUCT (SOA-PT (:CONSTRUCTOR SOA-PT (LEN)))
   (X (MAKE-ARRAY LEN :INITIAL-ELEMENT 0 :ELEMENT-TYPE '(UNSIGNED-BYTE 8))
    :TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)))
   (Y (MAKE-ARRAY LEN :INITIAL-ELEMENT 0 :ELEMENT-TYPE 'FIXNUM) :TYPE
    (SIMPLE-ARRAY FIXNUM (*))))
 (PROGN
  (DECLAIM (INLINE PT-SOAREF %PT-SET-SOAREF))
  (DEFUN PT-SOAREF (INSTANCE INDEX)
    (LET ((RET (MAKE-INSTANCE 'PT)))
      (SETF (SLOT-VALUE RET 'X) (AREF (SLOT-VALUE INSTANCE 'X) INDEX))
      (SETF (SLOT-VALUE RET 'Y) (AREF (SLOT-VALUE INSTANCE 'Y) INDEX))
      RET))
  (DEFUN %PT-SET-SOAREF (INSTANCE INDEX VALUE)
    (SETF (AREF (SLOT-VALUE INSTANCE 'X) INDEX) (SLOT-VALUE VALUE 'X))
    (SETF (AREF (SLOT-VALUE INSTANCE 'Y) INDEX) (SLOT-VALUE VALUE 'Y)))
  (DEFSETF PT-SOAREF %PT-SET-SOAREF)))
T