September 2004 - gsharp-cvs@common-lisp.net

[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