;;; 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
- #:install-dep-syntax
- #:dep-value #:dep-make-bad #:dep-bad #:dep-try
- #:dep-add-listener))
+ (:use #:common-lisp #:queue #:weak))
(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.
+
+(export '(dep depp dep-name))
(defstruct (dep (:predicate depp)
(:constructor %make-dep))
"There are two kinds of `dep', though we use the same object type for both.
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-predicate #'eql :type function)
- (goodp nil :type boolean)
- (state :pending :type (member :stable :pending :recomputing))
+ (%value .bad. :type t)
+ (name nil :type t :read-only t)
+ (value-function nil :type (or function null) :read-only t)
+ (value-predicate #'eql :type function :read-only t)
+ (%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)
+ (new-flags (logior (logand (dep-%flags dep) +queued+)
+ +value+ +deps+)))
+ (flet ((update (value)
+ (cond ((update-dep dep value)
+ (setf (dep-flags dep) (logior new-flags +changed+))
+ (propagate-to-dependents dep)
+ t)
+ (t
+ (setf (dep-flags dep) new-flags)
+ 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.
+
+ This is the unhappy path of `dep-value'."
+ (force-dep-value dep)
+ (when *evaluating-dep*
+ (pushnew (dep-weak-pointer *evaluating-dep*) (dep-dependents dep))
+ (pushnew dep (dep-dependencies *evaluating-dep*))))
+
+(export 'dep-value)
+(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)))
+
+(export 'dep-goodp)
+(defun dep-goodp (dep)
+ "Answer whether DEP is good."
+ (when (eq *state* :recomputing)
+ (force-dep-value dep))
+ (not (eq (dep-%value dep) .bad.)))
+
+(export 'dep-try)
+(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)))
+
+(export 'dep-bad)
+(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*))))))))
+
+(export 'with-deps-frozen)
+(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)
+(export 'dep-make-bad)
(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.))
+(export 'dep-add-listener)
(defun dep-add-listener (dep func)
"Add a listener function FUNC to the DEP. The FUNC is called each time the
DEP's value (or good/bad state) changes. It is called with no arguments,
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)))
-
+(export 'make-dep)
(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))))
+
+(export 'install-dep-syntax)
(defun install-dep-syntax (&optional (readtable *readtable*))
"Installs into the given READTABLE some syntactic shortcuts:
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 --------------------------------------------------
~mdw / lisp / blobdiff