Commit 72b9f3be authored by Kenny Tilton's avatar Kenny Tilton
Browse files

Fixed a whole in initialization such that a slot could be observed twice,...

Fixed a whole in initialization such that a slot could be observed twice, unhealthy when observers have side effects.
parent 2781f115
......@@ -37,6 +37,7 @@ See the Lisp Lesser GNU Public License for more details.
; 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
......
......@@ -32,8 +32,11 @@ See the Lisp Lesser GNU Public License for more details.
;
; 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*)
......
......@@ -328,7 +328,7 @@ In brief, initialize ~0@*~a to (c-in ~2@*~s) instead of plain ~:*~s"
)
;; (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))))
)
......
......@@ -104,7 +104,8 @@ See the Lisp Lesser GNU Public License for more details.
(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 @@ See the Lisp Lesser GNU Public License for more details.
;; 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 @@ See the Lisp Lesser GNU Public License for more details.
(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)
......
......@@ -113,8 +113,14 @@ See the Lisp Lesser GNU Public License for more details.
(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))
;
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment