dep: Use weak pointers for maintaining dependents.

diff --git a/dep.lisp b/dep.lisp
index c2d1008..7220975 100644 (file)
--- a/dep.lisp
+++ b/dep.lisp
@@ -22,7 +22,7 @@
 ;;; 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
@@ -67,17 +67,19 @@
   (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)))
@@ -108,7 +110,8 @@
       (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))
@@ -149,7 +152,7 @@
           (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)
@@ -209,27 +212,33 @@
     ;; 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*
@@ -326,8 +335,8 @@
 
 #+ 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)))

diff --git a/mdw.asd b/mdw.asd
index 51f5981..8a91809 100644 (file)
--- a/mdw.asd
+++ b/mdw.asd
@@ -14,7 +14,7 @@
               (:file "factorial")
               (:file "queue")
               (:file "weak")
-              (:file "dep" :depends-on ("queue"))
+              (:file "dep" :depends-on ("queue" "weak"))
               (:file "mdw-mop" :depends-on ("mdw-base"))
               (:file "str" :depends-on ("mdw-base"))
               (:file "collect" :depends-on ("mdw-base"))