- gsharp-cvs@common-lisp.net - mailman3.common-lisp.net

[gsharp-cvs] CVS update: gsharp/Flexichain/flexicursor.lisp
by rstrandh＠common-lisp.net 03 Jan '05

03 Jan '05

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

1 0

[gsharp-cvs] CVS update: gsharp/Flexichain/flexichain-package.lisp gsharp/Flexichain/flexichain.lisp
by rstrandh＠common-lisp.net 28 Dec '04

28 Dec '04

Update of /project/gsharp/cvsroot/gsharp/Flexichain In directory common-lisp.net:/tmp/cvs-serv7097 Modified Files: flexichain-package.lisp flexichain.lisp Log Message: added an "insert-vector*" function. Date: Tue Dec 28 07:57:00 2004 Author: rstrandh Index: gsharp/Flexichain/flexichain-package.lisp diff -u gsharp/Flexichain/flexichain-package.lisp:1.1 gsharp/Flexichain/flexichain-package.lisp:1.2 --- gsharp/Flexichain/flexichain-package.lisp:1.1 Mon Aug 16 10:12:45 2004 +++ gsharp/Flexichain/flexichain-package.lisp Tue Dec 28 07:57:00 2004 @@ -25,7 +25,7 @@ #:flexi-error #:flexi-initialization-error #:flexi-position-error #:flexi-incompatible-type-error #:nb-elements #:flexi-empty-p - #:insert* #:element* #:delete* + #:insert* #:insert-vector* #:element* #:delete* #:push-start #:pop-start #:push-end #:pop-end #:rotate #:cursorchain #:standard-cursorchain #:flexicursor #:standard-flexicursor Index: gsharp/Flexichain/flexichain.lisp diff -u gsharp/Flexichain/flexichain.lisp:1.5 gsharp/Flexichain/flexichain.lisp:1.6 --- gsharp/Flexichain/flexichain.lisp:1.5 Mon Sep 6 13:23:16 2004 +++ gsharp/Flexichain/flexichain.lisp Tue Dec 28 07:57:00 2004 @@ -245,6 +245,20 @@ (when (= gap-start (length buffer)) (setf gap-start 0)))) +(defmethod insert-vector* ((chain standard-flexichain) position vector) + (with-slots (element-type buffer gap-start) chain + (assert (<= 0 position (nb-elements chain)) () + 'flexi-position-error :chain chain :position position) + (assert (typep (array-element-type vector) element-type) () + 'flexi-incompatible-type-error :element vector :chain chain) + (ensure-gap-position chain position) + (ensure-room chain (+ (nb-elements chain) (length vector))) + (loop for elem across vector + do (setf (aref buffer gap-start) elem) + (incf gap-start) + (when (= gap-start (length buffer)) + (setf gap-start 0))))) + (defmethod delete* ((chain standard-flexichain) position) (with-slots (buffer expand-factor min-size fill-element gap-end) chain (assert (< -1 position (nb-elements chain)) ()

1 0

[gsharp-cvs] CVS update: CVSROOT/modules
by rstrandh＠common-lisp.net 22 Dec '04

22 Dec '04

Update of /project/gsharp/cvsroot/CVSROOT In directory common-lisp.net:/tmp/cvs-serv5201 Modified Files: modules Log Message: Added Flexichain as a separate module. Date: Wed Dec 22 14:55:21 2004 Author: rstrandh Index: CVSROOT/modules diff -u CVSROOT/modules:1.1 CVSROOT/modules:1.2 --- CVSROOT/modules:1.1 Wed Feb 11 16:22:54 2004 +++ CVSROOT/modules Wed Dec 22 14:55:20 2004 @@ -24,3 +24,5 @@ # character to interpose another module into the current module. This # can be useful for creating a module that consists of many directories # spread out over the entire source repository. + +Flexichain gsharp/Flexichain

1 0

[gsharp-cvs] CVS update: gsharp/Flexichain/flexicursor.lisp
by Robert Strandh 06 Sep '04

06 Sep '04

Update of /project/gsharp/cvsroot/gsharp/Flexichain In directory common-lisp.net:/tmp/cvs-serv16569 Modified Files: flexicursor.lisp Log Message: Delete the entry entirely from the skiplist when number of cursors at a particular position becomes zero. Removed move> and move< functions. Replaced :around method for delete* by :before method that calls (incf cursor-pos) or (decf cursor-pos) (according to the type of the cursor) before actual deletion takes place. Date: Mon Sep 6 13:25:52 2004 Author: rstrandh Index: gsharp/Flexichain/flexicursor.lisp diff -u gsharp/Flexichain/flexicursor.lisp:1.7 gsharp/Flexichain/flexicursor.lisp:1.8 --- gsharp/Flexichain/flexicursor.lisp:1.7 Thu Sep 2 08:23:50 2004 +++ gsharp/Flexichain/flexicursor.lisp Mon Sep 6 13:25:52 2004 @@ -172,9 +172,11 @@ 'flexi-position-error :chain (chain cursor) :position position) (with-slots (chain index) cursor (with-slots (cursors) chain - (setf (skiplist-find cursors index) - (delete cursor (skiplist-find cursors index) - :key #'wp-value :test #'eq)) + (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))))) @@ -186,9 +188,11 @@ 'flexi-position-error :chain (chain cursor) :position position) (with-slots (chain index) cursor (with-slots (cursors) chain - (setf (skiplist-find cursors index) - (delete cursor (skiplist-find cursors index) - :key #'wp-value :test #'eq)) + (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))))) @@ -198,12 +202,6 @@ (defmethod at-end-p ((cursor standard-flexicursor)) (= (cursor-pos cursor) (nb-elements (chain cursor)))) -(defmethod move> ((cursor standard-flexicursor) &optional (n 1)) - (incf (cursor-pos cursor) n)) - -(defmethod move< ((cursor standard-flexicursor) &optional (n 1)) - (decf (cursor-pos cursor) n)) - (defmethod insert ((cursor standard-flexicursor) object) (insert* (chain cursor) (cursor-pos cursor) object)) @@ -213,18 +211,16 @@ (insert cursor object)) sequence)) -(defmethod delete* :around ((chain standard-cursorchain) position) +(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))) - (when cursors-to-adjust - (skiplist-delete cursors old-index)) - (call-next-method) (loop for cursor-wp in cursors-to-adjust as cursor = (wp-value cursor-wp) when cursor - do (setf (cursor-pos cursor) position) - and do (push cursor-wp (skiplist-find cursors (flexicursor-index cursor))))))) + do (typecase cursor + (right-sticky-flexicursor (incf (cursor-pos cursor))) + (left-sticky-flexicursor (decf (cursor-pos cursor)))))))) (defmethod delete> ((cursor standard-flexicursor) &optional (n 1)) (let ((chain (chain cursor))

1 0

[gsharp-cvs] CVS update: gsharp/Flexichain/flexichain.lisp
by Robert Strandh 06 Sep '04

06 Sep '04

Update of /project/gsharp/cvsroot/gsharp/Flexichain In directory common-lisp.net:/tmp/cvs-serv16439 Modified Files: flexichain.lisp Log Message: Fixed a bug in resize-buffer that did not take the existence of sentinels into account. Date: Mon Sep 6 13:23:17 2004 Author: rstrandh Index: gsharp/Flexichain/flexichain.lisp diff -u gsharp/Flexichain/flexichain.lisp:1.4 gsharp/Flexichain/flexichain.lisp:1.5 --- gsharp/Flexichain/flexichain.lisp:1.4 Sun Aug 22 07:01:02 2004 +++ gsharp/Flexichain/flexichain.lisp Mon Sep 6 13:23:16 2004 @@ -467,7 +467,7 @@ (:gap-right (move-elements fc buffer-after buffer 0 0 gap-start)) (:gap-left - (let ((gap-end-after (- new-buffer-size (nb-elements fc)))) + (let ((gap-end-after (- new-buffer-size (+ 2 (nb-elements fc))))) (move-elements fc buffer-after buffer gap-end-after gap-end buffer-size) (setf gap-end gap-end-after))) (:gap-non-contiguous

1 0

[gsharp-cvs] CVS update: gsharp/Flexichain/rtester.lisp
by Robert Strandh 06 Sep '04

06 Sep '04

Update of /project/gsharp/cvsroot/gsharp/Flexichain In directory common-lisp.net:/tmp/cvs-serv16406 Modified Files: rtester.lisp Log Message: Removed generation of move< and move> instructions. Fixed a bug in the delete test which sometimes generated delete operations on empty chains. Added comparison of the two implementations during a replay. Made the stupid implementation the reference (since presumably that is the correct one). Date: Mon Sep 6 13:21:49 2004 Author: rstrandh Index: gsharp/Flexichain/rtester.lisp diff -u gsharp/Flexichain/rtester.lisp:1.2 gsharp/Flexichain/rtester.lisp:1.3 --- gsharp/Flexichain/rtester.lisp:1.2 Thu Sep 2 08:23:50 2004 +++ gsharp/Flexichain/rtester.lisp Mon Sep 6 13:21:49 2004 @@ -21,8 +21,6 @@ ;; (setf element*) ;; clone-cursor fcu ;; (setf cursor-pos) -;; move> fcu &optional (n 1) -;; move< fcu &optional (n 1) ;; insert fcu obj ;; delete< fcu ;; delete> fcu @@ -64,21 +62,24 @@ (push inst *instructions*)) (defun i* (&optional - (pos (random (1+ (flexichain:nb-elements *fc-real*)))) + (pos (random (1+ (stupid:nb-elements *fc-fake*)))) (elem (random 1000000))) (add-inst `(i* ,pos ,elem)) (flexichain:insert* *fc-real* pos elem) (stupid:insert* *fc-fake* pos elem)) -(defun d* (&optional (pos (random (flexichain:nb-elements *fc-real*)))) - (add-inst `(d* ,pos)) - (flexichain:delete* *fc-real* pos) - (stupid:delete* *fc-fake* pos)) +(defun d* (&optional pos) + (unless (zerop (stupid:nb-elements *fc-fake*)) + (unless pos + (setf pos (random (stupid:nb-elements *fc-fake*)))) + (add-inst `(d* ,pos)) + (flexichain:delete* *fc-real* pos) + (stupid:delete* *fc-fake* pos))) (defun se* (&optional pos elem) (unless (zerop (stupid:nb-elements *fc-fake*)) (unless pos - (setf pos (random (flexichain:nb-elements *fc-real*)) + (setf pos (random (stupid:nb-elements *fc-fake*)) elem (random 1000000))) (add-inst `(se* ,pos ,elem)) (setf (flexichain:element* *fc-real* pos) elem) @@ -111,19 +112,6 @@ (setf (flexichain:cursor-pos (elt *cursors-real* elt)) pos) (setf (stupid:cursor-pos (elt *cursors-fake* elt)) pos)) -(defun m< (&optional (elt (random (length *cursors-real*)))) - (unless (zerop (stupid:cursor-pos (elt *cursors-fake* elt))) - (add-inst `(m< ,elt)) - (flexichain:move< (elt *cursors-real* elt)) - (stupid:move< (elt *cursors-fake* elt)))) - -(defun m> (&optional (elt (random (length *cursors-fake*)))) - (unless (= (stupid:cursor-pos (elt *cursors-fake* elt)) - (stupid:nb-elements (stupid:chain (elt *cursors-fake* elt)))) - (add-inst `(m> ,elt)) - (flexichain:move> (elt *cursors-real* elt)) - (stupid:move> (elt *cursors-fake* elt)))) - (defun ii (&optional (elt (random (length *cursors-fake*))) (elem (random 1000000))) @@ -178,14 +166,11 @@ (defun mc () (randomcase (mlc) (mrc))) -(defun mov () - (randomcase (m<) (m>))) - (defun test-step () - (compare) (when (zerop (random 200)) (setf *ins-del-state* (not *ins-del-state*))) - (randomcase (i-or-d) (setel) (mc) (cc) (scp) (mov))) + (randomcase (i-or-d) (setel) (mc) (cc) (scp)) + (compare)) (defun reset-all () (setf *instructions* '()) @@ -195,15 +180,16 @@ (setf *fc-real* (make-instance 'flexichain:standard-cursorchain)) (setf *fc-fake* (make-instance 'stupid:standard-cursorchain))) -(defun tester () +(defun tester (&optional (n 1)) (reset-all) (mlc) (mrc) - (loop repeat 100000 + (loop repeat n do (test-step))) (defun replay (instructions) (let ((*instructions* '())) (reset-all) (loop for inst in (reverse instructions) - do (apply (car inst) (cdr inst))))) + do (apply (car inst) (cdr inst)) + (compare))))

1 0

[gsharp-cvs] CVS update: gsharp/Flexichain/Doc/flexichain.tex
by Robert Strandh 06 Sep '04

06 Sep '04

Update of /project/gsharp/cvsroot/gsharp/Flexichain/Doc In directory common-lisp.net:/tmp/cvs-serv16372 Modified Files: flexichain.tex Log Message: Added the (setf cursor-pos) generic function. Removed the move> and move< functions from the protocol, because they can be replaced by incf and decf on cursor-pos. Date: Mon Sep 6 13:18:42 2004 Author: rstrandh Index: gsharp/Flexichain/Doc/flexichain.tex diff -u gsharp/Flexichain/Doc/flexichain.tex:1.2 gsharp/Flexichain/Doc/flexichain.tex:1.3 --- gsharp/Flexichain/Doc/flexichain.tex:1.2 Fri Aug 6 17:47:36 2004 +++ gsharp/Flexichain/Doc/flexichain.tex Mon Sep 6 13:18:42 2004 @@ -581,10 +581,21 @@ Create a cursor that is initially at the same location as the one given as argument. +\Deferror {flexi-position-error} + +This condition is signaled whenever an attempt is made to use position +outside of the range of valid positions. + \Defgeneric {cursor-pos} {cursor} Return the position of the cursor. +\Defgeneric {(setf cursor-pos)} {position cursor} + +Set the position of the cursor. If the new position of the cursor is +before the first position or after the last position of the chain, the +condition \cl{flexi-position-error} is signaled. + \Defgeneric {at-beginning-p} {cursor} Return true if the cursor is at the beginning of the chain (i.e., if @@ -606,18 +617,6 @@ This condition is signaled whenever an attempt is made to move a cursor beyond the end of the chain. - -\Defgeneric {move>} {cursor \optional (n 1)} - -More the cursor forward n positions. If the cursor is at a position -greater than $l - n$ where $l$ is the length of the chain, then the -condition \cl{at-end} will be signaled. - -\Defgeneric {move<} {cursor \optional (n 1)} - -More the cursor backward n positions. If the cursor is at a -position less than n, then the condition \cl{at-beginning} will be -signaled. \Deferror {incompatible-object-type}

1 0

[gsharp-cvs] CVS update: gsharp/Flexichain/flexicursor.lisp gsharp/Flexichain/rtester.lisp
by Robert Strandh 02 Sep '04

02 Sep '04

Update of /project/gsharp/cvsroot/gsharp/Flexichain In directory common-lisp.net:/tmp/cvs-serv6500 Modified Files: flexicursor.lisp rtester.lisp Log Message: Fixed a bug where (setf cursor-pos) did not modify the skiplist. Used the new version of (setf cursor-pos) to make move> and move< much shorter than before. Fixed a problem in the new random tester where the name of the function to be applied was not recorded correctly. Date: Thu Sep 2 08:23:50 2004 Author: rstrandh Index: gsharp/Flexichain/flexicursor.lisp diff -u gsharp/Flexichain/flexicursor.lisp:1.6 gsharp/Flexichain/flexicursor.lisp:1.7 --- gsharp/Flexichain/flexicursor.lisp:1.6 Wed Sep 1 07:55:11 2004 +++ gsharp/Flexichain/flexicursor.lisp Thu Sep 2 08:23:50 2004 @@ -171,7 +171,12 @@ (assert (<= 0 position (nb-elements (chain cursor))) () 'flexi-position-error :chain (chain cursor) :position position) (with-slots (chain index) cursor - (setf index (position-index chain (1- position))))) + (with-slots (cursors) chain + (setf (skiplist-find cursors index) + (delete cursor (skiplist-find cursors index) + :key #'wp-value :test #'eq)) + (setf index (position-index chain (1- position))) + (push (make-wp cursor) (skiplist-find cursors index))))) (defmethod cursor-pos ((cursor right-sticky-flexicursor)) (index-position (chain cursor) (slot-value cursor 'index))) @@ -180,7 +185,12 @@ (assert (<= 0 position (nb-elements (chain cursor))) () 'flexi-position-error :chain (chain cursor) :position position) (with-slots (chain index) cursor - (setf index (position-index chain position)))) + (with-slots (cursors) chain + (setf (skiplist-find cursors index) + (delete cursor (skiplist-find cursors index) + :key #'wp-value :test #'eq)) + (setf index (position-index chain position)) + (push (make-wp cursor) (skiplist-find cursors index))))) (defmethod at-beginning-p ((cursor standard-flexicursor)) (zerop (cursor-pos cursor))) @@ -189,32 +199,10 @@ (= (cursor-pos cursor) (nb-elements (chain cursor)))) (defmethod move> ((cursor standard-flexicursor) &optional (n 1)) - (cond ((minusp n) (move< cursor (- n))) - ((zerop n) nil) - (t (let ((cursor-pos (cursor-pos cursor))) - (assert (<= (+ n cursor-pos) (nb-elements (chain cursor))) () - 'at-end-error :cursor cursor) - (with-slots (cursors) (chain cursor) - (with-slots (index) cursor - (setf (skiplist-find cursors index) - (delete cursor (skiplist-find cursors index) - :key #'wp-value :test #'eq)) - (setf (cursor-pos cursor) (+ cursor-pos n)) - (push (make-wp cursor) (skiplist-find cursors index)))))))) + (incf (cursor-pos cursor) n)) (defmethod move< ((cursor standard-flexicursor) &optional (n 1)) - (cond ((minusp n) (move> cursor (- n))) - ((zerop n) nil) - (t (let ((cursor-pos (cursor-pos cursor))) - (assert (>= cursor-pos n) () - 'at-beginning-error :cursor cursor) - (with-slots (cursors) (chain cursor) - (with-slots (index) cursor - (setf (skiplist-find cursors index) - (delete cursor (skiplist-find cursors index) - :key #'wp-value :test #'eq)) - (setf (cursor-pos cursor) (- cursor-pos n)) - (push (make-wp cursor) (skiplist-find cursors index)))))))) + (decf (cursor-pos cursor) n)) (defmethod insert ((cursor standard-flexicursor) object) (insert* (chain cursor) (cursor-pos cursor) object)) Index: gsharp/Flexichain/rtester.lisp diff -u gsharp/Flexichain/rtester.lisp:1.1 gsharp/Flexichain/rtester.lisp:1.2 --- gsharp/Flexichain/rtester.lisp:1.1 Wed Sep 1 07:55:11 2004 +++ gsharp/Flexichain/rtester.lisp Thu Sep 2 08:23:50 2004 @@ -80,7 +80,7 @@ (unless pos (setf pos (random (flexichain:nb-elements *fc-real*)) elem (random 1000000))) - (add-inst `(setf element* ,pos ,elem)) + (add-inst `(se* ,pos ,elem)) (setf (flexichain:element* *fc-real* pos) elem) (setf (stupid:element* *fc-fake* pos) elem))) @@ -182,6 +182,7 @@ (randomcase (m<) (m>))) (defun test-step () + (compare) (when (zerop (random 200)) (setf *ins-del-state* (not *ins-del-state*))) (randomcase (i-or-d) (setel) (mc) (cc) (scp) (mov))) @@ -195,6 +196,7 @@ (setf *fc-fake* (make-instance 'stupid:standard-cursorchain))) (defun tester () + (reset-all) (mlc) (mrc) (loop repeat 100000

1 0

[gsharp-cvs] CVS update: gsharp/Flexichain/rtester.lisp gsharp/Flexichain/stupid.lisp gsharp/Flexichain/flexicursor.lisp
by Robert Strandh 01 Sep '04

01 Sep '04

Update of /project/gsharp/cvsroot/gsharp/Flexichain In directory common-lisp.net:/tmp/cvs-serv10291 Modified Files: flexicursor.lisp Added Files: rtester.lisp stupid.lisp Log Message: Added a stupid (but straightforward) implementation of the flexichain protocol. The idea is to generate random test cases and compare the result to that obtained with the stupid implementation. Added a random tester facility that uses the normal and the stupid implementations. Fixed a problem in the flexicursor implementation that made clone-cursor do the wrong thing. Added initarg :position for creating flexicursors. Date: Wed Sep 1 07:55:11 2004 Author: rstrandh Index: gsharp/Flexichain/flexicursor.lisp diff -u gsharp/Flexichain/flexicursor.lisp:1.5 gsharp/Flexichain/flexicursor.lisp:1.6 --- gsharp/Flexichain/flexicursor.lisp:1.5 Sun Aug 22 07:01:02 2004 +++ gsharp/Flexichain/flexicursor.lisp Wed Sep 1 07:55:11 2004 @@ -144,29 +144,25 @@ (defclass right-sticky-flexicursor (standard-flexicursor) ()) (defmethod initialize-instance :after ((cursor left-sticky-flexicursor) - &rest initargs) + &rest initargs &key (position 0)) (declare (ignore initargs)) (with-slots (index chain) cursor - (setf index (slot-value chain 'data-start)) + (setf index (position-index chain (1- position))) (with-slots (cursors) chain (push (make-wp cursor) (skiplist-find cursors index))))) (defmethod initialize-instance :after ((cursor right-sticky-flexicursor) - &rest initargs) + &rest initargs &key (position 0)) (declare (ignore initargs)) (with-slots (index chain) cursor - (setf index (position-index chain 0)) + (setf index (position-index chain position)) (with-slots (cursors) chain (push (make-wp cursor) (skiplist-find cursors index))))) (defmethod clone-cursor ((cursor standard-flexicursor)) - (with-slots (index) cursor - (let ((result (make-instance (class-of cursor) - :chain (chain cursor)))) - (setf (slot-value result 'index) index) - (with-slots (cursors) (chain cursor) - (push (make-wp result) (skiplist-find cursors index))) - result))) + (make-instance (class-of cursor) + :chain (chain cursor) + :position (cursor-pos cursor))) (defmethod cursor-pos ((cursor left-sticky-flexicursor)) (1+ (index-position (chain cursor) (slot-value cursor 'index)))) @@ -274,7 +270,7 @@ 'at-beginning-error :cursor cursor) (element* (chain cursor) (1- (cursor-pos cursor)))) -(defmethod (setf element>) (object (cursor standard-flexicursor)) +(defmethod (setf element<) (object (cursor standard-flexicursor)) (assert (not (at-beginning-p cursor)) () 'at-beginning-error :cursor cursor) (setf (element* (chain cursor) (1- (cursor-pos cursor)))

1 0

[gsharp-cvs] CVS update: gsharp/Flexichain/flexichain.lisp gsharp/Flexichain/flexicursor.lisp
by Robert Strandh 22 Aug '04

22 Aug '04

Update of /project/gsharp/cvsroot/gsharp/Flexichain In directory common-lisp.net:/tmp/cvs-serv8545 Modified Files: flexichain.lisp flexicursor.lisp Log Message: Fixed a bug where cursors were not deleted from the skiplist before the were moved, which resulted in multiple entries of a cursor in the skiplist. Fixed a test in flexichain the purpose of which was to determine whether to hop or to move was wrong, resulting in too many objects being moved in some cases. Date: Sat Aug 21 22:01:03 2004 Author: rstrandh Index: gsharp/Flexichain/flexichain.lisp diff -u gsharp/Flexichain/flexichain.lisp:1.3 gsharp/Flexichain/flexichain.lisp:1.4 --- gsharp/Flexichain/flexichain.lisp:1.3 Thu Aug 19 06:58:54 2004 +++ gsharp/Flexichain/flexichain.lisp Sat Aug 21 22:01:02 2004 @@ -331,7 +331,7 @@ on the right of the buffer." (with-slots (buffer gap-start gap-end) chain (let ((buffer-size (length buffer))) - (cond ((< (- gap-start hot-spot) (- buffer-size gap-start)) + (cond ((< (- gap-start hot-spot) hot-spot) (push-elements-right chain (- gap-start hot-spot))) ((<= hot-spot (- buffer-size gap-start)) (hop-elements-right chain hot-spot)) Index: gsharp/Flexichain/flexicursor.lisp diff -u gsharp/Flexichain/flexicursor.lisp:1.4 gsharp/Flexichain/flexicursor.lisp:1.5 --- gsharp/Flexichain/flexicursor.lisp:1.4 Thu Aug 19 06:58:54 2004 +++ gsharp/Flexichain/flexicursor.lisp Sat Aug 21 22:01:02 2004 @@ -201,7 +201,7 @@ (with-slots (cursors) (chain cursor) (with-slots (index) cursor (setf (skiplist-find cursors index) - (delete index (skiplist-find cursors index) + (delete cursor (skiplist-find cursors index) :key #'wp-value :test #'eq)) (setf (cursor-pos cursor) (+ cursor-pos n)) (push (make-wp cursor) (skiplist-find cursors index)))))))) @@ -215,7 +215,7 @@ (with-slots (cursors) (chain cursor) (with-slots (index) cursor (setf (skiplist-find cursors index) - (delete index (skiplist-find cursors index) + (delete cursor (skiplist-find cursors index) :key #'wp-value :test #'eq)) (setf (cursor-pos cursor) (- cursor-pos n)) (push (make-wp cursor) (skiplist-find cursors index))))))))

1 0