[bknr-cvs] r2529 - branches/trunk-reorg/bknr/datastore/src/indices

[hhubner at common-lisp.net]

Author: hhubner
Date: Mon Feb 18 05:35:20 2008
New Revision: 2529

Modified:
   branches/trunk-reorg/bknr/datastore/src/indices/category-index.lisp
   branches/trunk-reorg/bknr/datastore/src/indices/indices.lisp
Log:
Fix warnings.


Modified: branches/trunk-reorg/bknr/datastore/src/indices/category-index.lisp
==============================================================================
--- branches/trunk-reorg/bknr/datastore/src/indices/category-index.lisp	(original)
+++ branches/trunk-reorg/bknr/datastore/src/indices/category-index.lisp	Mon Feb 18 05:35:20 2008
@@ -141,13 +141,11 @@
     (when (and (not (slot-index-index-nil index))
 	       (null key))
       (return-from index-add))
-    (multiple-value-bind (value presentp)
-	(gethash key hash-table)
-      (if presentp
-	  (push object (gethash key hash-table))
-	  (progn
-	    (tree-add-category tree key)
-	    (setf (gethash key hash-table) (list object)))))))
+    (if (nth-value 1 (gethash key hash-table))
+        (push object (gethash key hash-table))
+        (progn
+          (tree-add-category tree key)
+          (setf (gethash key hash-table) (list object))))))
 
 (defmethod index-remove ((index category-index) object)
   (let ((key (slot-value object (slot-index-slot-name index)))

Modified: branches/trunk-reorg/bknr/datastore/src/indices/indices.lisp
==============================================================================
--- branches/trunk-reorg/bknr/datastore/src/indices/indices.lisp	(original)
+++ branches/trunk-reorg/bknr/datastore/src/indices/indices.lisp	Mon Feb 18 05:35:20 2008
@@ -135,11 +135,9 @@
     (when (and (not (slot-index-index-nil index))
 	       (null key))
       (return-from index-add))
-    (multiple-value-bind (value presentp)
-	(gethash key hash-table)
-      (if presentp
-	  (push object (gethash key hash-table))
-	  (setf (gethash key hash-table) (list object))))))
+    (if (nth-value 1 (gethash key hash-table))
+        (push object (gethash key hash-table))
+        (setf (gethash key hash-table) (list object)))))
 
 (defmethod index-remove ((index hash-index) object)
   (let ((key (slot-value object (slot-index-slot-name index)))
@@ -172,11 +170,9 @@
   (labels ((index-object (object class)
 	     (let ((key (class-name class))
 		   (hash-table (slot-index-hash-table index)))
-	       (multiple-value-bind (value presentp)
-		   (gethash key hash-table)
-		 (if presentp
-		     (push object (gethash key hash-table))
-		     (setf (gethash key hash-table) (list object)))))))
+               (if (nth-value 1 (gethash key hash-table))
+                   (push object (gethash key hash-table))
+                   (setf (gethash key hash-table) (list object))))))
     
     (if (class-index-index-superclasses index)
 	(dolist (class (cons (class-of object)
@@ -212,11 +208,9 @@
   (let ((keys (slot-value object (slot-index-slot-name index)))
 	(hash-table (slot-index-hash-table index)))
     (dolist (key keys)
-      (multiple-value-bind (value presentp)
-	  (gethash key hash-table)
-	(if presentp
-	    (push object (gethash key hash-table))
-	    (setf (gethash key hash-table) (list object)))))))
+      (if (nth-value 1 (gethash key hash-table))
+          (push object (gethash key hash-table))
+          (setf (gethash key hash-table) (list object))))))
 
 (defmethod index-remove ((index hash-list-index) object)
   (let ((keys (slot-value object (slot-index-slot-name index)))
@@ -406,7 +400,7 @@
 the new skip-list."
   (let ((new-list (skip-list-index-skip-list new-index)) 
 	(old-list (skip-list-index-skip-list old-index)))
-    (setf (skip-list-index-skip-list new-index) old-list)
+    (setf (skip-list-index-skip-list new-list) old-list)
     new-index))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -419,9 +413,8 @@
 	      :accessor class-skip-index-slot-name)
    (hash-table :accessor class-skip-index-hash-table)))
 
-(defmethod initialize-instance :after ((index class-skip-index) &key (type 'string)
-				       (test #'eql)
-				       slots index-superclasses &allow-other-keys)
+(defmethod initialize-instance :after ((index class-skip-index)
+                                       &key (test #'eql) slots index-superclasses)
   (unless (<= (length slots) 1)
     (error "Can not create slot-index with more than one slot."))
   (with-slots (hash-table slot-name) index