Commit 8781904d authored by Stas Boukarev's avatar Stas Boukarev
Browse files

Improve compatibility with lesser implmenentations.

parent 306b62fe
Loading
Loading
Loading
Loading
+1 −1
Original line number Diff line number Diff line
@@ -233,7 +233,7 @@
  (write-n-signed-bytes n +fixnum-length+ stream))

(defun write-bignum (n stream)
  (declare ((and integer (not storage-fixnum)) n))
  (declare (type (and integer (not storage-fixnum)) n))
  (write-n-bytes #.(type-code 'bignum) 1 stream)
  (write-n-bytes (sign n) 1 stream)
  (let* ((fixnum-bits (* +fixnum-length+ 8))
+2 −22
Original line number Diff line number Diff line
@@ -146,10 +146,8 @@
          (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))
(defmethod finalize-inheritance :after ((class storable-class))
  (initialize-class-slots class (class-slots class)))

(defun find-slot (slot-name class)
  (find slot-name (class-slots class)
@@ -174,21 +172,3 @@
(defmethod initialize-instance :after ((class storable-class) &key)
  (when (class-storage class)
    (pushnew class (storage-data (class-storage class)) :test #'eq)))

;;;

(defclass identifiable (standard-object)
  ((id :accessor id
       :initform nil
       :storep nil
       :read-only-p t)
   (relations :initform nil
              :accessor relations
              :storep nil
              :read-only-p t))
  (:metaclass storable-class))

(defgeneric relation (object type))

(defmethod relation (object type)
  (getf (relations object) type))
+18 −0
Original line number Diff line number Diff line
@@ -5,6 +5,24 @@

(in-package #:storage)

(defclass identifiable (standard-object)
  ((id :accessor id
       :initform nil
       :storep nil
       :read-only-p t)
   (relations :initform nil
              :accessor relations
              :storep nil
              :read-only-p t))
  (:metaclass storable-class))

(defgeneric relation (object type))

(defmethod relation (object type)
  (getf (relations object) type))

;;;

(defvar *storage* nil)

(defun objects-of-type (type)