/[flexichain]/flexichain/skiplist.lisp
ViewVC logotype

Diff of /flexichain/skiplist.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1.1.1 by rkreuter, Thu Feb 9 02:51:06 2006 UTC revision 1.2 by charmon, Sun Jan 27 06:05:37 2008 UTC
# Line 35  Line 35 
35    (print-unreadable-object (s stream :type t)    (print-unreadable-object (s stream :type t)
36      (with-slots (start) s      (with-slots (start) s
37         (when (entry-next start 0)         (when (entry-next start 0)
38           (loop for entry = (entry-next start 0) then (entry-next entry 0)           (loop for entry = (entry-next start 0) then (entry-next entry 0)
39                 do (format stream "(~W ~W) "                 do (format stream "(~W ~W) "
40                                   (entry-key entry)                                   (entry-key entry)
41                                   (entry-obj entry))                                   (entry-obj entry))
42                 until (last-entry-p start entry 0))))))                 until (last-entry-p start entry 0))))))
43    
44  (defun entry-obj (entry)  (defun entry-obj (entry)
45    (aref entry 0))    (aref entry 0))
# Line 88  Line 88 
88  (defun find-entry-level (skiplist entry level key)  (defun find-entry-level (skiplist entry level key)
89    (with-slots (start) skiplist    (with-slots (start) skiplist
90       (loop until (or (key-= skiplist (entry-key (entry-next entry level)) key)       (loop until (or (key-= skiplist (entry-key (entry-next entry level)) key)
91                       (and (key-< skiplist (entry-key entry) key)                       (and (key-< skiplist (entry-key entry) key)
92                            (key-> skiplist (entry-key (entry-next entry level)) key))                            (key-> skiplist (entry-key (entry-next entry level)) key))
93                       (and (key-< skiplist (entry-key entry) key)                       (and (key-< skiplist (entry-key entry) key)
94                            (key-< skiplist (entry-key (entry-next entry level)) key)                            (key-< skiplist (entry-key (entry-next entry level)) key)
95                            (last-entry-p start entry level)                            (last-entry-p start entry level)
96                            (eq (entry-next entry level) (entry-next start level)))                            (eq (entry-next entry level) (entry-next start level)))
97                       (and (key-> skiplist (entry-key entry) key)                       (and (key-> skiplist (entry-key entry) key)
98                            (key-> skiplist (entry-key (entry-next entry level)) key)                            (key-> skiplist (entry-key (entry-next entry level)) key)
99                            (last-entry-p start entry level)))                            (last-entry-p start entry level)))
100             do (setf entry (entry-next entry level))))             do (setf entry (entry-next entry level))))
101    entry)    entry)
102    
103    
104  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
105  ;;;  ;;;
# Line 111  Line 111 
111    (with-slots (current-maxlevel start) skiplist    (with-slots (current-maxlevel start) skiplist
112       (let ((entry (entry-next start current-maxlevel)))       (let ((entry (entry-next start current-maxlevel)))
113         (loop for l downfrom current-maxlevel to 0         (loop for l downfrom current-maxlevel to 0
114               do (setf entry (find-entry-level skiplist entry l key)))               do (setf entry (find-entry-level skiplist entry l key)))
115         (if (key-= skiplist (entry-key (entry-next entry 0)) key)         (if (key-= skiplist (entry-key (entry-next entry 0)) key)
116             (values (entry-obj (entry-next entry 0)) t)             (values (entry-obj (entry-next entry 0)) t)
117             (values nil nil)))))             (values nil nil)))))
118    
119  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
120  ;;;  ;;;
# Line 124  Line 124 
124    (assert (not (skiplist-empty-p skiplist)))    (assert (not (skiplist-empty-p skiplist)))
125    (with-slots (start) skiplist    (with-slots (start) skiplist
126       (values (entry-obj (entry-next start 0))       (values (entry-obj (entry-next start 0))
127               (entry-key (entry-next start 0)))))               (entry-key (entry-next start 0)))))
128    
129  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
130  ;;;  ;;;
# Line 132  Line 132 
132    
133  (defun pick-a-level (maxlevel)  (defun pick-a-level (maxlevel)
134    (loop for level from 0 to maxlevel    (loop for level from 0 to maxlevel
135          while (zerop (random 2))          while (zerop (random 2))
136          finally (return level)))          finally (return level)))
137    
138  (defun make-entry (level key obj)  (defun make-entry (level key obj)
139    (let ((entry (make-array (+ level 3) :initial-element nil)))    (let ((entry (make-array (+ level 3) :initial-element nil)))
140      (setf (aref entry 0) obj      (setf (aref entry 0) obj
141            (aref entry 1) key)            (aref entry 1) key)
142      entry))      entry))
143    
144  (defun (setf skiplist-find) (obj skiplist key)  (defun (setf skiplist-find) (obj skiplist key)
145    (with-slots (current-maxlevel start) skiplist    (with-slots (current-maxlevel start) skiplist
146       (if (second (multiple-value-list (skiplist-find skiplist key)))       (if (second (multiple-value-list (skiplist-find skiplist key)))
147           (let ((entry (entry-next start current-maxlevel)))           (let ((entry (entry-next start current-maxlevel)))
148             (loop for l downfrom current-maxlevel to 0             (loop for l downfrom current-maxlevel to 0
149                   do (setf entry (find-entry-level skiplist entry l key)))                   do (setf entry (find-entry-level skiplist entry l key)))
150             (setf (entry-obj (entry-next entry 0)) obj))             (setf (entry-obj (entry-next entry 0)) obj))
151           (let* ((level (pick-a-level (maxlevel skiplist)))           (let* ((level (pick-a-level (maxlevel skiplist)))
152                  (new-entry (make-entry level key obj)))                  (new-entry (make-entry level key obj)))
153             (loop for l downfrom level above current-maxlevel             (loop for l downfrom level above current-maxlevel
154                   do (setf (entry-next start l) new-entry                   do (setf (entry-next start l) new-entry
155                            (entry-next new-entry l) new-entry))                            (entry-next new-entry l) new-entry))
156             (let ((entry (entry-next start current-maxlevel)))             (let ((entry (entry-next start current-maxlevel)))
157               (loop for l downfrom current-maxlevel above level               (loop for l downfrom current-maxlevel above level
158                     do (setf entry (find-entry-level skiplist entry l key)))                     do (setf entry (find-entry-level skiplist entry l key)))
159               (loop for l downfrom (min level current-maxlevel) to 0               (loop for l downfrom (min level current-maxlevel) to 0
160                     do (setf entry (find-entry-level skiplist entry l key))                     do (setf entry (find-entry-level skiplist entry l key))
161                        (setf (entry-next new-entry l) (entry-next entry l)                        (setf (entry-next new-entry l) (entry-next entry l)
162                              (entry-next entry l) new-entry)                              (entry-next entry l) new-entry)
163                        (when (key-< skiplist key (entry-key entry))                        (when (key-< skiplist key (entry-key entry))
164                          (setf (entry-next start l) new-entry))))                          (setf (entry-next start l) new-entry))))
165             (setf current-maxlevel (max current-maxlevel level)))))             (setf current-maxlevel (max current-maxlevel level)))))
166    skiplist)    skiplist)
167    
168  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
# Line 174  Line 174 
174    (with-slots (current-maxlevel start) skiplist    (with-slots (current-maxlevel start) skiplist
175       (let ((entry (entry-next start current-maxlevel)))       (let ((entry (entry-next start current-maxlevel)))
176         (loop for l downfrom current-maxlevel to 0         (loop for l downfrom current-maxlevel to 0
177               do (setf entry (find-entry-level skiplist entry l key))               do (setf entry (find-entry-level skiplist entry l key))
178               when (key-= skiplist (entry-key (entry-next entry l)) key)               when (key-= skiplist (entry-key (entry-next entry l)) key)
179                 do (cond ((key-= skiplist (entry-key entry) key)                 do (cond ((key-= skiplist (entry-key entry) key)
180                           (setf (entry-next start l) nil))                           (setf (entry-next start l) nil))
181                          ((key-< skiplist (entry-key entry) key)                          ((key-< skiplist (entry-key entry) key)
182                           (setf (entry-next entry l)                           (setf (entry-next entry l)
183                                 (entry-next (entry-next entry l) l)))                                 (entry-next (entry-next entry l) l)))
184                          (t (setf (entry-next entry l)                          (t (setf (entry-next entry l)
185                                   (entry-next (entry-next entry l) l))                                   (entry-next (entry-next entry l) l))
186                             (setf (entry-next start l)                             (setf (entry-next start l)
187                                   (entry-next entry l)))))                                   (entry-next entry l)))))
188         (loop while (and (null (entry-next start current-maxlevel))         (loop while (and (null (entry-next start current-maxlevel))
189                          (>= current-maxlevel 0))                          (>= current-maxlevel 0))
190               do (decf current-maxlevel))))               do (decf current-maxlevel))))
191    skiplist)    skiplist)
192    
193  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
# Line 197  Line 197 
197  (defun update-interval (skiplist entry to update-key)  (defun update-interval (skiplist entry to update-key)
198    (with-slots (start) skiplist    (with-slots (start) skiplist
199       (flet ((update-entry (entry)       (flet ((update-entry (entry)
200                (setf (entry-key entry)                (setf (entry-key entry)
201                      (funcall update-key (entry-key entry) (entry-obj entry)))))                      (funcall update-key (entry-key entry) (entry-obj entry)))))
202         (loop while (key-<= skiplist (entry-key entry) to)         (loop while (key-<= skiplist (entry-key entry) to)
203               do (update-entry entry)               do (update-entry entry)
204               until (last-entry-p start entry 0)               until (last-entry-p start entry 0)
205               do (setf entry (entry-next entry 0))))))               do (setf entry (entry-next entry 0))))))
206    
207  (defun skiplist-slide-keys (skiplist from to update-key)  (defun skiplist-slide-keys (skiplist from to update-key)
208    (unless (skiplist-empty-p skiplist)    (unless (skiplist-empty-p skiplist)
209      (with-slots (current-maxlevel start) skiplist      (with-slots (current-maxlevel start) skiplist
210         (let ((entry (entry-next start current-maxlevel)))         (let ((entry (entry-next start current-maxlevel)))
211           (loop for l downfrom current-maxlevel to 0           (loop for l downfrom current-maxlevel to 0
212                 do (setf entry (find-entry-level skiplist entry l from)))                 do (setf entry (find-entry-level skiplist entry l from)))
213           (when (key->= skiplist (entry-key (entry-next entry 0)) from)           (when (key->= skiplist (entry-key (entry-next entry 0)) from)
214             (update-interval skiplist (entry-next entry 0) to update-key)))))             (update-interval skiplist (entry-next entry 0) to update-key)))))
215    skiplist)    skiplist)
216    
217  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
# Line 222  Line 222 
222    (unless (skiplist-empty-p skiplist)    (unless (skiplist-empty-p skiplist)
223      (with-slots (current-maxlevel start) skiplist      (with-slots (current-maxlevel start) skiplist
224         (let ((entry (entry-next start current-maxlevel)))         (let ((entry (entry-next start current-maxlevel)))
225           (loop for l downfrom current-maxlevel to 0           (loop for l downfrom current-maxlevel to 0
226                 do (setf entry (find-entry-level skiplist entry l to)))                 do (setf entry (find-entry-level skiplist entry l to)))
227           (when (key-= skiplist (entry-key (entry-next entry 0)) to)           (when (key-= skiplist (entry-key (entry-next entry 0)) to)
228             (setf entry (entry-next entry 0)))             (setf entry (entry-next entry 0)))
229           (cond ((and (key-> skiplist (entry-key entry) to)           (cond ((and (key-> skiplist (entry-key entry) to)
230                       (key-> skiplist (entry-key (entry-next entry 0)) to))                       (key-> skiplist (entry-key (entry-next entry 0)) to))
231                  nil)                  nil)
232                 ((and (key-<= skiplist (entry-key entry) to)                 ((and (key-<= skiplist (entry-key entry) to)
233                       (key-<= skiplist (entry-key (entry-next entry 0)) to))                       (key-<= skiplist (entry-key (entry-next entry 0)) to))
234                  (update-interval skiplist (entry-next entry 0) to update-key))                  (update-interval skiplist (entry-next entry 0) to update-key))
235                 (t (update-interval skiplist (entry-next start 0) to update-key)                 (t (update-interval skiplist (entry-next start 0) to update-key)
236                    (loop with entry = (entry-next entry 0)                    (loop with entry = (entry-next entry 0)
237                          for level from 0 to current-maxlevel                          for level from 0 to current-maxlevel
238                          do (loop until (>= (length entry) (+ 3 level))                          do (loop until (>= (length entry) (+ 3 level))
239                                   do (setf entry (entry-next entry (1- level))))                                   do (setf entry (entry-next entry (1- level))))
240                             (setf (entry-next start level) entry)))))))                             (setf (entry-next start level) entry)))))))
241    skiplist)    skiplist)
242    
243    
# Line 248  Line 248 
248  (defun update-interval-to-end (skiplist entry update-key)  (defun update-interval-to-end (skiplist entry update-key)
249    (with-slots (start) skiplist    (with-slots (start) skiplist
250       (flet ((update-entry (entry)       (flet ((update-entry (entry)
251                (setf (entry-key entry)                (setf (entry-key entry)
252                      (funcall update-key (entry-key entry) (entry-obj entry)))))                      (funcall update-key (entry-key entry) (entry-obj entry)))))
253         (loop do (update-entry entry)         (loop do (update-entry entry)
254               until (last-entry-p start entry 0)               until (last-entry-p start entry 0)
255               do (setf entry (entry-next entry 0))))))               do (setf entry (entry-next entry 0))))))
256    
257  (defun skiplist-rotate-suffix (skiplist from update-key)  (defun skiplist-rotate-suffix (skiplist from update-key)
258    (unless (skiplist-empty-p skiplist)    (unless (skiplist-empty-p skiplist)
259      (with-slots (current-maxlevel start) skiplist      (with-slots (current-maxlevel start) skiplist
260         (let ((entry (entry-next start current-maxlevel)))         (let ((entry (entry-next start current-maxlevel)))
261           (loop for l downfrom current-maxlevel to 0           (loop for l downfrom current-maxlevel to 0
262                 do (setf entry (find-entry-level skiplist entry l from)))                 do (setf entry (find-entry-level skiplist entry l from)))
263           (cond ((and (key-< skiplist (entry-key entry) from)           (cond ((and (key-< skiplist (entry-key entry) from)
264                       (key-< skiplist (entry-key (entry-next entry 0)) from))                       (key-< skiplist (entry-key (entry-next entry 0)) from))
265                  nil)                  nil)
266                 ((and (key->= skiplist (entry-key entry) from)                 ((and (key->= skiplist (entry-key entry) from)
267                       (key->= skiplist (entry-key (entry-next entry 0)) from))                       (key->= skiplist (entry-key (entry-next entry 0)) from))
268                  (update-interval-to-end skiplist (entry-next entry 0) update-key))                  (update-interval-to-end skiplist (entry-next entry 0) update-key))
269                 (t (update-interval-to-end skiplist (entry-next entry 0) update-key)                 (t (update-interval-to-end skiplist (entry-next entry 0) update-key)
270                    (loop with entry = (entry-next entry 0)                    (loop with entry = (entry-next entry 0)
271                          for level from 0 to current-maxlevel                          for level from 0 to current-maxlevel
272                          do (loop until (>= (length entry) (+ 3 level))                          do (loop until (>= (length entry) (+ 3 level))
273                                   do (setf entry (entry-next entry (1- level))))                                   do (setf entry (entry-next entry (1- level))))
274                             (setf (entry-next start level) entry)))))))                             (setf (entry-next start level) entry)))))))
275    skiplist)    skiplist)

Legend:
Removed from v.1.1.1.1  
changed lines
  Added in v.1.2

  ViewVC Help
Powered by ViewVC 1.1.5