summaryrefslogtreecommitdiff
path: root/Lisp/weak-hash-tables.lisp
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2007-08-04 15:01:53 +0200
committerMatthias Benkard <code@mail.matthias.benkard.de>2007-08-04 15:01:53 +0200
commit4765624c39dffb085554b1459b3e80bcbf347791 (patch)
tree55408134eb69247c8020c540bd65060ba951c439 /Lisp/weak-hash-tables.lisp
parent533f953b4dd068e1c76c67e7c27e820606f649bf (diff)
Refactor directory and source file layout.
darcs-hash:0eb031a60f3b86a678869960867410811ca5325c
Diffstat (limited to 'Lisp/weak-hash-tables.lisp')
-rw-r--r--Lisp/weak-hash-tables.lisp33
1 files changed, 33 insertions, 0 deletions
diff --git a/Lisp/weak-hash-tables.lisp b/Lisp/weak-hash-tables.lisp
new file mode 100644
index 0000000..6221d8a
--- /dev/null
+++ b/Lisp/weak-hash-tables.lisp
@@ -0,0 +1,33 @@
+(in-package #:mulk.objective-cl)
+
+
+#+cmu
+(progn
+ (declaim (inline make-weak-value-hash-table))
+
+ (defun make-weak-value-hash-table ()
+ (make-hash-table :test 'eql))
+
+ (defun weak-gethash (key hash-table &optional (default nil))
+ (let ((pointer (gethash key hash-table default)))
+ (or (and (trivial-garbage:weak-pointer-p pointer)
+ (trivial-garbage:weak-pointer-value pointer))
+ (prog1 default
+ ;; Clean up.
+ (remhash key hash-table)))))
+
+ (defun (setf weak-gethash) (value key hash-table)
+ (setf (gethash key hash-table)
+ (trivial-garbage:make-weak-pointer value))))
+
+
+#-cmu
+(progn
+ (declaim (inline make-weak-value-hash-table))
+
+ (defun make-weak-value-hash-table ()
+ (trivial-garbage:make-weak-hash-table :weakness :value
+ :test 'eql))
+
+ (setf (fdefinition 'weak-gethash) (fdefinition 'gethash)
+ (fdefinition '(setf weak-gethash)) (fdefinition '(setf gethash))))