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))))))))