diff options
author | Matthias Benkard <code@mail.matthias.benkard.de> | 2007-08-04 15:01:53 +0200 |
---|---|---|
committer | Matthias Benkard <code@mail.matthias.benkard.de> | 2007-08-04 15:01:53 +0200 |
commit | 4765624c39dffb085554b1459b3e80bcbf347791 (patch) | |
tree | 55408134eb69247c8020c540bd65060ba951c439 /Lisp/weak-hash-tables.lisp | |
parent | 533f953b4dd068e1c76c67e7c27e820606f649bf (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.lisp | 33 |
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)))) |