X-Git-Url: https://git.distorted.org.uk/~mdw/lisp/blobdiff_plain/2626af6648d844d428b3da1c12d1401e42405593..1a50efd8a9e976bf16a29ce381ea38c6b9a39ea1:/dep.lisp

diff --git a/dep.lisp b/dep.lisp
index 5903743..8a9410d 100644
--- a/dep.lisp
+++ b/dep.lisp
@@ -22,16 +22,69 @@
 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 (defpackage #:dep
-  (:use #:common-lisp #:queue)
-  (:export #:dep #:depp #:make-dep #:dep-goodp
-	   :delay-recomputing-deps
+  (:use #:common-lisp #:queue #:weak)
+  (:export #:dep #:depp #:make-dep #:dep-goodp #:dep-name
+	   #:with-deps-frozen
 	   #:install-dep-syntax
 	   #:dep-value #:dep-make-bad #:dep-bad #:dep-try
 	   #:dep-add-listener))
 (in-package #:dep)
 
 ;;;--------------------------------------------------------------------------
-;;; Dependencies.
+;;; Constants.
+
+(defconstant +value+ 1
+  "Flag: dep's value is up-to-date.")
+(defconstant +deps+ 2
+  "Flag: dep is known as a dependent on its dependencies.")
+(defconstant +changed+ 4
+  "Flag: dep has changed in the current recomputation phase.")
+(defconstant +recomputing+ 8
+  "Flag: dep is currently being recomputed.")
+(defconstant +queued+ 16
+  "Flag: dep is currently on the queue for recomputation.")
+
+(defconstant .bad. '.bad.
+  "Magical value used to indicate bad deps.")
+
+;;;--------------------------------------------------------------------------
+;;; Global and special variables.
+
+(defvar *generation* (list '*generation*)
+  "Generation marker, used to remember when we last updated a particular dep.
+   Essentially, if the dep's generation matches *GENERATION* then it doesn't
+   need updating again.")
+
+(defvar *evaluating-dep* nil
+  "The dep currently being evaluated.  This is bound only during the call of
+   a value-function, and is used to track the dependencies implied during the
+   function's evaluation.")
+
+(defvar *state* :ready
+  "The current state.  It may be any of:
+
+     * :READY -- the usual state: everything is up-to-date and correct.
+
+     * :FROZEN -- the state used to evaluate the body of WITH-DEPS-FROZEN.
+       Deps may be assigned values, but their dependents are not immediately
+       recomputed.
+
+     * :RECOMPUTING -- the state imposed while updating dependents.")
+
+(defvar *delayed-operations* nil
+  "A queue of operations delayed by WITH-DEPS-FROZEN.  Only available in the
+   :RECOMPUTING state.")
+
+(defvar *pending-deps* nil
+  "A queue of deps pending recomputation.  This is bound to a queue during
+   recomputation and restored afterwards, so it can also be used as a flag to
+   detect whether recomputation is happening.
+
+   Deps on the queue are always in the current generation, and have the
+   +QUEUED+ flag set.")
+
+;;;--------------------------------------------------------------------------
+;;; Data structures.
 
 (defstruct (dep (:predicate depp)
 		(:constructor %make-dep))
@@ -45,117 +98,257 @@
    either `good' (i.e., it has a value) or `bad'.  An attempt to read the
    value of a bad dep results in a throw of `bad-dep'.  Badness propagates
    automatically during recomputation phases."
-  (%value nil :type t)
-  (value-func nil :type (or function null))
+  (%value .bad. :type t)
+  (name nil :type t)
+  (value-function nil :type (or function null))
   (value-predicate #'eql :type function)
-  (goodp nil :type boolean)
-  (state :pending :type (member :stable :pending :recomputing))
+  (%flags 0 :type (unsigned-byte 8))
+  (generation *generation* :type list)
   (listeners nil :type list)
-  (dependents nil :type list))
-
-(defvar *evaluating-dep* nil
-  "The dep currently being evaluated.  This is bound only during the call of
-   a value-func, and is used to track the dependencies implied during the
-   function's evaluation.")
+  (dependents nil :type list)
+  (dependencies nil :type list)
+  (weak-pointer nil :type t))
 
-(defvar *pending-deps* nil
-  "A queue of deps pending recomputation.  This is bound to a queue during
-   recomputation and restored afterwards, so it can also be used as a flag to
-   detect whether recomputation is happening.")
-
-(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."
-  (dolist (d (dep-dependents dep))
-    (when (eq (dep-state d) :stable)
-      (enqueue d *pending-deps*)
-      (setf (dep-state d) :pending)))
+;;;--------------------------------------------------------------------------
+;;; Main code.
+
+(declaim (inline dep-flags))
+(defun dep-flags (dep)
+  "Return the current flags of DEP.
+
+   The flags are fetched from the object if we're in a recomputation phase
+   and the object's generation is current.  Otherwise the object's flags are
+   out of date, and we make up a better set."
+  (cond ((eq *state* :ready) (logior +value+ +deps+))
+	((eq (dep-generation dep) *generation*) (dep-%flags dep))
+	((not (dep-value-function dep)) (logior +value+ +deps+))
+	(t 0)))
+
+(declaim (inline (setf dep-flags)))
+(defun (setf dep-flags) (flags dep)
+  "Set the DEP's flags.
+
+   This doesn't do anything else like force DEP's generation."
+  (setf (dep-%flags dep) flags))
+
+(defun update-dep (dep value)
+  "Modify the value of DEP.
+
+   If DEP's value is now different (according to its badness or
+   value-predicate) then return true; otherwise return false."
+  (let ((old-value (dep-%value dep)))
+    (if (if (eq value .bad.)
+	    (eq old-value .bad.)
+	    (and (not (eq old-value .bad.))
+		 (funcall (dep-value-predicate dep) value old-value)))
+	nil
+	(progn (setf (dep-%value dep) value) t))))
+
+(defun new-dep-value (dep)
+  "Recompute and return the value of DEP, or .BAD. if the dep is bad.
+
+   This function is very minimal.  The caller expected to deal with many
+   aspects of caring for and feeding DEP.  In particular:
+
+     * Non-local exits (except throwing DEP-BAD) are not handled here.
+
+     * We assume that DEP is already in the current generation, and has its
+       +RECOMPUTING+ flag set.
+
+     * The caller is responsible for setting the current flags afterwards."
+  (catch 'dep-bad
+    (let ((*evaluating-dep* dep))
+      (setf (dep-dependencies dep) nil)
+      (funcall (dep-value-function dep)))))
+
+(defun propagate-to-dependents (dep)
+  "Notify the dependents of DEP of a change to its value.
+
+   We assume that DEP is up-to-date in the current generation, and has
+   correct flags (at least +VALUE+ and +CHANGED+, and maybe +DEPS+).
+   Dependents of DEP are enqueued for recomputation.  The DEP's dependents
+   are forced into the current generation and enqueued, and the dependents
+   list is cleared ready to be repopulated.  The DEP's listener functions are
+   invoked."
+  (dolist (dweak (dep-dependents dep))
+    (let ((d (weak-pointer-value dweak)))
+      (when d
+	(let ((flags (dep-flags d)))
+	  (unless (plusp (logand flags (logior +queued+ +deps+)))
+	    (enqueue d *pending-deps*)
+	    (setf (dep-generation d) *generation*
+		  (dep-flags d) (logior (logand flags +value+)
+					+queued+)))))))
   (setf (dep-dependents dep) nil)
-  (dolist (l (dep-listeners dep))
-    (funcall l)))
-
-(defun update-dep (dep value &optional (goodp t))
-  "Modify the value of DEP.  If GOODP is t, then mark it as good and store
-   VALUE is its new value; otherwise mark it bad.  If DEP's value is now
-   different (according to its value-predicate) then return true; otherwise
-   return false."
-  (setf (dep-state dep) :stable)
-  (cond ((not goodp)
-	 (if (dep-goodp dep)
-	     (progn (setf (dep-goodp dep) nil) t)
-	     nil))
-	((and (dep-goodp dep)
-	      (funcall (dep-value-predicate dep) value (dep-%value dep)))
-	 nil)
-	(t
-	 (setf (dep-goodp dep) t
-	       (dep-%value dep) value)
-	 t)))
-
-(defun recompute-dep (dep)
-  "Recompute the value of DEP.  This function is careful to trap nonlocal
-   transfers from the value-func."
-  (let ((winning nil))
+  (dolist (listener (dep-listeners dep))
+    (funcall listener)))
+
+(defun recompute-dep-value (dep)
+  "Recompute the value of DEP.
+
+   Returns true if DEP's value actually changed, or nil otherwise.  On exit,
+   the DEP's +VALUE+ and +DEPS+ flags are set, and +CHANGED+ is set if the
+   value actually changed.
+
+   We assume that DEP's dependencies are up-to-date already, and that DEP's
+   +RECOMPUTING+ flag is set.  In the former case, DEP's dependents and
+   listeners are notified, using PROPAGATE-TO-DEPENDENTS."
+  (let ((winning nil) (queued (logand (dep-%flags dep) +queued+)))
+    (flet ((update (value)
+	     (cond ((update-dep dep value)
+		    (setf (dep-flags dep) (logior +value+ +deps+ +changed+
+						  queued))
+		    (propagate-to-dependents dep)
+		    t)
+		   (t
+		    (setf (dep-flags dep) (logior +value+ +deps+ queued))
+		    nil))))
+      (unwind-protect
+	   (prog1 (update (new-dep-value dep)) (setf winning t))
+	(unless winning (update .bad.))))))
+
+(defun force-dep-value (dep)
+  "Arrange for DEP to have a current value.
+
+   Returns true if the DEP's value has changed in this recomputation phase,
+   or nil if not.
+
+   If DEP is already has a good value, then we just use that; the return
+   value is determined by the +CHANGED+ flag.  Otherwise, we set
+   +RECOMPUTING+ (in order to trap circularities) and force the values of
+   DEP's dependencies in turn.  If any of them returned true then we have to
+   explicitly recompute DEP (so we do); otherwise we can leave it as it is."
+  (let ((flags (dep-flags dep)))
+    (cond ((plusp (logand flags +recomputing+))
+	   (error "Ouch!  Circular dependency detected."))
+	  ((plusp (logand flags +value+))
+	   (plusp (logand flags +changed+)))
+	  (t
+	   (setf (dep-generation dep) *generation*
+		 (dep-flags dep) (logior (logand flags +queued+)
+					 +recomputing+))
+	   (if (some #'force-dep-value (dep-dependencies dep))
+	       (recompute-dep-value dep)
+	       (progn (setf (dep-flags dep) flags) nil))))))
+
+(defun %dep-value (dep)
+  "Do the difficult work of retrieving the current value of a DEP."
+  (when *evaluating-dep*
+    (pushnew (dep-weak-pointer *evaluating-dep*) (dep-dependents dep))
+    (pushnew dep (dep-dependencies *evaluating-dep*)))
+  (force-dep-value dep))
+
+(declaim (inline dep-value))
+(defun dep-value (dep)
+  "Retrieve the current value from DEP."
+  (when (eq *state* :recomputing)
+    (%dep-value dep))
+  (let ((value (dep-%value dep)))
+    (if (eq value .bad.)
+	(throw 'dep-bad .bad.)
+	value)))
+
+(defun dep-goodp (dep)
+  "Answer whether DEP is good."
+  (when (eq *state* :recomputing)
+    (force-dep-value dep))
+  (not (eq (dep-%value dep) .bad.)))
+
+(defmacro dep-try (expr &body body)
+  "Evaluate EXPR.  If it throws DEP-BAD then evaluate BODY instead."
+  (let ((block-name (gensym "TRY")))
+    `(block ,block-name
+       (catch 'dep-bad
+	 (return-from ,block-name ,expr))
+       ,@body)))
+
+(defun dep-bad ()
+  "Call from a value-function: indicates that the dep should marked as bad."
+  (throw 'dep-bad nil))
+
+(defun recompute-pending-deps ()
+  "Process the *PENDING-DEPS* queue, recomputing the deps listed on it.
+
+   We bind *STATE* to :RECOMPUTING during the process."
+  (let ((*state* :recomputing))
     (unwind-protect
-	 (catch 'dep-bad
-	   (setf (dep-state dep) :recomputing)
-	   (when (update-dep dep (let ((*evaluating-dep* dep))
-				   (funcall (dep-value-func dep))))
-	     (kick-dep dep))
-	   (setf winning t))
-      (unless winning
-	(when (update-dep dep nil nil)
-	  (kick-dep dep))))))
-
-(defun recompute-deps ()
-  "Recompute all the pending deps, and any others that depend on them."
-  (unwind-protect
-       (loop (when (queue-emptyp *pending-deps*)
-	       (return))
-	     (let ((dep (dequeue *pending-deps*)))
-	       (when (eq (dep-state dep) :pending)
-		 (recompute-dep dep))))
-    (loop (when (queue-emptyp *pending-deps*)
-	    (return))
-	  (let ((d (dequeue *pending-deps*)))
-	    (setf (dep-state d) :stable
-		  (dep-goodp d) nil)))))
-
-(defun ensure-dep-has-value (dep)
-  "Ensure that DEP has a stable value.  If DEP is currently computing,
-   signals an error."
-  (ecase (dep-state dep)
-    (:stable)
-    (:pending
-     (recompute-dep dep))
+	 (loop (when (queue-emptyp *pending-deps*)
+		 (return))
+	       (let* ((dep (dequeue *pending-deps*))
+		      (flags (dep-%flags dep)))
+		 (setf (dep-%flags dep) (logandc2 flags +queued+))
+		 (cond ((zerop (logand flags +value+))
+			(recompute-dep-value dep))
+		       ((zerop (logand flags +deps+))
+			(new-dep-value dep)
+			(setf (dep-%flags dep) (logior flags +deps+))))))
+      (loop (when (queue-emptyp *pending-deps*)
+	      (return))
+	    (let ((d (dequeue *pending-deps*)))
+	      (setf (dep-%value d) .bad.))))))
+
+(defun with-deps-frozen* (thunk &key delay)
+  "Invoke THUNK in the :FROZEN state.  See WITH-DEPS-FROZEN for full
+   information."
+  (ecase *state*
+    (:frozen
+     (funcall thunk))
     (:recomputing
-     (error "Ouch!  Cyclic dependency."))))
-
-(defun pulse-dep (dep)
-  "Notifies DEP of a change in its value.  If a recomputation phase is
-   currently under way, queue the dependents and leave fixing things up to
-   the outer loop; otherwise start up a recomputation phase."
-  (if *pending-deps*
-      (kick-dep dep)
-      (let ((*pending-deps* (make-queue)))
-	(kick-dep dep)
-	(recompute-deps))))
+     (unless delay
+       (error "This really isn't a good time."))
+     (enqueue thunk *delayed-operations*))
+    (:ready
+     (let ((*state* :frozen)
+	   (*delayed-operations* (make-queue))
+	   (*pending-deps* (make-queue)))
+       (setf *generation* (list '*generation*))
+       (multiple-value-prog1 (funcall thunk)
+	 (loop (recompute-pending-deps)
+	       (when (queue-emptyp *delayed-operations*)
+		 (return))
+	       (funcall (dequeue *delayed-operations*))))))))
+
+(defmacro with-deps-frozen ((&key delay) &body body)
+  "Evaluate BODY in the :FROZEN state.
+
+   In the :FROZEN state, recomutation is deferred.  If the current state is
+   :READY, then we enter :FROZEN, evaluate the BODY, and then enter
+   :RECOMPUTING to fix up the dependency graph.  If the current state is
+   :FROZEN, we do nothing particularly special.  Finally, if the current
+   state is :RECOMPUTING then the behaviour depends on the value of
+   the :DELAY argument: if false, an error is signalled; if true, the
+   evaluation is postponed until the end of the recomputation.
+
+   This macro has four immediate uses.
+
+     * Firstly, it's actually the only way to trigger recomputation at all.
+       It's invoked behind the scenes to do the right thing.
+
+     * If you're making a large number of updates without data dependencies
+       then you can make them go faster by wrapping them in WITH-DEPS-FROZEN
+       and only having a single recomputation phase.
+
+     * A simple (SETF (DEP-VALUE ...) ...) is unsafe during recomputation.
+       You can use WITH-DEPS-FROZEN to indicate that it's safe to defer the
+       assignment until later.  Deferred operations take place in the order
+       in which they were requested.
+
+     * Finally, you can use it to force a number of deps to hold given values
+       simultaneously, despite their value-functions disagreeing."
+  `(with-deps-frozen* (lambda () ,@body) :delay ,delay))
 
 (defun (setf dep-value) (value dep)
-  "Set DEP's value to be VALUE (and mark it as being good)."
-  (when (dep-value-func dep)
-    (error "Not a leaf dep."))
-  (when (update-dep dep value)
-    (pulse-dep dep))
+  "Assign the VALUE to the DEP, forcing recomputation if necessary."
+  (with-deps-frozen ()
+    (when (update-dep dep value)
+      (setf (dep-generation dep) *generation*
+	    (dep-flags dep) (logior +value+ +changed+))
+      (propagate-to-dependents dep)))
   value)
 
 (defun dep-make-bad (dep)
   "Mark DEP as being bad."
-  (when (dep-value-func dep)
-    (error "Not a leaf dep."))
-  (when (update-dep dep nil nil)
-    (pulse-dep dep)))
+  (setf (dep-value dep) .bad.))
 
 (defun dep-add-listener (dep func)
   "Add a listener function FUNC to the DEP.  The FUNC is called each time the
@@ -163,103 +356,78 @@
    and its return value is ignored."
   (push func (dep-listeners dep)))
 
-(defun dep-value (dep)
-  "Retrieve the current value from DEP."
-  (when *evaluating-dep*
-    (pushnew *evaluating-dep* (dep-dependents dep)))
-  (ensure-dep-has-value dep)
-  (if (dep-goodp dep) (dep-%value dep) (throw 'dep-bad nil)))
-
 (defun make-dep (&rest args)
   "Create a new DEP object.  There are two basic argument forms:
 
-   (:leaf &optional OBJECT)
+   (:value &optional OBJECT)
 	Return a leaf dep, whose value is OBJECT; if no OBJECT is given, the
-	dep is initially bad.
+	dep is initially bad.  The keyword :LEAF is accepted as a synonym.
 
    (:function FUNCTION)
 	Return a non-leaf dep whose value is computed by FUNCTION.
 
-   Additionally, if the first argument is something other than :leaf or
-   :function (ideally not a keyword, for forward compatibility), then the
+   Additionally, if the first argument is something other than :VALUE or
+   :FUNCTION (ideally not a keyword, for forward compatibility), then the
    first argument is inspected: if it's a function, then a function dep is
    retuerned (as if you'd specified :function); otherwise a leaf dep is
    returned.
 
+   Finally, it's possible to specify both :VALUE and :FUNCTION
+   simultaneously; this will set the initial values as requested, but
+   recompute them as necessary.  It is possible to establish dependency
+   cycles, but you need to suppress recomputation in order to do this
+   correctly -- see the DELAY-RECOMPUTING-DEPS macro.
+
    If no arguments are given, a bad leaf dep is returned."
 
-  (flet ((arg (&optional (default nil defaultp))
-	   (cond (args (pop args))
-		 (defaultp default)
-		 (t (error "Not enough arguments to MAKE-DEP.")))))
+  (flet ((arg () (if args (pop args)
+		     (error "Not enough arguments to MAKE-DEP."))))
 
     ;; Sort out the arguments.
-    (multiple-value-bind (type value goodp)
-      (if (null args)
-	  (values :leaf nil nil)
-	  (let ((indicator (pop args)))
-	    (cond ((eq indicator :leaf)
-		   (if args
-		       (values :leaf (pop args) t)
-		       (values :leaf nil nil)))
-		  ((eq indicator :function)
-		   (values :function (arg) nil))
-		  ((functionp indicator)
-		   (values :function indicator nil))
-		  (t
-		   (values :leaf indicator t)))))
-      (unless (endp args)
-	(error "Excess arguments to MAKE-DEP."))
+    (let ((value .bad.)
+	  (valuep nil)
+	  (name nil)
+	  (predicate #'eql)
+	  (listeners nil)
+	  (function nil))
+      (do () ((endp args))
+	(let ((indicator (pop args)))
+	  (case indicator
+	    ((:value :leaf)
+	     (setf value (if args (pop args) .bad.)
+		   valuep t))
+	    (:function
+	     (setf function (arg)))
+	    (:predicate
+	     (setf predicate (arg)))
+	    (:name
+	     (setf name (arg)))
+	    (:listener
+	     (push (arg) listeners))
+	    (t
+	     (cond ((functionp indicator)
+		    (setf function indicator))
+		   (t
+		    (setf value indicator
+			  valuep t)))))))
+      (unless (or valuep function)
+	(setf valuep t))
 
       ;; Create the object appropriately.
-      (case type
-	(:function
-	 (let ((dep (%make-dep :value-func value :state :pending)))
-	   (if *pending-deps*
-	       (enqueue dep *pending-deps*)
-	       (let ((*pending-deps* (make-queue)))
-		 (enqueue dep *pending-deps*)
-		 (recompute-deps)))
-	   dep))
-	(:leaf
-	 (%make-dep :%value value :goodp goodp :state :stable))))))
-
-(defmacro dep-try (expr &body body)
-  "Evaluate EXPR.  If it throws dep-bad then evaluate BODY instead."
-  (let ((block-name (gensym "TRY")))
-    `(block ,block-name
-       (catch 'dep-bad
-	 (return-from ,block-name ,expr))
-       ,@body)))
-
-(defun dep-bad ()
-  "Call from a value-func: indicates that the dep should marked as bad."
-  (throw 'dep-bad nil))
-
-(defun delay-recomputing-deps* (thunk)
-  "The guts of the DELAY-RECOMPUTATING-DEPS macro.  Evaluate THUNK without
-   immediately updating dependencies until THUNK finishes.  Returns the
-   value(s) of THUNK."
-  (if *pending-deps*
-      (funcall thunk)
-      (let ((*pending-deps* (make-queue)))
-	(multiple-value-prog1
-	    (funcall thunk)
-	  (recompute-deps)))))
-
-(defmacro delay-recomputing-deps (&body body)
-  "Evaluate BODY, but delay recomputing any deps until the BODY completes
-   execution.
-
-   Note that deps can report incorrect values while delayed recomputation is
-   in effect.  In the current implementation, the direct dependents of a leaf
-   dep whose value has changed will be correctly marked as pending (and
-   recomputed as necessary); higher-level dependents won't be noticed until
-   the direct dependents are recomputed.
-
-   This form is intended to be used for bulk update to leaves, for which
-   purpose it is fairly safe."
-  `(delay-recomputating-deps* #'(lambda () ,@body)))
+      (let ((dep (%make-dep :value-function function
+			    :%value value
+			    :name name
+			    :listeners listeners
+			    :%flags (logior (if valuep +value+ 0)
+					    (if function +queued+ +deps+)
+					    +changed+)
+			    :value-predicate predicate
+			    :generation *generation*)))
+	(setf (dep-weak-pointer dep) (make-weak-pointer dep))
+	(when function
+	  (with-deps-frozen ()
+	    (enqueue dep *pending-deps*)))
+	dep))))
 
 (defun install-dep-syntax (&optional (readtable *readtable*))
   "Installs into the given READTABLE some syntactic shortcuts:
@@ -290,23 +458,71 @@
 				readtable)
   readtable)
 
+#- abcl
 (defmethod print-object ((dep dep) stream)
   (print-unreadable-object (dep stream :type t :identity t)
-    (cond ((not (eq (dep-state dep) :stable))
-	   (format stream "~S" (dep-state dep)))
-	  ((dep-goodp dep)
-	   (format stream "~S ~W" :good (dep-%value dep)))
-	  (t
-	   (format stream "~S" :bad)))))
+    (pprint-logical-block (stream nil)
+      (let ((flags (dep-flags dep))
+	    (value (dep-%value dep)))
+	(cond ((zerop (logand flags +value+))
+	       (write-string "#<out-of-date>" stream))
+	      ((eq value .bad.)
+	       (write-string "#<bad>" stream))
+	      (t
+	       (write value :stream stream)))
+	(when (dep-name dep)
+	  (format stream " ~_~S ~@_~W" :name (dep-name dep)))
+	(when (zerop (logand flags +deps+))
+	  (format stream " ~_~S" :recompute-deps))
+	(when (plusp (logand flags +queued+))
+	  (format stream " ~_~S" :queued))
+	(when (plusp (logand flags +changed+))
+	  (format stream " ~_~S" :changed))))))
+
+;;;--------------------------------------------------------------------------
+;;; Tests.
 
 #+ test
 (progn
-  (defparameter x (make-leaf-dep 1))
-  (defparameter y (make-leaf-dep 2))
-  (defparameter z (make-dep (lambda () (+ (dep-value x) (dep-value y)))))
-  (defparameter w (make-dep (lambda () (* (dep-value x) (dep-value z)))))
+  (defparameter x (make-dep :name 'x 1))
+  (defparameter y (make-dep :name 'y 2))
+  (defparameter z (make-dep :name 'z
+			    (lambda () (+ (dep-value x) (dep-value y)))))
+  (defparameter w (make-dep :name 'w
+			    (lambda () (* (dep-value x) (dep-value z)))))
   (dep-add-listener x (lambda () (format t "x now ~A~%" x)))
   (dep-add-listener z (lambda () (format t "z now ~A~%" z)))
   (dep-add-listener w (lambda () (format t "w now ~A~%" w))))
 
+#+ test
+(progn
+  (defparameter a (make-dep :name 'a 1))
+  (defparameter b (make-dep :name 'b 2))
+  (defparameter c (make-dep :name 'c
+			    (lambda () (1+ (dep-value a)))))
+  (defparameter d (make-dep :name 'd
+			    (lambda () (* (dep-value c) (dep-value b)))))
+  (defparameter e (make-dep :name 'e
+			    (lambda () (- (dep-value d) (dep-value a)))))
+  ;;  a   b   c = a + 1   d = c*b   e = d - a
+  ;;  1   2      2           4          3
+  ;;  4   2      5          10          6
+  (values (dep-value e)
+	  (progn
+	    (setf (dep-value a) 4)
+	    (dep-value e))))
+
+#+ test
+(progn
+  (defparameter x nil)
+  (defparameter y nil)
+  (with-deps-frozen ()
+    (setf x (make-dep :name 'x 1 (lambda () (+ (dep-value y) 1)))
+	  y (make-dep :name 'y 2 (lambda () (- (dep-value x) 2))))))
+
+#+ test
+(trace with-deps-frozen* update-dep new-dep-value force-dep-value
+       recompute-dep-value recompute-pending-deps propagate-to-dependents
+       dep-value)
+
 ;;;----- That's all, folks --------------------------------------------------