[elephant-cvs] CVS elephant/src/db-clsql
ieslick
ieslick at common-lisp.net
Mon Feb 26 19:12:18 UTC 2007
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)
More information about the Elephant-cvs
mailing list