dep.lisp (recompute-dep-value): Refactor the flag calculation.

[lisp] / dep.lisp

diff --git a/dep.lisp b/dep.lisp
index c437538672db3648a46dfb0b6b95bd0069cb6749..15f6e0b55a50bcbe158dace45cd8e6f8d19e2107 100644 (file)
--- a/dep.lisp
+++ b/dep.lisp
@@ -189,15 +189,16 @@ (defun recompute-dep-value (dep)
    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."
    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+)))
+  (let ((winning nil)
+       (new-flags (logior (logand (dep-%flags dep) +queued+)
+                          +value+ +deps+)))

     (flet ((update (value)
             (cond ((update-dep dep value)
     (flet ((update (value)
             (cond ((update-dep dep value)

-                   (setf (dep-flags dep) (logior +value+ +deps+ +changed+
-                                                 queued))
+                   (setf (dep-flags dep) (logior new-flags +changed+))

                    (propagate-to-dependents dep)
                    t)
                   (t
                    (propagate-to-dependents dep)
                    t)
                   (t

-                   (setf (dep-flags dep) (logior +value+ +deps+ queued))
+                   (setf (dep-flags dep) new-flags)

                    nil))))
       (unwind-protect
           (prog1 (update (new-dep-value dep)) (setf winning t))
                    nil))))
       (unwind-protect
           (prog1 (update (new-dep-value dep)) (setf winning t))


@@ -228,11 +229,13 @@ (defun force-dep-value (dep)
               (progn (setf (dep-flags dep) flags) nil))))))
 
 (defun %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."
+  "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))
   (when *evaluating-dep*
     (pushnew (dep-weak-pointer *evaluating-dep*) (dep-dependents dep))

-    (pushnew dep (dep-dependencies *evaluating-dep*)))
-  (force-dep-value dep))
+    (pushnew dep (dep-dependencies *evaluating-dep*))))

 
 (export 'dep-value)
 (declaim (inline dep-value))
 
 (export 'dep-value)
 (declaim (inline dep-value))