delivery-shaker-weak-pointer Function

Summary

Used to make a pointer from one object to another weak object during the shaking operation.

Package

lispworks

Signature

delivery-shaker-weak-pointer pointing accessor &key setter remover dead-value pointed

Arguments

Description

The function delivery-shaker-weak-pointer is used to make a pointer from one object pointing to another weak object pointed during the shaking operation. The operations of delivery-shaker-weak-pointer are:

1. If setter is nil, it computes it based on accessor (see below), and creates a record with all the arguments for the shaker.
2. Before the shaker starts shaking, for each of the records created in (1), it finds the value of the pointed object, which is pointed if it is not nil, or the result of applying accessor to pointing.

   If pointed is nil and accessor returns nil, the shaker does not do anything else for this record. Otherwise, it stores weak pointers to both pointing and the pointed object, and uses remover to remove the pointer from pointing.

3. After the main shaking operation, for each pair of pointing/pointed object from (2) it checks if both have survived the shaking. If they did, it stores a pointer to the pointed object in pointing using setter.

If both pointed and setter are non-nil then accessor is not used. Otherwise accessor is called with pointing and returns the pointed object. accessor is used for two purposes:

• Getting the pointed object if pointed is nil.
• Computing the value for setter if it is nil.

If accessor is a symbol then it specifies a function that is called with the pointing object as its argument. If accessor is a list then the car of the list is called with pointing as its first argument, and the cdr of the list forming the rest of the arguments, that is:

(apply (car accessor) pointing (cdr accessor)) 

For example, if accessor is (slot-value name) the call is (slot-value pointing name), and if accessor is (aref 1 2) the call is (aref pointing 1 2).

If setter is nil, it is computed by the system using accessor and the same expansion that setf would use. If setter is non-nil, it has the same properties as accessor, except that in the call the pointed object is inserted before the rest of the arguments. That is, if setter is (set-something name), the call is (set-something pointed-object pointing name). In addition, where accessor accepts a symbol, setter also accepts a function object.

The default value of remover is t, which means use setter with new value being dead-value. remover is used to remove the pointer to the pointed object from pointing. It is called exactly like setter, except that the first argument is dead-value, rather than pointed.

pointed gives the value of the pointed object. If pointed is nil then accessor is used to get the pointed object.

The default value of dead-value is nil. This is the value that is stored by remover in the pointing value before starting the shaking. Note that if the pointed object is shaken, pointing is left with dead-value.

Note that between the calls to remover and setter (steps 2 and 3 above), pointing points to the wrong thing (dead-value). This may cause problems if pointing is used by the system during the shaking (this does not happen unless you access objects which you should not access), or if you use delivery-shaker-weak-pointer more than once on the same object, and one of these uses a slot that has been defined by the other. Thus you have to make sure that you do not cause this situation.

Examples

Suppose the keys of *my-hash-table* are conses of an object and a number, and it is desired to remove from *my-hash-table* those entries where the car is not pointed to from anywhere else. This can be done by something like this :

;; This will eliminate all entries where the car is nil
(defun clean-my-hash-table (table)
  (maphash (lambda (x y) 
             (declare (ignore y))
             (unless (car x) (remhash x table)))
           table))
 
;; This will cause the car of any entry where the car is
;; not pointed to from another object to change to nil
(defun shake-my-hash-table ()
  (maphash #'(lambda (x y) (declare (ignore y))
               (delivery-shaker-weak-pointer x 'car))
           *my-hash-table*))
 
;; This will cause clean-my-hash-table to be called
;; later in the shaking, provided that *my-hash-table*
;; is still alive.
(delivery-shaker-cleanup *my-hash-table*
                         'clean-my-hash-table)
 
;; Call this function at delivery time
(define-action "Delivery Actions" "shake my hash table"
             'shake-my-hash-table)

If the car can be nil, the code above removes some entries it should not. In this case the appropriate forms should be changed to:

(delivery-shaker-weak-pointer x 'car
                              :dead-value 'my-dead-value)

and inside the definition of clean-my-hash-table above replace thge unless form by:

(when (eq (car x) 'my-dead-value) (remhash x table))

This assumes there are no entries where the car is my-dead-value.

Note that the cleanup function is not going to be called unless the hash table actually survives the shaking operation.

Examples

The value of *aaa* is a list of objects of type a-struct, which has a slot called name, which points to a symbol. We want to get rid of any of these structures if the symbol is not pointed to by some other object.

Implementation A:

Make the pointers from the structures to the names be weak, and have the cleanup function throw away any structure where the name becomes nil.

(defun clean-*aaa* ()
  (loop for a on *aaa* do
        (delivery-shaker-weak-pointer
         a
         'a-struct-name)))
 
(delivery-shaker-cleanup 
 '*aaa* 
 #'(lambda (symbol) 
     (set symbol
          (remove-if-not 'a-struct-name 
                         (symbol-value symbol)))))
 
(define-action "Delivery Actions" "Clean *aaa*"
               'clean-*aaa*)

Implementation B:

Make a pointer from the symbol to the structure, and make *aaa* point weakly to the names, and set *aaa* to nil. The remover and accessor do nothing, and the setter is defined to restore *aaa*. This implementation does not use the cleanup function.

(defun clean-*aaa* ()
  (let ((setter
         #'(lambda (name symbol)
             (set symbol (nconc 
                          (symbol-value symbol) 
                          (list (get name 'a-struct))))
             (remprop name 'a-struct)))) 
    (dolist (x *aaa* ()) 
      (let ((name (a-struct-name x)))
        (setf (get name 'a-struct) x)
        (delivery-shaker-weak-pointer '*aaa* nil
                                      :remover nil 
                                      :pointed name
                                      :setter setter)))
    (setq *aaa* nil)))
 
(define-action "Delivery actions" "Clean aaa"
               'clean-*aaa*)

See also

delivery-shaker-cleanup