;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
(defpackage #:dep
- (:use #:common-lisp #:queue)
+ (:use #:common-lisp #:queue #:weak)
(:export #:dep #:depp #:make-dep #:dep-goodp
#:delay-recomputing-deps
#:install-dep-syntax
(state :pending :type (member :stable :pending :recomputing))
(generation *generation* :type list)
(listeners nil :type list)
- (dependents nil :type list))
+ (dependents nil :type list)
+ (weak-pointer nil :type t))
(defun kick-dep (dep)
"Call when DEP's value (or good/bad state) has changed. Marks the
dependents of DEP as :pending, if they're currently :stable, and then
clears the dependent list. Also invokes DEP's listener functions."
(setf (dep-generation dep) *generation*)
- (dolist (d (dep-dependents dep))
- (when (eq (dep-state d) :stable)
- (enqueue d *pending-deps*)
- (setf (dep-state d) :pending)))
+ (dolist (dweak (dep-dependents dep))
+ (let ((d (weak-pointer-value dweak)))
+ (when (and d (eq (dep-state d) :stable))
+ (enqueue d *pending-deps*)
+ (setf (dep-state d) :pending))))
(setf (dep-dependents dep) nil)
(dolist (l (dep-listeners dep))
(funcall l)))
(unwind-protect
(catch 'dep-bad
(setf (dep-state dep) :recomputing)
- (when (update-dep dep (let ((*evaluating-dep* dep))
+ (when (update-dep dep (let ((*evaluating-dep*
+ (dep-weak-pointer dep)))
(funcall (dep-value-func dep))))
(kick-dep dep))
(setf winning t))
(kick-dep dep)
(when (dep-value-func dep)
(catch 'dep-bad
- (let ((*evaluating-dep* dep))
+ (let ((*evaluating-dep* (dep-weak-pointer dep)))
(funcall (dep-value-func dep)))))))
(if *pending-deps*
(kick dep)
;; Sort out the arguments.
(let ((value nil)
(valuep nil)
+ (predicate #'eql)
(function nil))
(do () ((endp args))
(let ((indicator (pop args)))
- (cond ((or (eq indicator :value)
- (eq indicator :leaf))
- (if args
- (setf value (pop args) valuep t)
- (setf value nil valuep t)))
- ((eq indicator :function)
- (setf function (arg)))
- ((functionp indicator)
- (setf function indicator))
- (t
- (setf value indicator valuep t)))))
+ (case indicator
+ ((:value :leaf)
+ (if args
+ (setf value (pop args) valuep t)
+ (setf value nil valuep t)))
+ (:function
+ (setf function (arg)))
+ (:predicate
+ (setf predicate (arg)))
+ (t
+ (cond ((functionp indicator)
+ (setf function indicator))
+ (t
+ (setf value indicator valuep t)))))))
;; Create the object appropriately.
(let ((dep (%make-dep :value-func function
:%value value
:state (if valuep :stable :pending)
+ :value-predicate predicate
:generation (if function nil *generation*)
:goodp valuep)))
+ (setf (dep-weak-pointer dep) (make-weak-pointer dep))
(cond ((not function) t)
(valuep (pulse-dep dep))
(*pending-deps*
#+ test
(progn
- (defparameter x (make-leaf-dep 1))
- (defparameter y (make-leaf-dep 2))
+ (defparameter x (make-dep 1))
+ (defparameter y (make-dep 2))
(defparameter z (make-dep (lambda () (+ (dep-value x) (dep-value y)))))
(defparameter w (make-dep (lambda () (* (dep-value x) (dep-value z)))))
(dep-add-listener x (lambda () (format t "x now ~A~%" x)))