Update of /project/cells/cvsroot/cells In directory clnet:/tmp/cvs-serv852
Modified Files: cells-test.asd cells.lpr initialize.lisp integrity.lisp model-object.lisp propagate.lisp Log Message: New doc and test (deep-cells) for Cells 3. One mod to avoid unnecessary :etll-dependents enqueue
--- /project/cells/cvsroot/cells/cells-test.asd 2006/03/16 05:28:28 1.2 +++ /project/cells/cvsroot/cells/cells-test.asd 2006/03/18 00:15:40 1.3 @@ -20,7 +20,8 @@ (:file "output-setf") (:file "test-cycle") (:file "test-ephemeral") - (:file "test-synapse"))))) + (:file "test-synapse") + (:file "deep-cells")))))
(defmethod perform :after ((op load-op) (system (eql (find-system :cells-test)))) (funcall (find-symbol "TEST-CELLS" "CELLS"))) --- /project/cells/cvsroot/cells/cells.lpr 2006/03/16 05:28:28 1.7 +++ /project/cells/cvsroot/cells/cells.lpr 2006/03/18 00:15:40 1.8 @@ -49,7 +49,7 @@ :old-space-size 256000 :new-space-size 6144 :runtime-build-option :standard - :on-initialization 'cells::test-cells + :on-initialization 'cells::go-deep :on-restart 'do-default-restart)
;; End of Project Definition --- /project/cells/cvsroot/cells/initialize.lisp 2006/03/16 05:28:28 1.2 +++ /project/cells/cvsroot/cells/initialize.lisp 2006/03/18 00:15:40 1.3 @@ -34,14 +34,14 @@
(defmethod c-awaken-cell ((c cell)) (assert (c-inputp c)) - (when (and (c-ephemeral-p c) + #+goforit(when (and (c-ephemeral-p c) (c-value c)) (c-break "Feature not yet supported: initializing ephemeral to other than nil: [~a]" (c-value c))) ; ; nothing to calculate, but every cellular slot should be output ; - (slot-change (c-slot-name c) (c-model c) (c-value c) nil nil) + (slot-value-observe (c-slot-name c) (c-model c) (c-value c) nil nil) (c-ephemeral-reset c))
(defmethod c-awaken-cell ((c c-ruled)) --- /project/cells/cvsroot/cells/integrity.lisp 2006/03/16 05:28:28 1.5 +++ /project/cells/cvsroot/cells/integrity.lisp 2006/03/18 00:15:40 1.6 @@ -80,29 +80,69 @@ (tagbody tell-dependents (just-do-it :tell-dependents) - - (just-do-it :awaken) ;--- awaken new instances --- + ; + ; while the next step looks separate from the prior, they are closely bound. + ; during :tell-dependents, any number of new model instances can be spawned. + ; as they are spawned, shared-initialize queues them for awakening, which + ; you will recall forces the calculation of ruled cells and observer notification + ; for all cell slots. These latter may enqueue :change or :client tasks, in which + ; case note that they become appended to :change or :client tasks enqueued + ; during :tell-dependents. How come? Because the birth itself of model instances during + ; a datapulse is considered part of that datapulse, so we do want tasks enqueued + ; during their awakening to be handled along with those enqueued by cells of + ; existing model instances. + ; + (just-do-it :awaken) ;--- md-awaken new instances --- + ; + ; we do not go back to check for a need to :tell-dependents because (a) the original propagation + ; and processing of the :tell-dependents queue is a full propagation; no rule can ask for a cell that + ; then decides it needs to recompute and possibly propagate; and (b) the only rules forced awake during + ; awakening need that precisely because no one asked for their values, so their can be no dependents + ; to "tell". I think. :) So... + ; + (assert (null (fifo-peek (ufb-queue :tell-dependents))))
;--- process client queue ------------------------------ ; (when *stop* (return-from finish-business)) - (trc (fifo-peek (ufb-queue :client)) "!!! finbiz --- USER --- length" (fifo-length (ufb-queue :client))) - + (bwhen (clientq (ufb-queue :client)) (if *client-queue-handler* - (funcall *client-queue-handler* clientq) ;; might be empty/not exist + (funcall *client-queue-handler* clientq) ;; might be empty/not exist, so handlers must check (just-do-it clientq)))
;--- now we can reset ephemerals -------------------- + ; + ; one might be wondering when the observers got notified. That happens + ; Nice historical note: by accident, in the deep-cells test to exercise the new behavior + ; of cells3, I coded an ephemeral cell and initialized it to non-nil, hitting a runtime + ; error (now gone) saying I had no idea what a non-nil ephemeral would mean. That had been + ; my conclusion when the idea occurred to me the first time, so I stuck in an assertion + ; to warn off users. + ; + ; But the new + ; datachange progression defined by Cells3 had already forced me to manage ephemeral resets + ; more predictably (something in the test suite failed). By the time I got the runtime + ; error on deep-cells I was able to confidently take out the error and just let the thing + ; run. deep-cells looks to behave just right, but maybe a tougher test will present a problem? + ; (just-do-it :ephemeral-reset)
;--- do deferred state changes ----------------------- ; - (bwhen (task-info (fifo-pop (ufb-queue :change))) ;; it would be odd, but nils can legally inhabit queues, so be safe... + (bwhen (task-info (fifo-pop (ufb-queue :change))) (trc nil "!!!!!!!!!!!!!!!!!!! finbiz --- CHANGE ---- (first of)" (fifo-length (ufb-queue :change))) (destructuring-bind (defer-info . task-fn) task-info (trc nil "finbiz: deferred state change" defer-info) (data-pulse-next (list :finbiz defer-info)) (funcall task-fn) + ; + ; to finish this state change we could recursively call (finish-business), but + ; a goto let's us not use the stack. Someday I envision code that keeps on + ; setf-ing, polling the OS for events, in which case we cannot very well use + ; recursion. But as a debugger someone might want to change the next form + ; to (finish-business) if they are having trouble with a chain of setf's and + ; want to inspect the history on the stack. + ; (go tell-dependents)))))
--- /project/cells/cvsroot/cells/model-object.lisp 2006/03/16 05:28:28 1.3 +++ /project/cells/cvsroot/cells/model-object.lisp 2006/03/18 00:15:40 1.4 @@ -133,7 +133,7 @@ ;; but I think anything better creates a run-time hit. ;; (unless (md-slot-cell-flushed self slot-name) ;; slot will have been propagated just after cell was flushed - (slot-change slot-name self (bd-slot-value self slot-name) nil nil))) + (slot-value-observe slot-name self (bd-slot-value self slot-name) nil nil)))
((find (c-lazy c) '(:until-asked :always t)) (trc nil "md-awaken deferring c-awaken since lazy" --- /project/cells/cvsroot/cells/propagate.lisp 2006/03/16 05:28:28 1.9 +++ /project/cells/cvsroot/cells/propagate.lisp 2006/03/18 00:15:40 1.10 @@ -85,7 +85,7 @@
; --- manifest new value as needed --- ; - ; propagation to users jumps back in front of client slot-change handling in cells3 + ; propagation to users jumps back in front of client slot-value-observe handling in cells3 ; because model adopting (once done by the kids change handler) can now be done in ; shared-initialize (since one is now forced to supply the parent to make-instance). ; @@ -95,13 +95,13 @@ ; (c-propagate-to-users c)
- (slot-change (c-slot-name c) (c-model c) + (slot-value-observe (c-slot-name c) (c-model c) (c-value c) prior-value prior-value-supplied) ; ; with propagation done, ephemerals can be reset. we also do this in c-awaken, so ; let the fn decide if C really is ephemeral. Note that it might be possible to leave ; this out and use the datapulse to identify obsolete ephemerals and clear them - ; when read. That would avoid ever making again bug I had in which I had the reset inside slot-change, + ; when read. That would avoid ever making again bug I had in which I had the reset inside slot-value-observe, ; thinking that that always followed propagation to users. It would also make ; debugging easier in that I could find the last ephemeral value in the inspector. ; would this be bad for persistent CLOS, in which a DB would think there was still a link @@ -112,14 +112,6 @@
; --- slot change -----------------------------------------------------------
-(defun slot-change (slot-name self new-value prior-value prior-value-supplied) - (trc nil "slot-change > now!!" self slot-name new-value prior-value) - ;; (count-it :output slot-name) - ; - ; this next guy is a GF with progn method combo, which is why we cannot just use slot-change - ; - (slot-value-observe slot-name self new-value prior-value prior-value-supplied)) - (defmacro defobserver (slotname (&optional (self-arg 'self) (new-varg 'new-value) (oldvarg 'old-value) (oldvargboundp 'old-value-boundp)) @@ -172,15 +164,16 @@ ; there is no way one can reliably be sure H will not ask for A ; (trc nil "c-propagate-to-users > queueing" c) - (let ((causation (cons c *causation*))) ;; in case deferred - (with-integrity (:tell-dependents c) - (assert (null *c-calculators*)) - (let ((*causation* causation)) - (trc nil "c-propagate-to-users > notifying users of" c) - (dolist (user (c-users c)) - (unless (member (cr-lazy user) '(t :always :once-asked)) - (trc nil "propagating to user is (used,user):" c user) - (c-value-ensure-current user :user-propagation))))))) + (when (c-users c) + (let ((causation (cons c *causation*))) ;; in case deferred + (with-integrity (:tell-dependents c) + (assert (null *c-calculators*)) + (let ((*causation* causation)) + (trc nil "c-propagate-to-users > notifying users of" c) + (dolist (user (c-users c)) + (unless (member (cr-lazy user) '(t :always :once-asked)) + (trc nil "propagating to user is (used,user):" c user) + (c-value-ensure-current user :user-propagation))))))))
-
ktilton