Commit 41dd636b authored by Stas Boukarev's avatar Stas Boukarev
Browse files

Better handling of slot redefinition.

parent 71abee59
......@@ -452,11 +452,12 @@
(let* ((length (read-n-bytes +sequence-length+ stream))
(vector (make-array length)))
(loop for i below length
for slot-d =
(slot-effective-definition class (read-next-object stream))
do (setf (aref vector i)
(slot-effective-definition class
(read-next-object stream))))
(setf (slots-to-store class) vector)
(initialize-class-slots class :slots-to-store-only t))
(cons (slot-definition-location slot-d)
(slot-definition-initform slot-d))))
(setf (slot-locations-and-initforms-read class) vector))
;;; identifiable
......@@ -513,7 +514,7 @@
(let* ((instance (get-instance
(read-n-bytes +id-length+ stream)))
(class (class-of instance))
(slots (slot-locations-and-initforms class)))
(slots (slot-locations-and-initforms-read class)))
(declare (simple-vector slots))
(loop for slot-id = (read-n-bytes 1 stream)
until (= slot-id +end+)
......@@ -18,6 +18,9 @@
:initform nil
:accessor slot-locations-and-initforms)
:initform nil
:accessor slot-locations-and-initforms-read)
:initform nil
:accessor all-slot-locations-and-initforms)
......@@ -125,23 +128,25 @@
(slot-definition-initform slot-definition)))
(defun initialize-class-slots (class &key slots-to-store-only)
(defun initialize-class-slots (class slots)
(let* ((slots-to-store (coerce (remove-if-not #'store-slot-p slots)
(setf (slots-to-store class)
(setf (slot-locations-and-initforms class)
(make-slots-cache (slots-to-store class)))
(unless slots-to-store-only
(make-slots-cache slots-to-store))
(setf (all-slot-locations-and-initforms class)
(make-slots-cache (class-slots class))
(class-initforms class)
(map 'vector #'slot-definition-initform (class-slots class)))))
(defmethod finalize-inheritance :after ((class storable-class))
(let ((slots (class-slots class)))
(setf (slot-value class 'slots-to-store)
(coerce (remove-if-not #'store-slot-p slots)
(initialize-class-slots class)
(compute-search-key class slots)
(setf (class-relations class) (slots-with-relations class))))
(make-slots-cache slots))
(setf (class-initforms class)
(map 'vector #'slot-definition-initform slots))
(setf (class-relations class)
(slots-with-relations class))
(compute-search-key class slots)))
(defmethod compute-slots :around ((class storable-class))
(let ((slots (call-next-method)))
(initialize-class-slots class slots)
(defun find-slot (slot-name class)
(find slot-name (class-slots class)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment