Changeset 1088

Timestamp:

01/05/05 12:25:25 (4 years ago)

Author:

manuel

Message:

neue skip-list in die indices schicht eingebaut, allerdings werden die cursors noch nicht benutzt, da koennte man unter umstaenden effizienz rausdruecken

Files:

• trunk/bknr/src/bknr-indices.asd (modified) (1 diff)
• trunk/bknr/src/indices/indices.lisp (modified) (10 diffs)
• trunk/bknr/src/indices/package.lisp (modified) (1 diff)
• trunk/bknr/src/indices/protocol.lisp (added)
• trunk/bknr/src/indices/skip-list-cursor.lisp (added)
• trunk/bknr/src/skip-list/package.lisp (modified) (1 diff)
• trunk/bknr/src/skip-list/skip-list.lisp (modified) (5 diffs)

trunk/bknr/src/bknr-indices.asd

@@ -22 +22 @@
-  :long-description ""
-
-
+bknr-
-
-  :components ((:module "indices"
-                        :components
-                        ((:file "package")
-
+
+
+
-                         (:file "index-metaclass"
-                                :depends-on ("package" "indices"))))))

trunk/bknr/src/indices/indices.lisp

@@ -4 +4 @@
-
-(in-package :bknr.indices)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; CLOS Protocol for index objects
-
-;;; A CLOS index is a CLOS class that complies to the following
-;;; protocol:
-
-(defgeneric index-add (index object)
-  (:documentation "Add OBJECT to the INDEX. Throws an ERROR if a
-problem happened while inserting OBJECT."))
-
-(defgeneric index-get (index key)
-  (:documentation "Get the object (or the objects) stored under the index-key KEY."))
-
-(defgeneric index-remove (index object)
-  (:documentation "Remove OBJECT from the INDEX."))
-
-(defgeneric index-keys (index)
-  (:documentation "Returns all the KEYs of the INDEX."))
-
-(defgeneric index-values (index)
-  (:documentation "Returns all the objects (or object lists) stored in
-INDEX."))
-
-(defgeneric index-mapvalues (index fun)
-  (:documentation "Apply FUN to every object in the INDEX."))
-
-(defgeneric index-reinitialize (new-index old-index)
-  (:documentation "Called when the definition of an index is changed."))
-
-(defgeneric index-clear (index)
-  (:documentation "Remove all indexed objects from the index."))
-
-(defun index-create (class-name &rest initargs)
-  "Instantiate the index object with class CLASS-NAME with INITARGS."
-  (apply #'make-instance class-name initargs))
-
-;;; Adding to an index can throw the following errors:
-
-(define-condition index-existing-error (error)
-  ((index :initarg :index :reader condition-index)
-   (key :initarg :key :reader condition-key)
-   (value :initarg :value :reader condition-value)))
-
-(defmethod print-object ((obj index-existing-error) stream)
-  (print-unreadable-object (obj stream :type t)
-    (format stream "INDEX: ~A KEY: ~S VALUE: ~S"
-            (condition-index obj) (condition-key obj) (condition-value obj))))
-
-;;;;;;;;;;;;;;;;;;;;
@@ -363 +315 @@
-   (slot-name :initarg :slot-name
-              :accessor skip-list-index-slot-name)
-   (order :initarg :order
-          :accessor skip-list-index-order)
-   (index-nil :initarg :index-nil :initform nil
-              :accessor skip-list-index-index-nil)))
-
-(type 'string)
-order 
+
+
-  (unless (<= (length slots) 1)
-    (error "Can not create slot-index with more than one slot."))
-  (with-slots (skip-list slot-name) index
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-(defmethod print-object ((object skip-list-index) stream)
@@ -437 +356 @@
-  (let ((slot-name (skip-list-index-slot-name index)))
-    (if (slot-boundp object slot-name)
-remov
+delet
-                          (skip-list-index-skip-list index))
-        (warn "Ignoring request to remove object ~a with unbound slot ~A."
@@ -444 +363 @@
-(defmethod index-keys ((index skip-list-index))
-  (let ((keys))
-do-skip-list (key val (skip-list-index-skip-list index
-      (declare (ignore val
-      (push key keys
+map-skip-list #'(lambda (key val) (declare (ignore val
+                            (push key keys
+                  (skip-list-index-skip-list index
-    (nreverse keys)))
-
-(defmethod index-values ((index skip-list-index))
-  (let ((vals))
-do-skip-list (key val (skip-list-index-skip-list index
-      (declare (ignore key
-      (push val vals
+map-skip-list #'(lambda (key val) (declare (ignore key
+                            (push val vals
+                  (skip-list-index-skip-list index
-    (nreverse vals)))
-
@@ -462 +381 @@
-  
-(defmethod index-clear ((index skip-list-index))
- order 
-skip-list order
+
+instance 'skip-list
-
-(defmethod index-reinitialize ((new-index skip-list-index)
@@ -473 +392 @@
-  (let ((new-list (skip-list-index-skip-list new-index)) 
-        (old-list (skip-list-index-skip-list old-index)))
-
-
-
-
-
-
+
-    new-index))
-
@@ -489 +403 @@
-   (slot-name :initarg :slot-name
-              :accessor class-skip-index-slot-name)
-   (order :initarg :order
-          :accessor class-skip-index-order)
-   (hash-table :accessor class-skip-index-hash-table)))
-
-(defmethod initialize-instance :after ((index class-skip-index) &key (type 'string)
-                                       (test #'eql)
-order 
+
-  (unless (<= (length slots) 1)
-    (error "Can not create slot-index with more than one slot."))
-  (with-slots (hash-table slot-name) index
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-(defmethod index-add ((index class-skip-index) object)
@@ -521 +426 @@
-                     (let ((skip-list
-                            (setf (gethash key hash-table)
-skip-list (class-skip-index-order index)
+instance 'skip-list
-                       (setf (skip-list-get id-key skip-list) object)))))))
-
@@ -549 +454 @@
-    (when skip-list
-      (let ((res))
-do-skip-list (key val skip-list
-  (declare (ignore key
-  (push val res)
+map-skip-list #'(lambda (key val) (declare (ignore key)
+                        (push val res
+              skip-list
-        (nreverse res)))))
-
-
-
-
-
+
+
+
+
+
-    new-skip-list))
-
@@ -563 +469 @@
-                               (old-index class-skip-index))
-  (let* ((new-hash (class-skip-index-hash-table new-index)) 
-
-
-
-
+
-    (if (eql (hash-table-test old-hash)
-             (hash-table-test new-hash))
-
-
-
-
-
-
+
-        (maphash #'(lambda (key value)
-
-
-
-
+
-                 old-hash))
-    new-index))

trunk/bknr/src/indices/package.lisp

@@ -8 +8 @@
-        :cxml
-        :bknr.utils
-
+bknr.
-        #+cmu
-        :ext

trunk/bknr/src/skip-list/package.lisp

@@ -3 +3 @@
-(defpackage :bknr.skip-list
-  (:use :cl)
-
-
-
+
+
+
+
+
+
+
+

trunk/bknr/src/skip-list/skip-list.lisp

@@ -1 +1 @@
-(in-package :bknr.skip-list)
-
-(defgeneric cursor-next (cursor))
-(defgeneric cursor-previous (cursor))
-(defgeneric cursor-search (cursor key))
-
-;;; TODO:
@@ -40 +36 @@
-    (declare (type fixnum level))))
-
-node: key, value, forward
+A node is a SIMPLE-VECTOR containing KEY, VALUE and the forward pointers
-
-(defmacro node-key (node)
@@ -65 +61 @@
-
-(defclass skip-list ()
-arg :header :init
+
-           :reader skip-list-header :type simple-vector)
+   #+nil
+   (finger :initform (make-header)
+           :reader skip-list-finger :type simple-vector)
-   (length :initform 0 :accessor skip-list-length :type fixnum)
-   (level :initform 0 :accessor skip-list-level :type fixnum))
@@ -174 +173 @@
-    sl))
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-  (declare (type integer key)
-           (optimize (speed 3)))
@@ -183 +193 @@
-       (let ((result (node-forward node)))
-         (if (and result (= (node-key result) key))
-(node-value result)
-ot-found
+result
+il
-    (declare (type fixnum level)
-             (type simple-vector node))))
+
+(defmethod skip-list-after-node ((sl skip-list) key)
+  "Search for the node with key biffer or equal to KEY in the skip-list (for range queries)."
+  (declare (type integer key)
+           (optimize (speed 3)))
+  (do ((level (1- (skip-list-level sl)) (1- level))
+       (node (skip-list-header sl) (follow-node node key level)))
+      ((< level 0)
+       (let ((result (node-forward node)))
+         (if (and result (>= (node-key result) key))
+             result
+             nil)))
+    (declare (type fixnum level)
+             (type simple-vector node))))
+
+(defmethod skip-list-search ((sl skip-list) key &optional not-found)
+  (let ((result (skip-list-search-node sl key)))
+    (if result
+        (node-value result)
+        not-found)))
+
+(defun node-before (node key &optional (level 0))
+  (let ((next (node-forward node level)))
+    (and next (< (node-key next) key))))
+
+;; broken, and not necessarily faster
+#+nil
+(defmethod skip-list-search ((sl skip-list) key &optional not-found)
+  (let ((finger (skip-list-finger sl))
+        node
+        lvl)
+
+    (if (node-before finger key 0)
+
+        (do ((level 1 (1+ level)))
+            ((or (>= level (skip-list-level sl))
+                 (not (node-before finger key level)))
+             (setf node (node-forward finger (1- level))
+                   lvl (1- level))))
+
+        (do ((level 1 (1+ level)))
+            ((or (>= level (skip-list-level sl))
+                 (node-before finger key level))
+             
+             (if (>= level (skip-list-level sl))
+                 (setf node (skip-list-header sl)
+                       lvl (1- (skip-list-level sl)))
+                 (setf node (node-forward finger level)
+                       lvl level)))
+          #+nil(format t "level: ~A~%" level)))
+
+    #+nil(format t "node: ~A, level ~A~%" node lvl)
+
+    (do ((level lvl (1- level)))
+        ((or (null node)
+             (< level 0))
+         (when node (setf node (node-forward node 0))))
+
+      (setf node (follow-node node key level))
+      (unless (eql node (skip-list-header sl))
+        #+nil(format t "storing in finger~%")
+        (setf (node-forward finger level) node)))
+
+    (if (and node (= (node-key node) key))
+        (node-value node)
+        not-found)))
-
-(defmethod skip-list-to-list ((sl skip-list))