Update of /project/cells/cvsroot/cells In directory clnet:/tmp/cvs-serv7503

Modified Files: cell-types.lisp family.lisp initialize.lisp md-slot-value.lisp md-utilities.lisp model-object.lisp propagate.lisp synapse.lisp Log Message: Mostly make ephemerals more transparent by always rerunning rules of dependents. This is actually a bug fix, at some profound level of understanding beyond me.

--- /project/cells/cvsroot/cells/cell-types.lisp 2006/06/10 22:16:35 1.10 +++ /project/cells/cvsroot/cells/cell-types.lisp 2006/06/13 05:05:12 1.11 @@ -64,10 +64,14 @@ ; within finish-business we are sure all users have been recalculated ; and all outputs completed. ; + ; ;; good q: what does (setf <ephem> 'x) return? historically nil, but...? + ; (with-integrity (:ephemeral-reset c) (trc nil "!!!!!!!!!!!!!! c-ephemeral-reset resetting:" c) (md-slot-value-store (c-model c) (c-slot-name c) nil) - (setf (c-value c) nil)))) ;; good q: what does (setf <ephem> 'x) return? historically nil, but...? + (setf (c-value c) nil) + (loop for user in (c-users c) + do (calculate-and-link user)))))

; -----------------------------------------------------

--- /project/cells/cvsroot/cells/family.lisp 2006/05/20 06:32:19 1.7 +++ /project/cells/cvsroot/cells/family.lisp 2006/06/13 05:05:12 1.8 @@ -135,8 +135,8 @@ (multiple-value-bind (c-or-value suppressp) (funcall (ks-rule ks-def) self) (unless suppressp - (trc nil "c-install " slot-name c-or-value) - (c-install self slot-name c-or-value))))))))) + (trc nil "md-install-cell " slot-name c-or-value) + (md-install-cell self slot-name c-or-value)))))))))

(defobserver .kids ((self family) new-kids old-kids) (declare (ignorable usage)) --- /project/cells/cvsroot/cells/initialize.lisp 2006/05/20 06:32:19 1.5 +++ /project/cells/cvsroot/cells/initialize.lisp 2006/06/13 05:05:12 1.6 @@ -24,11 +24,10 @@ (defstruct (c-envaluer (:conc-name nil)) envalue-rule)

- -(defmethod c-awaken-cell (c) +(defmethod awaken-cell (c) (declare (ignorable c)))

-(defmethod c-awaken-cell ((c cell)) +(defmethod awaken-cell ((c cell)) (assert (c-inputp c)) ; ; nothing to calculate, but every cellular slot should be output @@ -36,17 +35,17 @@ (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)) +(defmethod awaken-cell ((c c-ruled)) (let (*c-calculators*) - (c-calculate-and-set c))) + (calculate-and-set c)))

#+cormanlisp ; satisfy CormanCL bug -(defmethod c-awaken-cell ((c c-dependent)) +(defmethod awaken-cell ((c c-dependent)) (let (*c-calculators*) - (trc nil "c-awaken-cell c-dependent clearing *c-calculators*" c) - (c-calculate-and-set c))) + (trc nil "awaken-cell c-dependent clearing *c-calculators*" c) + (calculate-and-set c)))

-(defmethod c-awaken-cell ((c c-drifter)) +(defmethod awaken-cell ((c c-drifter)) ; ; drifters *begin* valid, so the derived version's test for unbounditude ; would keep (drift) rule ever from being evaluated. correct solution @@ -55,7 +54,7 @@ ; awakening, because awakening's other role is to get an instance up to speed ; at once upon instantiation ; - (c-calculate-and-set c) + (calculate-and-set c) (cond ((c-validp c) (c-value c)) ((c-unboundp c) nil) (t "illegal state!!!"))) --- /project/cells/cvsroot/cells/md-slot-value.lisp 2006/06/10 22:16:35 1.18 +++ /project/cells/cvsroot/cells/md-slot-value.lisp 2006/06/13 05:05:12 1.19 @@ -42,14 +42,14 @@ (if c (prog1 (with-integrity () - (c-value-ensure-current c)) + (ensure-value-is-current c)) (when (car *c-calculators*) (c-link-ex c))) (values (bd-slot-value self slot-name) nil)))

-(defun c-value-ensure-current (c) - (count-it :c-value-ensure-current) - (trc nil "c-value-ensure-current >" c) +(defun ensure-value-is-current (c) + (count-it :ensure-value-is-current) + (trc nil "ensure-value-is-current >" c) (cond ((c-currentp c)(trc nil "c-currentp" c)) ;; used to follow c-inputp, but I am toying with letting ephemerals (inputs) fall obsolete ;; and then get reset here (ie, ((c-input-p c) (c-ephemeral-reset c))). ie, do not assume inputs are never obsolete @@ -58,14 +58,14 @@

((or (not (c-validp c)) (some (lambda (used) - (c-value-ensure-current used) + (ensure-value-is-current used) (trc nil "comparing pulses (user, used): " (c-pulse c)(c-pulse used)) (when (and (c-changed used) (> (c-pulse used)(c-pulse c))) (trc nil "used changed" c used) t)) (cd-useds c))) (trc nil "ensuring current calc-set of" (c-slot-name c) debug-id) - (c-calculate-and-set c)) + (calculate-and-set c))

(t (c-pulse-update c :valid-uninfluenced)))

@@ -74,37 +74,36 @@

(c-value c))

-(defun c-calculate-and-set (c) +(defun calculate-and-set (c) (flet ((body () (when (c-stopped) (princ #.) - (return-from c-calculate-and-set)) - + (return-from calculate-and-set)) + (when (find c *c-calculators*) ;; circularity - (trc "c-calculate-and-set breaking on circularity" c) (c-break ;; break is problem when testing cells on some CLs "cell ~a midst askers: ~a" c *c-calculators*)) - (trc nil "calcing, calcers" (c-slot-name c) (mapcar 'c-slot-name *c-calculators*)) - (count-it :c-calculate-and-set) - ;;; (count-it :c-calculate-and-set (type-of (c-model c))) ;; (c-slot-name c)) - - (cd-usage-clear-all c) - + (multiple-value-bind (raw-value propagation-code) - (let ((*c-calculators* (cons c *c-calculators*)) - (*defer-changes* t)) - (funcall (cr-rule c) c)) + (calculate-and-link c) + (when (and *c-debug* (typep raw-value 'cell)) (c-break "new value for cell ~s is itself a cell: ~s. probably nested (c? ... (c? ))" c raw-value)) - - (c-unlink-unused c) - (trc nil "calc-set calling md-sv-assum" c propagation-code) + (md-slot-value-assume c raw-value propagation-code)))) (if nil ;; *dbg* (ukt::wtrc (0 100 "calcnset" c) (body)) (body))))

+(defun calculate-and-link (c) + (let ((*c-calculators* (cons c *c-calculators*)) + (*defer-changes* t)) + (cd-usage-clear-all c) + (multiple-value-prog1 + (funcall (cr-rule c) c) + (c-unlink-unused c)))) + ;-------------------------------------------------------------

(defun md-slot-makunbound (self slot-name @@ -183,7 +182,7 @@ (when (and (not (eq propagation-code :propagate)) (eql prior-state :valid) (c-no-news c absorbed-value prior-value)) - (trc nil "(setf md-slot-value) > early no news" propagation-code prior-state prior-value absorbed-value) + (trc "(setf md-slot-value) > early no news" propagation-code prior-state prior-value absorbed-value) (count-it :nonews) (return-from md-slot-value-assume absorbed-value))

--- /project/cells/cvsroot/cells/md-utilities.lisp 2006/05/20 06:32:19 1.4 +++ /project/cells/cvsroot/cells/md-utilities.lisp 2006/06/13 05:05:13 1.5 @@ -67,6 +67,6 @@

(defmacro make-kid (class &rest initargs) `(make-instance ,class - :fm-parent self + :fm-parent (progn (assert self) self) ,@initargs))

--- /project/cells/cvsroot/cells/model-object.lisp 2006/05/20 06:32:19 1.5 +++ /project/cells/cvsroot/cells/model-object.lisp 2006/06/13 05:05:13 1.6 @@ -51,7 +51,7 @@ (slot-value self sn)) when (typep sv 'cell) do (if (md-slot-cell-type (type-of self) sn) - (c-install self sn sv) + (md-install-cell self sn sv) (when *c-debug* (trc "warning: cell ~a offered for non-cellular model/slot ~a/~a" sv self sn)))) ; @@ -60,12 +60,12 @@ (with-integrity (:awaken self) (md-awaken self)))

-(defun c-install (self sn c &aux (c-isa-cell (typep c 'cell))) +(defun md-install-cell (self sn c &aux (c-isa-cell (typep c 'cell))) ; ; iff cell, init and move into dictionary ; (when c-isa-cell - (count-it :c-install) + (count-it :md-install-cell) (setf (c-model c) self (c-slot-name c) sn @@ -121,7 +121,7 @@ ((not c) ;; all slots must hit any change handlers as instances come into existence to get ;; models fully connected to the outside world they are controlling. that - ;; happens in c-awaken-cell for slots in fact mediated by cells, but as an + ;; happens in awaken-cell for slots in fact mediated by cells, but as an ;; optimization we allow raw literal values to be specified for a slot, in ;; which case heroic measures are needed to get the slot to the change handler ;; @@ -142,7 +142,7 @@ (count-it :c-awaken)

(setf (c-state c) :awake) - (c-awaken-cell c)))))) + (awaken-cell c))))))

(setf (md-state self) :awake) self) --- /project/cells/cvsroot/cells/propagate.lisp 2006/06/09 17:21:35 1.15 +++ /project/cells/cvsroot/cells/propagate.lisp 2006/06/13 05:05:13 1.16 @@ -46,7 +46,7 @@

(defun c-pulse-update (c key) (declare (ignorable key)) - (trc nil "c-pulse-update updating" *data-pulse-id* c key) + (trc nil "c-pulse-update updating" *data-pulse-id* c key) (setf (c-changed c) nil (c-pulse c) *data-pulse-id*))

@@ -159,8 +159,8 @@ ; but B is busy eagerly propagating. "This time" is important because it means ; there is no way one can reliably be sure H will not ask for A ; - (trc nil "c-propagate-to-users > queueing" c) (when (c-users c) + (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*)) @@ -169,7 +169,7 @@ (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)))))))) + (ensure-value-is-current user))))))))

--- /project/cells/cvsroot/cells/synapse.lisp 2006/05/20 06:32:19 1.10 +++ /project/cells/cvsroot/cells/synapse.lisp 2006/06/13 05:05:13 1.11 @@ -40,7 +40,7 @@ (prog1 (multiple-value-bind (v p) (with-integrity () - (c-value-ensure-current synapse)) + (ensure-value-is-current synapse)) (trc nil "with-synapse: synapse, v, prop" synapse v p) (values v p)) (c-link-ex synapse)))))