[slime-devel] Slime/Allegro and make-weak-key-hash-table

[Lynn Quam]

I experimented a bit with weak hashtables and SLIME in in both Allegro
and CMUCL.  Here are a few things I found useful.  They appear to work
with both Allegro and CMUCL.

(in-package :swank-backend)

#+allegro
(progn

;;; Crummy Allegro provides no way to ask if an object is a weak-vector.

(defstruct (weak-pointer (:constructor %make-weak-pointer)) 
  pointer)

(defun make-weak-pointer (object)
  "Creates a new weak pointer which points to OBJECT. For
   portability reasons, OBJECT must not be NIL."
  (assert (not (null object)))
  (let ((wv (excl:weak-vector 1)))
    (setf (svref wv 0) object)
    (%make-weak-pointer :pointer wv)))

(defun weak-pointer-value (weak-pointer)
  "If WEAK-POINTER is valid, returns its value. Otherwise, returns NIL."
  (svref (weak-pointer-pointer weak-pointer) 0))

) ; end #+allegro progn

(definterface weak-value-gethash (ht key &optional default)  
  "Access hash-table with weak value."
  (multiple-value-bind (val foundp) (gethash ht key)
    (if foundp
	(values (if (weak-pointer-p val)
		    (weak-pointer-value val)
		    val)
		t)
	default)))

(definterface (setf weak-value-gethash) (object ht key)  
  "Access hash-table with weak value."
  (when object
    (setf (gethash ht key) (make-weak-pointer object)))
  object)

(in-package :swank)

(defun save-presented-object (object)
  "Save OBJECT and return the assigned id.
If OBJECT was saved previously return the old id."
  (or (gethash object *object-to-presentation-id*)
      (let ((id (incf *presentation-counter*)))
        (setf (swank-backend::weak-value-gethash id *presentation-id-to-object*) object)
        (setf (gethash object *object-to-presentation-id*) id)
        id)))

(defun lookup-presented-object (id)
  "Retrieve the object corresponding to ID.
The secondary value indicates the absence of an entry."
  (swank-backend::weak-value-gethash id *presentation-id-to-object*))


Helmut Eller replied:

>  The reason is probably that nobody bothered to write the code.
>  I added the necessary bits now.
>  
>  Helmut.
>