Loading disk.lisp +2 −1 Original line number Diff line number Diff line Loading @@ -526,7 +526,8 @@ (let ((*storage* storage) (*indexes* *indexes*)) (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) (let ((*storage* storage)) Loading storage.lisp +28 −0 Original line number Diff line number Diff line Loading @@ -101,6 +101,34 @@ (interlink-slots object (standard-instance-access object loc) 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 () Loading Loading
disk.lisp +2 −1 Original line number Diff line number Diff line Loading @@ -526,7 +526,8 @@ (let ((*storage* storage) (*indexes* *indexes*)) (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) (let ((*storage* storage)) Loading
storage.lisp +28 −0 Original line number Diff line number Diff line Loading @@ -101,6 +101,34 @@ (interlink-slots object (standard-instance-access object loc) 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 () Loading