[flexichain-cvs] CVS update: flexichain/flexirank.lisp flexichain/utilities.lisp

[Robert Strandh]

Update of /project/flexichain/cvsroot/flexichain
In directory clnet:/tmp/cvs-serv18847

Modified Files:
	flexirank.lisp utilities.lisp 
Log Message:
Improvements from Tim Moore with respect to weak pointers on Allegro.


Date: Mon Mar 13 13:13:33 2006
Author: rstrandh

Index: flexichain/flexirank.lisp
diff -u flexichain/flexirank.lisp:1.1.1.1 flexichain/flexirank.lisp:1.2
--- flexichain/flexirank.lisp:1.1.1.1	Wed Feb  8 21:51:06 2006
+++ flexichain/flexirank.lisp	Mon Mar 13 13:13:33 2006
@@ -75,5 +75,5 @@
 (defmethod insert-vector* :after ((chain flexirank-mixin) position vector)
   (loop for elem across vector
 	for pos from position
-	do (setf (index elem) (position-index pos)
+	do (setf (index elem) (position-index chain pos)
 		 (chain elem) chain)))


Index: flexichain/utilities.lisp
diff -u flexichain/utilities.lisp:1.1.1.1 flexichain/utilities.lisp:1.2
--- flexichain/utilities.lisp:1.1.1.1	Wed Feb  8 21:51:06 2006
+++ flexichain/utilities.lisp	Mon Mar 13 13:13:33 2006
@@ -34,14 +34,17 @@
         (values nil nil)
         (values (elt sequence position) t))))
 
-;;; 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.
-;;;
+;;; CMUCL and SBCL have direct support for weak pointers. In OpenMCL and
+;;; Allegro 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)))
+  (#+(or openmcl allegro)
+  (weak-hash :initform (make-hash-table :test #'eql
+					 ;; Get it together guys!
+					 #+openmcl :weak #+openmcl :value
+					 #+allegro :values #+allegro :weak))
+  (key-counter :initform 0))
   (:documentation "Support for weak references, if needed"))
 
 (defgeneric make-weak-pointer (object container))
@@ -52,9 +55,9 @@
     #+cmu (extensions:make-weak-pointer object)
     #+sbcl (sb-ext:make-weak-pointer object))
 
-#+openmcl
+#+(or openmcl allegro)
 (defmethod make-weak-pointer (object (container weak-pointer-container-mixin))
-  (let ((key (cons nil nil)))
+  (let ((key (incf (slot-value container 'key-counter))))
     (setf (gethash key (slot-value container 'weak-hash)) object)
     key))
 
@@ -66,15 +69,20 @@
   #+cmu (extensions:weak-pointer-value weak-pointer)
   #+sbcl (sb-ext:weak-pointer-value weak-pointer))
 
-#+openmcl
+#+(or openmcl allegro)
 (defmethod weak-pointer-value
     (weak-pointer (container weak-pointer-container-mixin))
-  (gethash weak-pointer (slot-value container 'weak-hash) nil))
+  (let* ((table (slot-value container 'weak-hash))
+	 (val (gethash weak-pointer table)))
+    #+allegro
+    (unless val
+      (remhash weak-pointer table))
+    val))
 
 #-(or sbcl cmu openmcl)
 (progn
   (eval-when (:evaluate :compile-toplevel :load-toplevel)
-    (warning "No support for weak pointers in this implementation. Things may
+    (warn "No support for weak pointers in this implementation. Things may
 get big and slow")
     )
   (defmethod make-weak-pointer (object container)