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

Better handling of slot redefinition.

parent 71abee59

disk.lisp

+6 −5
Original line number Diff line number Diff line
@@ -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))

    class))



;;; 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+)

mop.lisp

+21 −16
Original line number Diff line number Diff line
@@ -18,6 +18,9 @@ 
   (slot-locations-and-initforms

    :initform nil

    :accessor slot-locations-and-initforms)

   (slot-locations-and-initforms-read

    :initform nil

    :accessor slot-locations-and-initforms-read)

   (all-slot-locations-and-initforms

    :initform nil

    :accessor all-slot-locations-and-initforms)
@@ -125,23 +128,25 @@ 
	       (slot-definition-initform slot-definition)))

       slot-definitions))



(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)

                                 'simple-vector)))

    (setf (slots-to-store class)

          slots-to-store)

    (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)

		  'simple-vector))

    (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)

    slots))



(defun find-slot (slot-name class)

  (find slot-name (class-slots class)