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