[elephant-cvs] CVS elephant/src/elephant

[ieslick]

Update of /project/elephant/cvsroot/elephant/src/elephant
In directory clnet:/tmp/cvs-serv17716/src/elephant

Modified Files:
	classes.lisp classindex.lisp collections.lisp metaclasses.lisp 
	serializer2.lisp 
Log Message:
Fixes submitted by Henrik; some OpenMCL changes

--- /project/elephant/cvsroot/elephant/src/elephant/classes.lisp	2007/03/19 19:41:35	1.22
+++ /project/elephant/cvsroot/elephant/src/elephant/classes.lisp	2007/03/21 14:29:30	1.23
@@ -240,18 +240,19 @@
 
 (defmethod slot-boundp-using-class ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
   "Checks if the slot exists in the database."
-  (let ((name (slot-definition-name slot-def)))
-    (persistent-slot-boundp (get-con instance) instance name)))
+  (when instance
+    (let ((name (slot-definition-name slot-def)))
+      (persistent-slot-boundp (get-con instance) instance name))))
 
 (defmethod slot-boundp-using-class ((class persistent-metaclass) (instance persistent-object) (slot-name symbol))
   "Checks if the slot exists in the database."
   (loop for slot in (class-slots class)
-	for matches-p = (eq (slot-definition-name slot) slot-name)
-	until matches-p
-	finally (return (if (and matches-p
-				 (subtypep (type-of slot) 'persistent-slot-definition))
-			    (persistent-slot-boundp (get-con instance) instance slot-name)
-			    (call-next-method)))))
+     for matches-p = (eq (slot-definition-name slot) slot-name)
+     until matches-p
+     finally (return (if (and matches-p
+			      (subtypep (type-of slot) 'persistent-slot-definition))
+			 (persistent-slot-boundp (get-con instance) instance slot-name)
+			 (call-next-method)))))
 
 (defmethod slot-makunbound-using-class ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
   "Removes the slot value from the database."
--- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2007/03/19 19:41:35	1.29
+++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2007/03/21 14:29:30	1.30
@@ -430,7 +430,7 @@
 
 (defmethod get-instances-by-range ((class persistent-metaclass) idx-name start end)
   (declare (type (or fixnum null) start end)
-	   (type string idx-name))
+	   (type symbol idx-name))
   (let ((instances nil))
     (declare (type list instances))
     (flet ((collector (k v pk)
--- /project/elephant/cvsroot/elephant/src/elephant/collections.lisp	2007/03/18 20:40:50	1.14
+++ /project/elephant/cvsroot/elephant/src/elephant/collections.lisp	2007/03/21 14:29:30	1.15
@@ -348,17 +348,20 @@
     (string (string<= a b))
     (persistent (<= (oid a) (oid b)))))
 
-(defmethod map-index (fn (index btree-index) &rest args &key start end)
+(defmethod map-index (fn (index btree-index) &rest args &key (start nil start-supplied-p) (end nil end-supplied-p))
   "Like map-btree, but takes a function of three arguments key, value and primary key
    if you want to get at the primary key value, otherwise use map-btree"
-  (declare (dynamic-extent args))
+  (declare (dynamic-extent args)
+	   (ignorable args))
   (let ((sc (get-con index)))
     (ensure-transaction (:store-controller sc)
       (with-btree-cursor (cur index)
 	(labels ((next-range ()
 		   (multiple-value-bind (exists? skey val pkey) (cursor-pnext-nodup cur)
-		     (if (or (and exists? (not end))
-			     (and exists? (lisp-compare<= skey end)))
+		     (if (and exists? 
+			      (or (not end-supplied-p)
+				  (null end)
+				  (lisp-compare<= skey end)))
 		       (progn
 			 (funcall fn skey val pkey)
 			 (next-in-range skey))
@@ -373,12 +376,14 @@
 			   (cursor-pset-range cur key)
 			   (next-range))))))
 	  (declare (dynamic-extent next-range next-in-range))
-	  (multiple-value-bind (exists? skey val pkey) 
-	      (if start
+	  (multiple-value-bind (exists? skey val pkey)
+	      (if (and start-supplied-p (not (null start)))
 		  (cursor-pset-range cur start)
 		  (cursor-pfirst cur))
-	    (if (or (and exists? (not end))
-		    (and exists? (lisp-compare<= skey end)))
+	    (if (and exists? 
+		     (or (not end-supplied-p)
+			 (null end)
+			 (lisp-compare<= skey end)))
 		(progn
 		  (funcall fn skey val pkey)
 		  (next-in-range skey))
--- /project/elephant/cvsroot/elephant/src/elephant/metaclasses.lisp	2007/03/19 19:41:35	1.11
+++ /project/elephant/cvsroot/elephant/src/elephant/metaclasses.lisp	2007/03/21 14:29:30	1.12
@@ -304,7 +304,7 @@
   (declare (ignore slot-name))
   (apply #'make-effective-slot-definition class
 	 (compute-effective-slot-definition-initargs 
-	 class slot-name direct-slot-definitions)))
+	 class direct-slot-definitions)))
 
 #+openmcl
 (defmethod compute-effective-slot-definition-initargs ((class slots-class)
--- /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp	2007/03/19 20:51:28	1.32
+++ /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp	2007/03/21 14:29:31	1.33
@@ -168,7 +168,7 @@
 		    (buffer-write-byte +fixnum32+ bs)
 		    (buffer-write-int32 frob bs))
 		  (progn
-		    (assert (< #.most-positive-fixnum +2^63+))
+		    (assert (eq (< #.most-positive-fixnum +2^63+) t))
 		    (if (< (abs frob) +2^31+)
 			(progn
 			  (buffer-write-byte +fixnum32+ bs)
@@ -343,7 +343,7 @@
 
 (defparameter *tag-table*
   `((,+fixnum32+ . "fixnum32")
-    (,+fixnum64+ . "fixnum32")
+    (,+fixnum64+ . "fixnum64")
     (,+char+ . "char")
     (,+short-float+ . "short-float")
     (,+single-float+ . "single-float")