(defpackage aligned-structure
  (:use :cl :alexandria :iterate :trivia))

(in-package :aligned-structure)

(defvar *default-allocation-size* 1024)
(defmacro define-aligned-structure (name-and-options &body slots)
  (setf name-and-options (ensure-list name-and-options))
  `(progn (defstruct ,name-and-options
            ,@(iter (for s in slots)
                    (collecting
                     (ematch s
                       ((and name (symbol))
                        `(,name (make-array *default-allocation-size* :adjustable t) :type array))
                       ((list* name default (and (property :type type '*)
                                                 (property :read-only ro nil)))
                        `(,name (make-array *default-allocation-size* :adjustable t
                                            :element-type ',type
                                            :initial-element ,default)
                                :type (array ,type)
                                :read-only ,ro))))))

          ,@(iter (for s in slots)
                  (ematch s
                    ((or (and name (symbol)
                              (<> type '*)
                              (<> ro nil))
                         (list* name _ (plist :type type :read-only ro)))
                     (let* ((accessor (symbolicate (first name-and-options) '- name))
                            (aref     (symbolicate accessor '-aref))
                            (struct (first name-and-options)))
                       (collecting
                        `(declaim (inline ,aref)))
                       (collecting
                        `(declaim (ftype (function (,struct (integer 0 ,array-dimension-limit)) ,type) ,aref)))
                       (collecting
                        `(defun ,aref (objects index)
                           (aref (,accessor objects)
                                 index)))
                       (unless ro
                         (collecting
                          `(declaim (inline (setf ,aref))))
                         (collecting
                          `(declaim (ftype (function (,type ,struct (integer 0 ,array-dimension-limit)) ,type) (setf ,aref))))
                         (collecting
                          `(defun (setf ,aref) (newval objects index)
                             (setf (aref (,accessor objects)
                                         index)
                                   newval))))))))))

(define-aligned-structure points
  (x 0.0d0 :type double-float :read-only t)
  (y 0.0d0 :type double-float)
  (z 0.0d0 :read-only t))