Update of /project/gsharp/cvsroot/gsharp/Flexichain
In directory common-lisp.net:/tmp/cvs-serv25678
Modified Files:
flexicursor.lisp
Log Message:
Unfortunately, despite much testing, there seems to be a bug in the
skiplist code. And since it is very hard to test, due to its
probabilistic nature, I prefer taking it out of the flexichain code.
Consequently, the cursors are now organized in a simple list. This
means that it is best not to have too many cursors. However, this can
be better in some respects, because now, moving a cursor is faster,
and the penalty occurs only when elements have to be moved or deleted.
Most applications will do more insertions than deletions anyway.
Date: Mon Jan 3 07:44:42 2005
Author: rstrandh
Index: gsharp/Flexichain/flexicursor.lisp
diff -u gsharp/Flexichain/flexicursor.lisp:1.8 gsharp/Flexichain/flexicursor.lisp:1.9
--- gsharp/Flexichain/flexicursor.lisp:1.8 Mon Sep 6 13:25:52 2004
+++ gsharp/Flexichain/flexicursor.lisp Mon Jan 3 07:44:42 2005
@@ -97,7 +97,7 @@
(:documentation "Replaces the element immediately after the cursor."))
(defclass standard-cursorchain (cursorchain standard-flexichain)
- ((cursors :initform (make-instance 'skiplist) :accessor cursorchain-cursors))
+ ((cursors :initform '()))
(:documentation "The standard instantiable subclass of CURSORCHAIN"))
(defun make-wp (value)
@@ -108,32 +108,6 @@
#+sbcl (sb-ext:weak-pointer-value wp)
#+cmu (ext:weak-pointer-value wp))
-(defmethod move-elements :after ((cc standard-cursorchain) to from start1 start2 end2)
- (declare (ignore to from))
- (let ((addfun (lambda (key wp-cursors)
- (let ((increment (- start1 start2)))
- (loop for wp in wp-cursors
- as cursor = (wp-value wp)
- unless (null cursor)
- do (incf (flexicursor-index cursor) increment))
- (+ key increment)))))
- (with-slots (cursors gap-start gap-end) cc
- (cond ((= start1 start2) nil)
- ((= gap-start gap-end)
- (skiplist-slide-keys cursors start2 (1- end2) addfun))
- ((< gap-end gap-start)
- (cond ((and (= end2 gap-start) (> start1 start2))
- (skiplist-slide-keys cursors start2 (1- end2) addfun))
- ((= end2 gap-start)
- (skiplist-rotate-suffix cursors start2 addfun))
- (t (skiplist-rotate-prefix cursors (1- end2) addfun))))
- ((plusp gap-start)
- (skiplist-slide-keys cursors start2 (1- end2) addfun))
- ((= start2 gap-end)
- (skiplist-slide-keys cursors start2 (1- end2) addfun))
- (t
- (skiplist-rotate-suffix cursors start2 addfun))))))
-
(defclass standard-flexicursor (flexicursor)
((chain :reader chain :initarg :chain)
(index :accessor flexicursor-index))
@@ -149,7 +123,7 @@
(with-slots (index chain) cursor
(setf index (position-index chain (1- position)))
(with-slots (cursors) chain
- (push (make-wp cursor) (skiplist-find cursors index)))))
+ (push (make-wp cursor) cursors))))
(defmethod initialize-instance :after ((cursor right-sticky-flexicursor)
&rest initargs &key (position 0))
@@ -157,7 +131,30 @@
(with-slots (index chain) cursor
(setf index (position-index chain position))
(with-slots (cursors) chain
- (push (make-wp cursor) (skiplist-find cursors index)))))
+ (push (make-wp cursor) cursors))))
+
+(defun adjust-cursors (cursors start end increment)
+ (let ((acc '()))
+ (loop while cursors
+ do (cond ((null (wp-value (car cursors)))
+ (pop cursors))
+ ((<= start (flexicursor-index (wp-value (car cursors))) end)
+ (incf (flexicursor-index (wp-value (car cursors))) increment)
+ (let ((rest (cdr cursors)))
+ (setf (cdr cursors) acc
+ acc cursors
+ cursors rest)))
+ (t
+ (let ((rest (cdr cursors)))
+ (setf (cdr cursors) acc
+ acc cursors
+ cursors rest)))))
+ acc))
+
+(defmethod move-elements :after ((cc standard-cursorchain) to from start1 start2 end2)
+ (declare (ignore to from))
+ (with-slots (cursors) cc
+ (setf cursors (adjust-cursors cursors start2 (1- end2) (- start1 start2)))))
(defmethod clone-cursor ((cursor standard-flexicursor))
(make-instance (class-of cursor)
@@ -172,13 +169,7 @@
'flexi-position-error :chain (chain cursor) :position position)
(with-slots (chain index) cursor
(with-slots (cursors) chain
- (let ((remaining (delete cursor (skiplist-find cursors index)
- :key #'wp-value :test #'eq)))
- (if (null remaining)
- (skiplist-delete cursors index)
- (setf (skiplist-find cursors index) remaining)))
- (setf index (position-index chain (1- position)))
- (push (make-wp cursor) (skiplist-find cursors index)))))
+ (setf index (position-index chain (1- position))))))
(defmethod cursor-pos ((cursor right-sticky-flexicursor))
(index-position (chain cursor) (slot-value cursor 'index)))
@@ -188,13 +179,7 @@
'flexi-position-error :chain (chain cursor) :position position)
(with-slots (chain index) cursor
(with-slots (cursors) chain
- (let ((remaining (delete cursor (skiplist-find cursors index)
- :key #'wp-value :test #'eq)))
- (if (null remaining)
- (skiplist-delete cursors index)
- (setf (skiplist-find cursors index) remaining)))
- (setf index (position-index chain position))
- (push (make-wp cursor) (skiplist-find cursors index)))))
+ (setf index (position-index chain position)))))
(defmethod at-beginning-p ((cursor standard-flexicursor))
(zerop (cursor-pos cursor)))
@@ -213,11 +198,10 @@
(defmethod delete* :before ((chain standard-cursorchain) position)
(with-slots (cursors) chain
- (let* ((old-index (position-index chain position))
- (cursors-to-adjust (skiplist-find cursors old-index)))
- (loop for cursor-wp in cursors-to-adjust
+ (let* ((old-index (position-index chain position)))
+ (loop for cursor-wp in cursors
as cursor = (wp-value cursor-wp)
- when cursor
+ when (and cursor (= old-index (flexicursor-index cursor)))
do (typecase cursor
(right-sticky-flexicursor (incf (cursor-pos cursor)))
(left-sticky-flexicursor (decf (cursor-pos cursor))))))))
