Commit 80137e77 authored by Stas Boukarev's avatar Stas Boukarev
Browse files

Don't store relations on disk, I forgot to store relations slot and

with its content stored it doesn't offset the time saved during
interlinking.
parent ca92680d
...@@ -526,7 +526,8 @@ ...@@ -526,7 +526,8 @@
(let ((*storage* storage) (let ((*storage* storage)
(*indexes* *indexes*)) (*indexes* *indexes*))
(clear-cashes) (clear-cashes)
(read-file (or file (storage-file *storage*))))) (read-file (or file (storage-file *storage*)))
(interlink-all-objects-first-time)))
(defun save-data (storage &optional file) (defun save-data (storage &optional file)
(let ((*storage* storage)) (let ((*storage* storage))
......
...@@ -101,6 +101,34 @@ ...@@ -101,6 +101,34 @@
(interlink-slots object (interlink-slots object
(standard-instance-access object loc) (standard-instance-access object loc)
relation))) relation)))
;;;
(defun interlink-all-objects-first-time ()
(map-data
(lambda (class objects)
(declare (ignore class))
(loop for object in objects
do (interlink-objects-first-time object)))))
(defun link-slot-first-time (relation object target-object)
(if (and (consp relation)
(eql (car relation) :slot))
(push object (slot-value target-object (cadr relation)))
(push object (getf (relations target-object) relation))))
(defun interlink-slots-first-time (object slot-value relation)
(do-maybe-list (target slot-value)
(when (typep target 'identifiable)
(link-slot-first-time relation object target))))
(defun interlink-objects-first-time (object)
(loop for (loc . relation) in (class-relations (class-of object))
do
(interlink-slots-first-time object
(standard-instance-access object loc)
relation)))
;;; ;;;
(defun clear-cashes () (defun clear-cashes ()
......
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