:accessor object-definition
:initarg :definition
:initform nil)
- (version
- :accessor object-version
- :initarg :version
- :initform 0)
(key-slots
:accessor key-slots
:initform nil)
result))
#+lispworks
-(defconstant +extra-class-options+ '(:base-table :version :schemas))
+(defconstant +extra-class-options+ '(:base-table))
#+lispworks
(defmethod clos::canonicalize-class-options :around
(defmethod initialize-instance :around ((class standard-db-class)
&rest all-keys
&key direct-superclasses base-table
- schemas version qualifier
+ qualifier
&allow-other-keys)
(let ((root-class (find-class 'standard-db-object nil))
(vmc (find-class 'standard-db-class)))
(car base-table)
base-table))
(class-name class)))))
- (setf (object-version class) version)
- (mapc (lambda (schema)
- (pushnew (class-name class) (gethash schema *object-schemas*)))
- (if (listp schemas) schemas (list schemas)))
(register-metaclass class (nth (1+ (position :direct-slots all-keys))
all-keys))))
(defmethod reinitialize-instance :around ((class standard-db-class)
&rest all-keys
- &key base-table schemas version
+ &key base-table
direct-superclasses qualifier
&allow-other-keys)
(let ((root-class (find-class 'standard-db-object nil))
direct-superclasses)
(remove-keyword-arg all-keys :direct-superclasses)))
(call-next-method)))
- (setf (object-version class) version)
- (mapc (lambda (schema)
- (pushnew (class-name class) (gethash schema *object-schemas*)))
- (if (listp schemas) schemas (list schemas)))
(register-metaclass class (nth (1+ (position :direct-slots all-keys))
all-keys)))
(let ((slots (call-next-method))
desired-sequence
output-slots)
-
(dolist (c (compute-class-precedence-list class))
(dolist (s (class-direct-slots c))
(let ((name (slot-definition-name s)))
(unless (find name desired-sequence)
- (setq desired-sequence (append desired-sequence (list name)))))))
- ;; desired-sequence is reversed at this time
+ (push name desired-sequence)))))
(dolist (desired desired-sequence)
(let ((slot (find desired slots :key #'slot-definition-name)))
(assert slot)
(push slot output-slots)))
-
- (nreverse output-slots)))
+ output-slots))
(defun compute-lisp-type-from-slot-specification (slotd specified-type)
"Computes the Lisp type for a user-specified type. Needed for OpenMCL
(defun slotdef-for-slot-with-class (slot class)
(find-if #'(lambda (d) (eql slot (slot-definition-name d)))
- (ordered-class-slots class)))
+ (class-slots class)))
#+ignore
(eval-when (:compile-toplevel :load-toplevel :execute)