[movitz-cvs] CVS movitz/losp/muerte

ffjeld ffjeld at common-lisp.net
Thu Apr 17 19:34:08 UTC 2008


Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory clnet:/tmp/cvs-serv14683

Modified Files:
	hash-tables.lisp 
Log Message:
Fix the utterly broken remhash.


--- /project/movitz/cvsroot/movitz/losp/muerte/hash-tables.lisp	2007/02/06 20:03:57	1.13
+++ /project/movitz/cvsroot/movitz/losp/muerte/hash-tables.lisp	2008/04/17 19:34:08	1.14
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Mon Feb 19 19:09:05 2001
 ;;;;                
-;;;; $Id: hash-tables.lisp,v 1.13 2007/02/06 20:03:57 ffjeld Exp $
+;;;; $Id: hash-tables.lisp,v 1.14 2008/04/17 19:34:08 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -246,8 +246,9 @@
       ((>= i bucket-length) nil)
     (declare ((index 2) i index2))
     (let ((x (svref bucket index2)))
-      (when (or (eq x '--no-hash-key--)
-		(funcall (hash-table-test hash-table) x key))
+      (when (eq x '--no-hash-key--)
+	(return nil))
+      (when (funcall (hash-table-test hash-table) x key)
 	(setf (svref bucket index2) '--no-hash-key--)
 	(decf (hash-table-count hash-table))
 	;; Now we must rehash any entries that might have been
@@ -257,10 +258,11 @@
 	    ((= i index2))
 	  (declare ((index 2) i))
 	  (let ((k (svref bucket i)))
-	    (when (eq x '--no-hash-key--)
+	    (when (eq k '--no-hash-key--)
 	      (return))
 	    (let ((v (svref bucket (1+ i))))
 	      (setf (svref bucket i) '--no-hash-key--) ; remove
+	      (decf (hash-table-count hash-table))
 	      (setf (gethash k hash-table) v)))) ; insert (hopefully this is safe..)
 	(return t)))))
 
@@ -282,5 +284,5 @@
 	    (get-next-entry)
 	  (if (not entry-p)
 	      (return nil)
-	    (map key value)))))))
+	      (map key value)))))))
 	




More information about the Movitz-cvs mailing list