From 5f61c96135dd8b0e795f6e1e5d96708347fc8f5e Mon Sep 17 00:00:00 2001
From: Mark Wooding <mdw@distorted.org.uk>
Date: Tue, 10 Jun 2008 12:36:50 +0100
Subject: [PATCH] dep: Use weak pointers for maintaining dependents.

---
 dep.lisp | 51 ++++++++++++++++++++++++++++++---------------------
 mdw.asd  |  2 +-
 2 files changed, 31 insertions(+), 22 deletions(-)

diff --git a/dep.lisp b/dep.lisp
index c2d1008..7220975 100644
--- 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
--- 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"))
-- 
2.11.0