|
Revision 3942, 1.0 kB
(checked in by hans, 4 months ago)
|
Merge from anon-transaction-fixes-2 branch. This changeset removes
make-object and initialize-persistent-instance, makes the allocation
of object IDs simpler and more safe and removes several relicts from
previous refactoring iterations. Also, the store tests have been
extended significantly to test pathological cases and create objects
from multiple threads.
|
| Line | |
|---|
| 1 |
(in-package :bknr.utils) |
|---|
| 2 |
|
|---|
| 3 |
;;; short form for DEFCLASS |
|---|
| 4 |
|
|---|
| 5 |
(defun compute-bknr-slot (class slot) |
|---|
| 6 |
(destructuring-bind (name access &rest rest) slot |
|---|
| 7 |
(let* ((initarg (make-keyword-from-string (symbol-name name))) |
|---|
| 8 |
(accessor (intern (concatenate 'string (symbol-name class) "-" |
|---|
| 9 |
(symbol-name name)) *package*))) |
|---|
| 10 |
(unless (getf rest :transient) |
|---|
| 11 |
(push initarg rest) |
|---|
| 12 |
(push :initarg rest)) |
|---|
| 13 |
(case access |
|---|
| 14 |
(:read |
|---|
| 15 |
(push accessor rest) |
|---|
| 16 |
(push :reader rest)) |
|---|
| 17 |
(:update |
|---|
| 18 |
(push accessor rest) |
|---|
| 19 |
(push :accessor rest)) |
|---|
| 20 |
(:none) |
|---|
| 21 |
(t (error "unknown access option ~A in slot ~A of class ~A." |
|---|
| 22 |
access slot class))) |
|---|
| 23 |
(cons name rest)))) |
|---|
| 24 |
|
|---|
| 25 |
(defmacro define-bknr-class (class (&rest superclasses) slots &rest class-options) |
|---|
| 26 |
(let ((slots (mapcar (lambda (slot) (compute-bknr-slot class slot)) slots))) |
|---|
| 27 |
;; the eval-when is there to create the index access functions at compile time |
|---|
| 28 |
`(eval-when (:compile-toplevel :load-toplevel :execute) |
|---|
| 29 |
(defclass ,class ,superclasses |
|---|
| 30 |
,slots |
|---|
| 31 |
,@class-options)))) |
|---|
| 32 |
|
|---|
