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

Modified Files: cell-types.lisp cells.lpr integrity.lisp link.lisp md-slot-value.lisp propagate.lisp synapse.lisp Log Message: Looks like copying files back and forth has fooled CVS into thinking everything changed. <sigh>

--- /project/cells/cvsroot/cells/cell-types.lisp 2006/06/29 09:54:06 1.15 +++ /project/cells/cvsroot/cells/cell-types.lisp 2006/07/24 05:03:07 1.16 @@ -45,9 +45,9 @@ (defun caller-drop (used caller) (fifo-delete (c-caller-store used) caller))

-(defmethod trcp ((c cell)) - nil #+(or) (and (typep (c-model c) 'index) - (eql 'state (c-slot-name c)))) +;;;(defmethod trcp ((c cell)) +;;; (and ;; (typep (c-model c) 'index) +;;; (find (c-slot-name c) '(celtk::state mathx::problem))))

; --- ephemerality -------------------------------------------------- ; @@ -131,20 +131,23 @@ ;_____________________ print __________________________________

(defmethod print-object :before ((c cell) stream) - (declare (ignorable c)) - (format stream "[~a~a:" (if (c-inputp c) "i" "?") - (cond - ((null (c-model c)) #\0) - ((eq :eternal-rest (md-state (c-model c))) #_) - ((not (c-currentp c)) ##) - (t #\space)))) + (unless *print-readably* + (format stream "[~a~a:" (if (c-inputp c) "i" "?") + (cond + ((null (c-model c)) #\0) + ((eq :eternal-rest (md-state (c-model c))) #_) + ((not (c-currentp c)) ##) + (t #\space)))))

(defmethod print-object ((c cell) stream) - (c-print-value c stream) - (format stream "=~d/~a/~a]" - (c-pulse c) - (symbol-name (or (c-slot-name c) :anoncell)) - (or (c-model c) :anonmd))) + (if *print-readably* + (call-next-method) + (progn + (c-print-value c stream) + (format stream "=~d/~a/~a]" + (c-pulse c) + (symbol-name (or (c-slot-name c) :anoncell)) + (or (c-model c) :anonmd)))))

;__________________

--- /project/cells/cvsroot/cells/cells.lpr 2006/06/29 09:54:06 1.17 +++ /project/cells/cvsroot/cells/cells.lpr 2006/07/24 05:03:08 1.18 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Jun 28, 2006 10:53)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Jul 19, 2006 19:38)"; cg: "1.81"; -*-

(in-package :cg-user)

--- /project/cells/cvsroot/cells/integrity.lisp 2006/07/06 22:10:01 1.11 +++ /project/cells/cvsroot/cells/integrity.lisp 2006/07/24 05:03:08 1.12 @@ -53,18 +53,21 @@ (funcall action) (finish-business)))))

-(defmacro without-integrity ((&optional dbg-info) &rest body) +(export! with-integrity-bubble) + +(defmacro with-integrity-bubble ((&optional dbg-info) &rest body) "Whimsical name for launching a self-contained, dynamic integrity chunk, as with string-to-mx in the math-paper project, where everything is fully isolated from the outside computation." - `(call-without-integrity ,dbg-info (lambda () ,@body))) + `(call-with-integrity-bubble ,dbg-info (lambda () ,@body)))

-(defun call-without-integrity (dbg-info action) +(defun call-with-integrity-bubble (dbg-info action) (declare (ignorable dbg-info)) (let ((*within-integrity* nil) *unfinished-business* *defer-changes* - *call-stack*) + *call-stack* + (*data-pulse-id* 0)) (funcall action)))

(defun ufb-queue (opcode) --- /project/cells/cvsroot/cells/link.lisp 2006/07/06 22:10:01 1.15 +++ /project/cells/cvsroot/cells/link.lisp 2006/07/24 05:03:08 1.16 @@ -95,7 +95,7 @@

(defmethod c-unlink-from-used ((caller c-dependent)) (dolist (used (cd-useds caller)) - #+dfdbg (trc caller "unlinking from used" caller used) + #+dfdbg (trc nil "unlinking from used" caller used) (c-unlink-caller used caller)) ;; shouldn't be necessary (setf (cd-useds caller) nil) ) --- /project/cells/cvsroot/cells/md-slot-value.lisp 2006/06/29 09:54:06 1.24 +++ /project/cells/cvsroot/cells/md-slot-value.lisp 2006/07/24 05:03:08 1.25 @@ -42,14 +42,15 @@ (if c (prog1 (with-integrity () - (ensure-value-is-current c)) + (ensure-value-is-current c :mdsv nil)) (when (car *call-stack*) (record-caller c))) (values (bd-slot-value self slot-name) nil)))

-(defun ensure-value-is-current (c) +(defun ensure-value-is-current (c debug-id caller) + (declare (ignorable debug-id caller)) (count-it :ensure-value-is-current) - (trc nil "ensure-value-is-current >" c) + (trc nil "ensure-value-is-current > entry" c :now-pulse *data-pulse-id* debug-id caller) (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) (ephemeral-reset c))). ie, do not assume inputs are never obsolete @@ -58,16 +59,17 @@

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

- (t (c-pulse-update c :valid-uninfluenced))) + (t (trc nil "ensuring current decided current, updating pulse" (c-slot-name c) ) + (c-pulse-update c :valid-uninfluenced)))

(when (c-unboundp c) (error 'unbound-cell :cell c :instance (c-model c) :name (c-slot-name c))) @@ -143,6 +145,7 @@ ; ; --- data flow propagation ----------- ; + (setf (c-changed c) t) (without-c-dependency (c-propagate c prior-value t))))))) @@ -207,6 +210,7 @@

; --- data flow propagation ----------- (unless (eq propagation-code :no-propagate) + (trc nil "md-slot-value-assume flagging as changed" c) (setf (c-changed c) t) (c-propagate c prior-value (eq prior-state :valid))) ;; until 06-02-13 was (not (eq prior-state :unbound))

--- /project/cells/cvsroot/cells/propagate.lisp 2006/06/23 01:04:56 1.18 +++ /project/cells/cvsroot/cells/propagate.lisp 2006/07/24 05:03:08 1.19 @@ -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 as unchanged!!!" *data-pulse-id* c key) (setf (c-changed c) nil (c-pulse c) *data-pulse-id*))

@@ -165,11 +165,11 @@ (with-integrity (:tell-dependents c) (assert (null *call-stack*)) (let ((*causation* causation)) - (trc nil "c-propagate-to-callers > notifying callers of" c (mapcar 'c-slot-name (c-callers c))) + (trc nil "c-propagate-to-callers > actually notifying callers of" c (mapcar 'c-slot-name (c-callers c))) (dolist (caller (c-callers c)) (unless (member (cr-lazy caller) '(t :always :once-asked)) - (trc nil "propagating to caller is (used,caller):" c caller) - (ensure-value-is-current caller)))))))) + (trc nil "propagating to caller is caller:" caller) + (ensure-value-is-current caller :prop-from c))))))))

--- /project/cells/cvsroot/cells/synapse.lisp 2006/07/06 22:10:01 1.13 +++ /project/cells/cvsroot/cells/synapse.lisp 2006/07/24 05:03:08 1.14 @@ -39,7 +39,7 @@ (prog1 (multiple-value-bind (v p) (with-integrity () - (ensure-value-is-current synapse)) + (ensure-value-is-current synapse :synapse (car *call-stack*))) (trc nil "with-synapse: synapse, v, prop" synapse v p) (values v p)) (record-caller synapse)))))