[gsharp-cvs] CVS update: gsharp/Flexichain/flexicursor.lisp gsharp/Flexichain/rtester.lisp

[Robert Strandh]

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