Update of /project/cells/cvsroot/cells In directory clnet:/tmp/cvs-serv20671
Modified Files: cell-types.lisp initialize.lisp md-slot-value.lisp model-object.lisp propagate.lisp Log Message: Fixed a whole in initialization such that a slot could be observed twice, unhealthy when observers have side effects.
--- /project/cells/cvsroot/cells/cell-types.lisp 2008/01/29 04:29:52 1.28 +++ /project/cells/cvsroot/cells/cell-types.lisp 2008/01/31 03:30:17 1.29 @@ -37,6 +37,7 @@ ; a dependency on the existence of instance owning X (pulse 0 :type fixnum) (pulse-last-changed 0 :type fixnum) ;; lazys can miss changes by missing change of X followed by unchange of X in subsequent DP + (pulse-observed 0 :type fixnum) lazy (optimize t) debug --- /project/cells/cvsroot/cells/initialize.lisp 2006/06/23 01:04:56 1.8 +++ /project/cells/cvsroot/cells/initialize.lisp 2008/01/31 03:30:17 1.9 @@ -32,8 +32,11 @@ ; ; nothing to calculate, but every cellular slot should be output ; - (slot-value-observe (c-slot-name c) (c-model c) (c-value c) nil nil) - (ephemeral-reset c)) + (trc nil "awaken cell observing" c) + (when (> *data-pulse-id* (c-pulse-observed c)) + (setf (c-pulse-observed c) *data-pulse-id*) + (slot-value-observe (c-slot-name c) (c-model c) (c-value c) nil nil) + (ephemeral-reset c)))
(defmethod awaken-cell ((c c-ruled)) (let (*call-stack*) --- /project/cells/cvsroot/cells/md-slot-value.lisp 2008/01/29 04:29:52 1.37 +++ /project/cells/cvsroot/cells/md-slot-value.lisp 2008/01/31 03:30:17 1.38 @@ -328,7 +328,7 @@ ) ;; (when (trcp c) (break "go optimizing ~a" c))
- #+shh (when (trcp c) + (when (trcp c) (trc "optimizing away" c (c-state c) (rassoc c (cells (c-model c)))(rassoc c (cells-flushed (c-model c)))) )
--- /project/cells/cvsroot/cells/model-object.lisp 2008/01/29 04:29:52 1.17 +++ /project/cells/cvsroot/cells/model-object.lisp 2008/01/31 03:30:17 1.18 @@ -104,7 +104,8 @@
(defmethod md-awaken :around ((self model-object)) (when (eql :nascent (md-state self)) - (call-next-method))) + (call-next-method)) + self)
#+test (md-slot-cell-type 'cgtk::label 'cgtk::container) @@ -150,7 +151,12 @@ ;; but first I worried about it being slow keeping the flushed list /and/ searching, then ;; I wondered why a flushed cell should not be observed, constant cells are. So Just Observe It
- (slot-value-observe slot-name self (bd-slot-value self slot-name) nil nil)) + (let ((flushed (md-slot-cell-flushed self slot-name))) + (when (or (null flushed) ;; constant, ie, never any cell provided for this slot + (> *data-pulse-id* (c-pulse-observed flushed))) ;; unfrickinlikely + (when flushed + (setf (c-pulse-observed flushed) *data-pulse-id*)) ;; probably unnecessary + (slot-value-observe slot-name self (bd-slot-value self slot-name) nil nil))))
((find (c-lazy c) '(:until-asked :always t)) @@ -179,6 +185,11 @@ (cdr (assoc slot-name (cells self))) (get slot-name 'cell)))
+(defmethod md-slot-cell-flushed (self slot-name) + (if self + (cdr (assoc slot-name (cells-flushed self))) + (get slot-name 'cell))) + #+test (get 'cgtk::label :cell-types)
--- /project/cells/cvsroot/cells/propagate.lisp 2007/11/30 16:51:18 1.28 +++ /project/cells/cvsroot/cells/propagate.lisp 2008/01/31 03:30:17 1.29 @@ -113,8 +113,14 @@ (unless nil #+not (member (c-lazy c) '(t :always :once-asked)) ;; 2006-09-26 still fuzzy on this (c-propagate-to-callers c))
- (slot-value-observe (c-slot-name c) (c-model c) - (c-value c) prior-value prior-value-supplied) + (trc nil "c-propagate observing" c) + + ; this next assertion is just to see if we can ever come this way twice. If so, just + ; make it a condition on whether to observe + (when t ; breaks algebra (> *data-pulse-id* (c-pulse-observed c)) + (setf (c-pulse-observed c) *data-pulse-id*) + (slot-value-observe (c-slot-name c) (c-model c) + (c-value c) prior-value prior-value-supplied))
;