Update of /project/elephant/cvsroot/elephant/src/db-clsql In directory clnet:/tmp/cvs-serv1238/src/db-clsql

Modified Files: sql-collections.lisp Log Message: Tweaks for lispworks compatability

--- /project/elephant/cvsroot/elephant/src/db-clsql/sql-collections.lisp 2007/02/08 22:33:35 1.10 +++ /project/elephant/cvsroot/elephant/src/db-clsql/sql-collections.lisp 2007/02/26 19:12:18 1.11 @@ -45,8 +45,8 @@ ;; to implement the cursor semantics. Clearly, passing ;; in a different ordering is a nice feature to have here. (defclass sql-cursor (cursor) - ((keys :accessor :sql-crsr-ks :initarg :sql-cursor-keys :initform '()) - (curkey :accessor :sql-crsr-ck :initarg :sql-cursor-curkey :initform -1 :type (or null integer))) + ((keys :accessor sql-crsr-ks :initarg :sql-cursor-keys :initform '()) + (curkey :accessor sql-crsr-ck :initarg :sql-cursor-curkey :initform -1 :type (or null integer))) (:documentation "A SQL cursor for traversing (primary) BTrees."))

(defmethod make-cursor ((bt sql-btree)) @@ -59,7 +59,7 @@

(defmethod cursor-close ((cursor sql-cursor)) - (setf (:sql-crsr-ck cursor) nil) + (setf (sql-crsr-ck cursor) nil) (setf (cursor-initialized-p cursor) nil))

;; Maybe this will still work? @@ -71,8 +71,8 @@ :initialized-p (cursor-initialized-p cursor) :oid (cursor-oid cursor) ;; Do we need to so some kind of copy on this collection? - :keys (:sql-crsr-ks cursor) - :curkey (:sql-crsr-ck cursor))) + :keys (sql-crsr-ks cursor) + :curkey (sql-crsr-ck cursor))) ;; :handle (db-cursor-duplicate ;; (cursor-handle cursor) ;; :position (cursor-initialized-p cursor)))) @@ -129,14 +129,14 @@ (len (length tuples))) ;; now we somehow have to load the keys into the array... ;; actually, this should be an adjustable vector... - (setf (:sql-crsr-ks cursor) (make-array (length tuples))) + (setf (sql-crsr-ks cursor) (make-array (length tuples))) (do ((i 0 (1+ i)) (tup tuples (cdr tup))) ((= i len) nil) - (setf (aref (:sql-crsr-ks cursor) i) + (setf (aref (sql-crsr-ks cursor) i) (deserialize-from-base64-string (caar tup) sc))) - (sort (:sql-crsr-ks cursor) #'my-generic-less-than) - (setf (:sql-crsr-ck cursor) 0) + (sort (sql-crsr-ks cursor) #'my-generic-less-than) + (setf (sql-crsr-ck cursor) 0) (setf (cursor-initialized-p cursor) t) ))

@@ -144,9 +144,9 @@

;; we're assuming here that nil is not a legitimate key. (defmethod get-current-key ((cursor sql-cursor)) - (let ((x (:sql-crsr-ck cursor))) - (if (and (>= x 0) (< x (length (:sql-crsr-ks cursor)))) - (svref (:sql-crsr-ks cursor) x) + (let ((x (sql-crsr-ck cursor))) + (if (and (>= x 0) (< x (length (sql-crsr-ks cursor)))) + (svref (sql-crsr-ks cursor) x) '() )) ) @@ -180,8 +180,8 @@ (defmethod cursor-last ((cursor sql-cursor) ) (unless (cursor-initialized-p cursor) (cursor-init cursor)) - (setf (:sql-crsr-ck cursor) - (- (length (:sql-crsr-ks cursor)) 1)) + (setf (sql-crsr-ck cursor) + (- (length (sql-crsr-ks cursor)) 1)) (setf (cursor-initialized-p cursor) t) (has-key-value cursor))

@@ -190,7 +190,7 @@ (defmethod cursor-next ((cursor sql-cursor)) (if (cursor-initialized-p cursor) (progn - (incf (:sql-crsr-ck cursor)) + (incf (sql-crsr-ck cursor)) (has-key-value cursor)) (cursor-first cursor))) @@ -198,27 +198,27 @@ (declare (optimize (speed 3))) (if (cursor-initialized-p cursor) (progn - (decf (:sql-crsr-ck cursor)) + (decf (sql-crsr-ck cursor)) (has-key-value cursor)) (cursor-last cursor))) (defmethod cursor-set ((cursor sql-cursor) key) (declare (optimize (speed 3))) (if (cursor-initialized-p cursor) - (let ((p (position key (:sql-crsr-ks cursor) :test #'equal))) + (let ((p (position key (sql-crsr-ks cursor) :test #'equal))) (if p (progn - (setf (:sql-crsr-ck cursor) p) + (setf (sql-crsr-ck cursor) p) (setf (cursor-initialized-p cursor) t) (has-key-value cursor) ) (setf (cursor-initialized-p cursor) nil))) (progn (cursor-init cursor) - (let ((p (position key (:sql-crsr-ks cursor) :test #'equal))) + (let ((p (position key (sql-crsr-ks cursor) :test #'equal))) (if p (progn - (setf (:sql-crsr-ck cursor) p) + (setf (sql-crsr-ck cursor) p) (has-key-value cursor) ) (setf (cursor-initialized-p cursor) nil)))) @@ -231,7 +231,7 @@ ;; the initialized state... (unless (cursor-initialized-p cursor) (cursor-init cursor)) - (let ((len (length (:sql-crsr-ks cursor))) + (let ((len (length (sql-crsr-ks cursor))) (vs '())) (do ((i 0 (1+ i))) ((or (= i len) @@ -299,7 +299,7 @@ ;; Secondary Cursors (defclass sql-secondary-cursor (sql-cursor) ( - (dup-number :accessor :dp-nmbr :initarg :dup-number :initform 0 :type integer) + (dup-number :accessor dp-nmbr :initarg :dup-number :initform 0 :type integer) ) (:documentation "Cursor for traversing bdb secondary indices."))

@@ -314,14 +314,14 @@

(defmethod has-key-value-scnd ((cursor sql-secondary-cursor) &key (returnpk nil)) - (let ((ck (:sql-crsr-ck cursor))) - (if (and (>= ck 0) (< ck (length (:sql-crsr-ks cursor)))) - (let* ((cur-pk (aref (:sql-crsr-ks cursor) - (:sql-crsr-ck cursor))) + (let ((ck (sql-crsr-ck cursor))) + (if (and (>= ck 0) (< ck (length (sql-crsr-ks cursor)))) + (let* ((cur-pk (aref (sql-crsr-ks cursor) + (sql-crsr-ck cursor))) (sc (get-con (cursor-btree cursor))) (indexed-pk (sql-get-from-clcn-nth (cursor-oid cursor) cur-pk sc - (:dp-nmbr cursor)))) + (dp-nmbr cursor)))) (if indexed-pk (let ((v (get-value indexed-pk (primary (cursor-btree cursor))))) (if v @@ -359,11 +359,11 @@ (declare (optimize (speed 3))) (unless (cursor-initialized-p cursor) (cursor-init cursor)) - (let ((idx (position key (:sql-crsr-ks cursor) :test #'equal))) + (let ((idx (position key (sql-crsr-ks cursor) :test #'equal))) (if idx (progn - (setf (:sql-crsr-ck cursor) idx) - (setf (:dp-nmbr cursor) 0) + (setf (sql-crsr-ck cursor) idx) + (setf (dp-nmbr cursor) 0) (cursor-current-x cursor :returnpk t)) (cursor-un-init cursor) ))) @@ -381,11 +381,11 @@ (declare (optimize (speed 3))) (unless (cursor-initialized-p cursor) (cursor-init cursor)) - (let ((idx (array-index-if #'(lambda (x) (my-generic-at-most key x)) (:sql-crsr-ks cursor)))) + (let ((idx (array-index-if #'(lambda (x) (my-generic-at-most key x)) (sql-crsr-ks cursor)))) (if (<= 0 idx) (progn - (setf (:sql-crsr-ck cursor) idx) - (setf (:dp-nmbr cursor) 0) + (setf (sql-crsr-ck cursor) idx) + (setf (dp-nmbr cursor) 0) (cursor-current-x cursor :returnpk t) ) (cursor-un-init cursor :returnpk t) @@ -456,15 +456,15 @@ (cursor-current-x cursor :returnpk t) (declare (ignore m k v)) (remove-kv p (primary (cursor-btree cursor))) - (let ((ck (:sql-crsr-ck cursor)) - (dp (:dp-nmbr cursor))) + (let ((ck (sql-crsr-ck cursor)) + (dp (dp-nmbr cursor))) (declare (ignorable dp)) (cursor-next cursor) ;; Now that we point to the old slot, remove the old slot from the array... - (setf (:sql-crsr-ks cursor) + (setf (sql-crsr-ks cursor) (remove-indexed-element-and-adjust ck - (:sql-crsr-ks cursor))) + (sql-crsr-ks cursor))) ;; now move us back to where we were (cursor-prev cursor) )) @@ -496,7 +496,7 @@

(defmethod cursor-first-x ((cursor sql-secondary-cursor) &key (returnpk nil)) (declare (optimize (speed 3))) - (setf (:dp-nmbr cursor) 0) + (setf (dp-nmbr cursor) 0) (cursor-init cursor) (has-key-value-scnd cursor :returnpk returnpk) ) @@ -509,10 +509,10 @@ (if (cursor-initialized-p cursor) (progn (let ((cur-pk (get-current-key cursor))) - (incf (:sql-crsr-ck cursor)) + (incf (sql-crsr-ck cursor)) (if (equal cur-pk (get-current-key cursor)) - (incf (:dp-nmbr cursor)) - (setf (:dp-nmbr cursor) 0)) + (incf (dp-nmbr cursor)) + (setf (dp-nmbr cursor) 0)) (has-key-value-scnd cursor :returnpk returnpk))) (cursor-first-x cursor :returnpk returnpk))) @@ -524,10 +524,10 @@ (if (cursor-initialized-p cursor) (progn (let ((cur-pk (get-current-key cursor))) - (decf (:sql-crsr-ck cursor)) + (decf (sql-crsr-ck cursor)) (if (equal cur-pk (get-current-key cursor)) - (setf (:dp-nmbr cursor) (max 0 (- (:dp-nmbr cursor) 1))) - (setf (:dp-nmbr cursor) + (setf (dp-nmbr cursor) (max 0 (- (dp-nmbr cursor) 1))) + (setf (dp-nmbr cursor) (sql-get-from-clcn-cnt (cursor-oid cursor) (get-current-key cursor) (get-con (cursor-btree cursor)) @@ -546,22 +546,22 @@ (defmethod cursor-next-dup-x ((cursor sql-secondary-cursor) &key (returnpk nil)) ;; (declare (optimize (speed 3))) (when (cursor-initialized-p cursor) - (let* ((cur-pk (aref (:sql-crsr-ks cursor) - (:sql-crsr-ck cursor))) - (nint (+ 1 (:sql-crsr-ck cursor))) - (nxt-pk (if (array-in-bounds-p (:sql-crsr-ks cursor) nint) - (aref (:sql-crsr-ks cursor) + (let* ((cur-pk (aref (sql-crsr-ks cursor) + (sql-crsr-ck cursor))) + (nint (+ 1 (sql-crsr-ck cursor))) + (nxt-pk (if (array-in-bounds-p (sql-crsr-ks cursor) nint) + (aref (sql-crsr-ks cursor) nint) -1 )) ) (if (equal cur-pk nxt-pk) (progn - (incf (:dp-nmbr cursor)) - (incf (:sql-crsr-ck cursor)) + (incf (dp-nmbr cursor)) + (incf (sql-crsr-ck cursor)) (has-key-value-scnd cursor :returnpk returnpk)) (progn - (setf (:dp-nmbr cursor) 0) + (setf (dp-nmbr cursor) 0) (cursor-un-init cursor :returnpk returnpk) )))))

@@ -571,15 +571,15 @@ (defmethod cursor-next-nodup-x ((cursor sql-secondary-cursor) &key (returnpk nil)) (if (cursor-initialized-p cursor) (let ((n - (do ((i (:sql-crsr-ck cursor) (1+ i))) + (do ((i (sql-crsr-ck cursor) (1+ i))) ((or - (not (array-in-bounds-p (:sql-crsr-ks cursor) (+ i 1))) + (not (array-in-bounds-p (sql-crsr-ks cursor) (+ i 1))) (not - (equal (aref (:sql-crsr-ks cursor) i) - (aref (:sql-crsr-ks cursor) (+ 1 i))))) + (equal (aref (sql-crsr-ks cursor) i) + (aref (sql-crsr-ks cursor) (+ 1 i))))) (+ 1 i))))) - (setf (:sql-crsr-ck cursor) n) - (setf (:dp-nmbr cursor) 0) + (setf (sql-crsr-ck cursor) n) + (setf (dp-nmbr cursor) 0) (has-key-value-scnd cursor :returnpk returnpk)) (cursor-first-x cursor :returnpk returnpk) )) @@ -590,9 +590,9 @@ (defmethod cursor-last-x ((cursor sql-secondary-cursor) &key (returnpk nil)) (unless (cursor-initialized-p cursor) (cursor-init cursor)) - (setf (:sql-crsr-ck cursor) - (- (length (:sql-crsr-ks cursor)) 1)) - (setf (:dp-nmbr cursor) + (setf (sql-crsr-ck cursor) + (- (length (sql-crsr-ks cursor)) 1)) + (setf (dp-nmbr cursor) (max 0 (- (sql-get-from-clcn-cnt (cursor-oid cursor) @@ -600,7 +600,7 @@ (get-con (cursor-btree cursor)) ) 1))) - (assert (>= (:dp-nmbr cursor) 0)) + (assert (>= (dp-nmbr cursor) 0)) (setf (cursor-initialized-p cursor) t) (has-key-value-scnd cursor :returnpk returnpk) ) @@ -614,8 +614,8 @@ (declare (optimize (speed 3))) (if (cursor-initialized-p cursor) (progn - (setf (:sql-crsr-ck cursor) (- (:sql-crsr-ck cursor) (+ 1 (:dp-nmbr cursor)))) - (setf (:dp-nmbr cursor) + (setf (sql-crsr-ck cursor) (- (sql-crsr-ck cursor) (+ 1 (dp-nmbr cursor)))) + (setf (dp-nmbr cursor) (max 0 (- (sql-get-from-clcn-cnt (cursor-oid cursor) (get-current-key cursor)