Skip to content

Instantly share code, notes, and snippets.

@guicho271828
Created November 21, 2017 06:26
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save guicho271828/22b30038f3e2fdf984338b33fe585418 to your computer and use it in GitHub Desktop.
(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))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment