[cells-cvs] CVS cells
ktilton
ktilton at common-lisp.net
Sat Mar 18 00:15:40 UTC 2006
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))))))))
More information about the Cells-cvs
mailing list