Implementation of hashtables with weak keys and/or values.

MAKE-HASH-TABLE now has an optional :WEAKNESS argument that can take
the values :KEY, :VALUE, :KEY-AND-VALUE, or :KEY-OR-VALUE.  :KEY means
that the key of an entry must be live to guarantee that the entry is
preserved. VALUE means that the value of an entry must be live to
guarantee that the entry is preserved.  :KEY-AND-VALUE means that both
the key and the value must be live to guarantee that the entry is
preserved.  :KEY-OR-VALUE means that either the key or the value must
be live to guarantee that the entry is preserved.

The tests simply excercise the various types of weak hash tables
enough that a GC phase should show that the table indeed does decrease
in size.

Changed the defition of functions in HashTableFunctions to match
current docstring/pf_XXX() naming conventions.

This implementation is only lightly tested in single-threaded use, and
untested in multiple threading scenarios.

Addresses ticket:140.
parent 15ff5143
......@@ -55,6 +55,8 @@
("file-system-tests"))
(:file "wild-pathnames" :depends-on
("file-system-tests"))
#+abcl
(:file "weak-hash-tables")
#+abcl
(:file "pathname-tests" :depends-on
("utilities"))))))
......
......@@ -98,6 +98,8 @@ public final class Keyword
JAVA_1_6 = internKeyword("JAVA-1.6"),
JAVA_1_7 = internKeyword("JAVA-1.7"),
KEY = internKeyword("KEY"),
KEY_AND_VALUE = internKeyword("KEY-AND-VALUE"),
KEY_OR_VALUE = internKeyword("KEY-OR-VALUE"),
LINUX = internKeyword("LINUX"),
LOAD_TOPLEVEL = internKeyword("LOAD-TOPLEVEL"),
LOCAL = internKeyword("LOCAL"),
......@@ -144,6 +146,7 @@ public final class Keyword
UP = internKeyword("UP"),
UPCASE = internKeyword("UPCASE"),
USE = internKeyword("USE"),
VALUE = internKeyword("VALUE"),
VERSION = internKeyword("VERSION"),
WILD = internKeyword("WILD"),
WILD_INFERIORS = internKeyword("WILD-INFERIORS"),
......
This diff is collapsed.
......@@ -32,9 +32,23 @@
(in-package #:system)
(defun make-hash-table (&key (test 'eql) (size 11) (rehash-size 1.5)
(rehash-threshold 0.75))
(rehash-threshold 0.75)
(weakness nil))
(setf test (coerce-to-function test))
(unless (and (integerp size) (>= size 0))
(error 'type-error :datum size :expected-type '(integer 0)))
(let ((size (max 11 (min size array-dimension-limit))))
(%make-hash-table test size rehash-size rehash-threshold)))
(let ((size (max 11 (min size array-dimension-limit)))
(weakness-types '(or (eql :key) (eql :value)
(eql :key-and-value)
(eql :key-or-value))))
(if weakness
(if (not (typep weakness weakness-types))
(error 'type-error :datum weakness
:expected-type weakness-types)
(%make-weak-hash-table test size rehash-size
rehash-threshold weakness))
(%make-hash-table test size
rehash-size rehash-threshold))))
(in-package #:abcl.test.lisp)
#|
(deftest weak-hash-table.1
(labels ((random-key ()
(coerce (/ (random 10000) (random 10000))
'single-float)))
(let ((ht (make-hash-table :weakness :keys))
(dotimes (i 1000)
(setf (gethash (random-key) ht) (random 100000))
(sys::hash-table-entries ht)
|#
(defun random-object ()
"A randomly constructed object that is elgible for garbage collection."
(coerce (/ (random 10000) (1+ (random 10000)))
'single-float))
(deftest weak-hash-table.1
(let* ((ht (make-hash-table :weakness :key))
(entries 0))
(dotimes (i 100000)
(setf (gethash (random-object) ht) (random 100000))
(let ((new-entries (sys::hash-table-count ht)))
(when (and new-entries
(> entries new-entries))
(format t "~&Previously ~A entries, now ~A."
entries new-entries))
(setf entries new-entries))))
nil)
(deftest weak-hash-table.2
(let* ((ht (make-hash-table :weakness :value))
(entries 0))
(dotimes (i 100000)
(setf (gethash (random-object) ht) (random 100000))
(let ((new-entries (sys::hash-table-count ht)))
(when (and new-entries
(> entries new-entries))
(format t "~&Previously ~A entries, now ~A."
entries new-entries))
(setf entries new-entries))))
nil)
(deftest weak-hash-table.3
(let* ((ht (make-hash-table :weakness :key-and-value))
(entries 0))
(dotimes (i 100000)
(setf (gethash (random-object) ht) (random 100000))
(let ((new-entries (sys::hash-table-count ht)))
(when (and new-entries
(> entries new-entries))
(format t "~&Previously ~A entries, now ~A."
entries new-entries))
(setf entries new-entries))))
nil)
(deftest weak-hash-table.4
(let* ((ht (make-hash-table :weakness :key-or-value))
(entries 0))
(dotimes (i 100000)
(setf (gethash (random-object) ht) (random 100000))
(let ((new-entries (sys::hash-table-count ht)))
(when (and new-entries
(> entries new-entries))
(format t "~&Previously ~A entries, now ~A."
entries new-entries))
(setf entries new-entries))))
nil)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment