delivery-shaker-weak-pointer

Function

Used to make a pointer from one object to another weak object during the shaking operation. The operations of
delivery-shaker-weak-pointer
are:

At the time it is called it computes the
setter
and
remover
if these are not given, and stores all its arguments for the shaker.

Before the shaker starts, the shaker finds the value of the
pointed
object (if this is not given) using the
accessor
, and stores weak pointers to the
pointing
object and the
pointed
object. It then uses the
remover
to remove the pointer from the
pointing
object.

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

Arguments:

pointing

The pointing object. Because of the way
delivery-shaker-weak-pointer
is defined, you are free to use your own notion of pointing, for example, it may be the key in a
hash-table
.

accessor

The accessor that is called with the pointing object. It returns the pointed object. The
accessor
is used for two purposes:

1. getting the pointed object if it is not given.

2. computing the setter if it is not given.

If both
:pointed
and
:setter
are passed to
delivery-shaker-weak-pointer
, the accessor is not used. The
accessor
can be one of:

A symbol. This specifies a function that is called with the pointing object as its argument.

A list starting with a symbol. In this case the
car
of the list is called with the
pointing
object as its first argument, and the
cdr
forming the rest of the arguments, that is:

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

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

(aref 1 2) => (aref
pointing
1 2).

setter

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

remover

Default value
t
,
which means use the
setter
. This is used to remove the
pointer
from the
pointing
object. It is called exactly like the
setter
, except that the first argument is
dead-value
, rather than
pointed.

pointed

This gives the value of the
pointed
object. If it is not given, the
accessor
is used to get the
pointed
object.

dead-value

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

Note that between the calls to the
remover
and the
setter
(steps 2 and 3 above), the
pointing
object points to the wrong thing (the
dead-value
). This may cause problems if the object is used by the system during the shaking (this does not happen unless you access objects which you should not access), or if you define more than one
delivery-shaker-weak-pointer
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.

Example 1
:

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 the 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 *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 lines should be changed to:

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

and

(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.

Example 2:

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*)

(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.