[rucksack-devel] delete-instances method

[Uwe von Loh]

Arthur Lemmens wrote:

> Thanks, I followed your suggestion and added the functions
> RUCKSACK-DELETE-OBJECT and RUCKSACK-DELETE-OBJECTS, based on
> your example implementation.  I committed these functions to
> CVS, but I haven't tested them yet.

Henriks DELETE-function saved me two weeks of guessing but it works for 
classes with direct slots only. Indexes of derived slots are indexed 
with the classes they are defined in. I assume this is the more general 
way of indexing slots because all are in one place then. Here is my 
"disimprovement" for deleting instances with direct and derived slots 
from all indexes. Caution, this is slow code. I'm not so familiar with 
real programming yet.
Uwe 8-)


(defmethod delete-instances ((rucksack standard-rucksack) instances)
   (let ((rucksack-roots (rucksack-roots rucksack)))
     (flet ((delete-instance (instance)
	     (let ((class-index
		    (rucksack-class-index
		     rucksack (class-of instance) :errorp nil))
		   (slot-indexes (slot-indexes-of (class-of instance)))
		   (oid (object-id instance)))
	       (when class-index
		 (index-delete class-index oid oid))
	       (when slot-indexes

		 (loop for slot-index in slot-indexes do
		      (when (slot-boundp instance (cadr slot-index))
			(index-delete (rucksack-slot-index rucksack
							   (car slot-index)
							   (cadr slot-index))
				      (slot-value instance (cadr slot-index))
				      oid :if-does-not-exist :ignore))))
	       (when (member oid rucksack-roots)
		 (delete-rucksack-root instance rucksack)))))
       (mapcar #'delete-instance instances))))

(defun slot-indexes-of (myclass)
   (mapcan #'indexed-direct-slots (maybe-indexed-superclasses-of myclass)))

(defun indexed-direct-slots (myclass)
   (with-rucksack (rs *uwes-rs*)
	(with-transaction ()
	  (let ((slots  (rucksack-indexed-slots-for-class rs myclass)))
		(if slots (mapcar #'(lambda (x) (list (class-name myclass) x))slots))))))
	
(defun maybe-indexed-superclasses-of (myclass)
   (let ((superclasses (class-direct-superclasses myclass)))
     (delete-duplicates (adjoin myclass (mapcan 
#'maybe-indexed-superclasses-of superclasses)))))