From rstrandh at common-lisp.net Mon Jan 3 06:44:43 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Mon, 3 Jan 2005 07:44:43 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/Flexichain/flexicursor.lisp Message-ID: <20050103064443.2AF12884A9@common-lisp.net> 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)))))))) From tmoore at common-lisp.net Fri Jan 14 16:12:43 2005 From: tmoore at common-lisp.net (Timothy Moore) Date: Fri, 14 Jan 2005 17:12:43 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/Flexichain/flexicursor.lisp gsharp/Flexichain/utilities.lisp Message-ID: <20050114161243.236B6884A9@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp/Flexichain In directory common-lisp.net:/tmp/cvs-serv18364 Modified Files: flexicursor.lisp utilities.lisp Log Message: Generalized weak pointer support and added an implementation for OpenMCL. Date: Fri Jan 14 17:12:42 2005 Author: tmoore Index: gsharp/Flexichain/flexicursor.lisp diff -u gsharp/Flexichain/flexicursor.lisp:1.9 gsharp/Flexichain/flexicursor.lisp:1.10 --- gsharp/Flexichain/flexicursor.lisp:1.9 Mon Jan 3 07:44:42 2005 +++ gsharp/Flexichain/flexicursor.lisp Fri Jan 14 17:12:41 2005 @@ -96,18 +96,11 @@ (defgeneric (setf element>) (object cursor) (:documentation "Replaces the element immediately after the cursor.")) -(defclass standard-cursorchain (cursorchain standard-flexichain) +(defclass standard-cursorchain + (weak-pointer-container-mixin cursorchain standard-flexichain) ((cursors :initform '())) (:documentation "The standard instantiable subclass of CURSORCHAIN")) -(defun make-wp (value) - #+sbcl (sb-ext:make-weak-pointer value) - #+cmu (ext:make-weak-pointer value)) - -(defun wp-value (wp) - #+sbcl (sb-ext:weak-pointer-value wp) - #+cmu (ext:weak-pointer-value wp)) - (defclass standard-flexicursor (flexicursor) ((chain :reader chain :initarg :chain) (index :accessor flexicursor-index)) @@ -123,7 +116,7 @@ (with-slots (index chain) cursor (setf index (position-index chain (1- position))) (with-slots (cursors) chain - (push (make-wp cursor) cursors)))) + (push (make-weak-pointer cursor chain) cursors)))) (defmethod initialize-instance :after ((cursor right-sticky-flexicursor) &rest initargs &key (position 0)) @@ -131,30 +124,32 @@ (with-slots (index chain) cursor (setf index (position-index chain position)) (with-slots (cursors) chain - (push (make-wp cursor) cursors)))) + (push (make-weak-pointer cursor chain) cursors)))) -(defun adjust-cursors (cursors start end increment) +(defun adjust-cursors (chain 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) + (loop + for cursor = (and cursors (weak-pointer-value (car cursors) chain)) + while cursors + do (cond ((null cursor) + (pop cursors)) + ((<= start (flexicursor-index cursor) end) + (incf (flexicursor-index cursor) 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))))) + (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))))) + (setf cursors (adjust-cursors cc cursors start2 (1- end2) (- start1 start2))))) (defmethod clone-cursor ((cursor standard-flexicursor)) (make-instance (class-of cursor) @@ -200,7 +195,7 @@ (with-slots (cursors) chain (let* ((old-index (position-index chain position))) (loop for cursor-wp in cursors - as cursor = (wp-value cursor-wp) + as cursor = (weak-pointer-value cursor-wp chain) when (and cursor (= old-index (flexicursor-index cursor))) do (typecase cursor (right-sticky-flexicursor (incf (cursor-pos cursor))) Index: gsharp/Flexichain/utilities.lisp diff -u gsharp/Flexichain/utilities.lisp:1.1 gsharp/Flexichain/utilities.lisp:1.2 --- gsharp/Flexichain/utilities.lisp:1.1 Sun Aug 1 17:27:19 2004 +++ gsharp/Flexichain/utilities.lisp Fri Jan 14 17:12:41 2005 @@ -34,17 +34,52 @@ (values nil nil) (values (elt sequence position) t)))) -(defun make-weak-pointer (object) - "Returns a weak pointer to OBJECT." - #+cmu (extensions:make-weak-pointer object) - #+sbcl (sb-ext:make-weak-pointer object) - #-(or cmu sbcl) (error "MAKE-WEAK-POINTER not implemented.")) - -(defun weak-pointer-value (weak-pointer) - ;; TODO: check other CL implementations behavior wrt. return values - "Returns the object pointed to by WEAK-POINTER or NIL if the pointer -is broken." +;;; CMUCL and SBCL have direct support for weak pointers. In OpenMCL weak +;;; references are only supported via weak hash tables. This class provides +;;; the means for other classes to manage their weak references. +;;; +;;; TODO: check other CL implementations behavior wrt. return values +(defclass weak-pointer-container-mixin () + #+openmcl + ((weak-hash :initform (make-hash-table :test #'eq :weak :value))) + (:documentation "Support for weak references, if needed")) + +(defgeneric make-weak-pointer (object container)) + +#+(or sbcl cmu) +(defmethod make-weak-pointer (object container) + (declare (ignore container)) + #+cmu (extensions:make-weak-pointer object) + #+sbcl (sb-ext:make-weak-pointer object)) + +#+openmcl +(defmethod make-weak-pointer (object (container weak-pointer-container-mixin)) + (let ((key (cons nil nil))) + (setf (gethash key (slot-value container 'weak-hash)) object) + key)) + +(defgeneric weak-pointer-value (weak-pointer container)) + +#+(or sbcl cmu) +(defmethod weak-pointer-value (weak-pointer container) + (declare (ignore container)) #+cmu (extensions:weak-pointer-value weak-pointer) - #+sbcl (sb-ext:weak-pointer-value weak-pointer) - #-(or cmu sbcl) (error "WEAK-POINTER-VALUE not implemented.")) + #+sbcl (sb-ext:weak-pointer-value weak-pointer)) + +#+openmcl +(defmethod weak-pointer-value + (weak-pointer (container weak-pointer-container-mixin)) + (gethash weak-pointer (slot-value container 'weak-hash) nil)) +#-(or sbcl cmu openmcl) +(progn + (eval-when (:evaluate :compile-toplevel :load-toplevel) + (warning "No support for weak pointers in this implementation. Things may +get big and slow") + ) + (defmethod make-weak-pointer (object container) + (declare (ignore container)) + object) + (defmethod weak-pointer-value (weak-pointer container) + (declare (ignore container)) + weak-pointer)) From tmoore at common-lisp.net Sat Jan 15 08:43:53 2005 From: tmoore at common-lisp.net (Timothy Moore) Date: Sat, 15 Jan 2005 09:43:53 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/Flexichain/utilities.lisp Message-ID: <20050115084353.76EFB884B9@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp/Flexichain In directory common-lisp.net:/tmp/cvs-serv4778 Modified Files: utilities.lisp Log Message: Fixed non-openmcl typo Date: Sat Jan 15 09:43:50 2005 Author: tmoore Index: gsharp/Flexichain/utilities.lisp diff -u gsharp/Flexichain/utilities.lisp:1.2 gsharp/Flexichain/utilities.lisp:1.3 --- gsharp/Flexichain/utilities.lisp:1.2 Fri Jan 14 17:12:41 2005 +++ gsharp/Flexichain/utilities.lisp Sat Jan 15 09:43:50 2005 @@ -40,8 +40,8 @@ ;;; ;;; TODO: check other CL implementations behavior wrt. return values (defclass weak-pointer-container-mixin () - #+openmcl - ((weak-hash :initform (make-hash-table :test #'eq :weak :value))) + (#+openmcl + (weak-hash :initform (make-hash-table :test #'eq :weak :value))) (:documentation "Support for weak references, if needed")) (defgeneric make-weak-pointer (object container)) From rstrandh at common-lisp.net Mon Jan 17 05:32:08 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Mon, 17 Jan 2005 06:32:08 +0100 (CET) Subject: [gsharp-cvs] CVS update: gsharp/Flexichain/flexichain.asd Message-ID: <20050117053208.50192884A5@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp/Flexichain In directory common-lisp.net:/tmp/cvs-serv14516 Modified Files: flexichain.asd Log Message: patch to reflect new package files. Date: Mon Jan 17 06:32:07 2005 Author: rstrandh Index: gsharp/Flexichain/flexichain.asd diff -u gsharp/Flexichain/flexichain.asd:1.1 gsharp/Flexichain/flexichain.asd:1.2 --- gsharp/Flexichain/flexichain.asd:1.1 Sun Aug 1 17:27:19 2004 +++ gsharp/Flexichain/flexichain.asd Mon Jan 17 06:32:06 2005 @@ -24,9 +24,15 @@ (in-package #:flexichain-system) +;; The tester is not included, for it depends on clim. The stupid +;; implementation has also been left out, since it seems mostly useful +;; for testing. (defsystem flexichain :name "flexichain" - :components ((:file "package") - (:file "utilities" :depends-on ("package")) + :components ((:file "skiplist-package") + (:file "skiplist" :depends-on ("skiplist-package")) + (:file "flexichain-package" :depends-on ("skiplist-package")) + (:file "utilities" :depends-on ("flexichain-package")) (:file "flexichain" :depends-on ("utilities")) (:file "flexicursor" :depends-on ("flexichain")))) + From crhodes at common-lisp.net Tue Jan 25 11:08:40 2005 From: crhodes at common-lisp.net (Christophe Rhodes) Date: Tue, 25 Jan 2005 03:08:40 -0800 (PST) Subject: [gsharp-cvs] CVS update: gsharp/Flexichain/Doc/flexichain.tex Message-ID: <20050125110840.70D9D88394@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp/Flexichain/Doc In directory common-lisp.net:/tmp/cvs-serv8287/Flexichain/Doc Modified Files: flexichain.tex Log Message: s/elemement/element/ in flexichain spec. Date: Tue Jan 25 03:08:36 2005 Author: crhodes Index: gsharp/Flexichain/Doc/flexichain.tex diff -u gsharp/Flexichain/Doc/flexichain.tex:1.3 gsharp/Flexichain/Doc/flexichain.tex:1.4 --- gsharp/Flexichain/Doc/flexichain.tex:1.3 Mon Sep 6 04:18:42 2004 +++ gsharp/Flexichain/Doc/flexichain.tex Tue Jan 25 03:08:32 2005 @@ -663,7 +663,7 @@ after the last operation has been completed, thus making it more efficient to use this macro than to use individual editing operations. -\Defgeneric {elemement<} {cursor} +\Defgeneric {element<} {cursor} Return the element immediately before the cursor. If the cursor is at the beginning, an at-beginning condition will be signaled. @@ -674,7 +674,7 @@ as argument. If the cursor is at the beginning, an at-beginning condition will be signaled. -\Defgeneric {elemement>} {cursor} +\Defgeneric {element>} {cursor} Return the element immediately after the cursor. If the cursor is at the end, an at-end condition will be signaled.