delivery-shaker-weak-pointer pointing accessor
&key setter remover dead-value pointed
Used to make a pointer from one object to another weak object during the shaking operation. The operations of
- 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 .
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.
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.
:setter are passed to
delivery-shaker-weak-pointer , the accesor is not used. The accessor can be one of:
A symbol. This defines a functions 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 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 (
name) , and
(aref 1 2) => (aref pointing 1 2).
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 argument. That is, if the setter is
(set-something name ), the call is
(set-something pointed pointing name
) . In addition, where the accessor accept a symbol, the setter also accept a function object.
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.
This gives the value of the pointed object. If it is not given, the accessor is used to get the pointed object.
(Default 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 (does not happen unless you access objects you should not), 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 situtaion.
Examples One :
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 anywhere else. This can be done by something like this :
;;;; This will eliminate all the entries where the
(defun clean-my-hash-table (table)
(maphash (lambda (x y) (declare (ignore y))
(unless (car x) (remhash x table)))
(defun shake-my-hash-table ()
;;; this will cause the car of any entry where the car is not
;;; pointed to from another object to change to nil
(maphash #'(lambda (x y) (declare (ignore y))
(delivery-shaker-weak-pointer x 'car))
;;; 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))
(define-action "delivery actions" "shake my hash table"
;; call this function at delivery time
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))
(when (eq(car x) 'my-dead-value) (remhash x table))
[ Assuming there are no entries where the
Note that the cleanup function is not going to be called unless the hash table actually survives the shaking operation.
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.
Make the pointers from the structures to the names weak, and have the cleanup function throw away any structure where the name becomes
(defun clean-*aaa* ()
(loop for a on *aaa*)
(delivery-shaker-weak-pointer a 'a-struct-name))
(symbol-value symbol ) )))))
(define-action "Delivery Actions" "Clean aaa" 'clean-*aaa*)
Make a pointer from the symbol to the structure, and make
*aaa* point weakly to the names, and set
nil . The remover and accessor do nothing, and the setter is defined to restore
*aaa* . This implemetation does not use the cleanup function.
(defun clean-*aaa* ()
(let ((setter #'(lambda (name symbol)
(set symbol (ncons
(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
(setq *aaa* nil)))
(define-action "Delivery actions" "Clean aaa" 'clean-*aaa*)