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

Modified Files: cell-types.lisp cells.lisp constructors.lisp link.lisp md-slot-value.lisp md-utilities.lisp trc-eko.lisp Log Message: I forget. Some interesting stuff, I think.

--- /project/cells/cvsroot/cells/cell-types.lisp 2006/10/17 21:28:39 1.20 +++ /project/cells/cvsroot/cells/cell-types.lisp 2006/10/28 18:20:48 1.21 @@ -38,9 +38,14 @@ (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 lazy + (optimize t) debug md-info)

+(defmethod trcp :around ((c cell)) + (or (c-debug c) + (call-next-method))) + (defun c-callers (c) "Make it easier to change implementation" (fifo-data (c-caller-store c))) @@ -96,7 +101,7 @@ rule)

(defun c-optimized-away-p (c) - (eql :optimized-away (c-state c))) + (eq :optimized-away (c-state c)))

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

--- /project/cells/cvsroot/cells/cells.lisp 2006/10/02 02:38:31 1.17 +++ /project/cells/cvsroot/cells/cells.lisp 2006/10/28 18:20:48 1.18 @@ -78,6 +78,8 @@ (defmacro without-c-dependency (&body body) `(let (*call-stack*) ,@body))

+(export! .cause) + (define-symbol-macro .cause (car *causation*))

--- /project/cells/cvsroot/cells/constructors.lisp 2006/10/17 21:28:39 1.10 +++ /project/cells/cvsroot/cells/constructors.lisp 2006/10/28 18:20:48 1.11 @@ -53,7 +53,15 @@ :value-state :unevaluated :rule (c-lambda (without-c-dependency ,@body))))

-(export! c?once) +(defmacro c?n-until (&body body) + `(make-c-dependent + :optimize :when-value-t + :code ',body + :inputp t + :value-state :unevaluated + :rule (c-lambda ,@body))) + +(export! c?once c?n-until) (defmacro c?once (&body body) `(make-c-dependent :code '(without-c-dependency ,@body) --- /project/cells/cvsroot/cells/link.lisp 2006/10/17 21:28:39 1.19 +++ /project/cells/cvsroot/cells/link.lisp 2006/10/28 18:20:48 1.20 @@ -24,8 +24,10 @@

(defun record-caller (used &aux (caller (car *call-stack*))) (when (c-optimized-away-p used) ;; 2005-05-21 removed slow type check that used is cell + (trc nil "caller not being recorded because used optimized away" caller (c-value used) :used used) (return-from record-caller nil)) - (trc used "record-caller entry: used=" used :caller caller) + (trc nil "record-caller entry: used=" used :caller caller) + (multiple-value-bind (used-pos useds-len) (loop with u-pos for known in (cd-useds caller) --- /project/cells/cvsroot/cells/md-slot-value.lisp 2006/10/17 21:28:39 1.29 +++ /project/cells/cvsroot/cells/md-slot-value.lisp 2006/10/28 18:20:48 1.30 @@ -65,7 +65,9 @@ ;; and then get reset here (ie, ((c-input-p c) (ephemeral-reset c))). ie, do not assume inputs are never obsolete ;; ((and (c-inputp c) - (c-validp c))) ;; a c?n (ruled-then-input) cell will not be valid at first + (c-validp c) ;; a c?n (ruled-then-input) cell will not be valid at first + (not (and (eq (cd-optimize c) :when-value-t) + (null (c-value c))))))

((or (not (c-validp c)) ;; @@ -236,7 +238,11 @@ (c-value-state c) :valid (c-state c) :awake)

- (c-optimize-away?! c) ;;; put optimize test here to avoid needless linking + + (case (cd-optimize c) + ((t) (c-optimize-away?! c)) ;;; put optimize test here to avoid needless linking + (:when-value-t (when (c-value c) + (c-unlink-from-used c))))

; --- data flow propagation ----------- (unless (eq propagation-code :no-propagate) @@ -251,24 +257,29 @@

(defun c-optimize-away?! (c) (when (and (typep c 'c-dependent) + (null (cd-useds c)) + (cd-optimize c) (not (c-optimized-away-p c)) ;; c-streams (FNYI) may come this way repeatedly even if optimized away - (c-validp c) + (c-validp c) ;; /// when would this not be the case? (not (c-synaptic c)) ;; no slot to cache invariant result, so they have to stay around) - ;; chop (every (lambda (lbl-syn) (null (cd-useds (cdr lbl-syn)))) (cd-synapses c)) - (not (c-inputp c)) - (null (cd-useds c))) - - (trc nil "optimizing away" c (c-state c)) + (not (c-inputp c)) ;; yes, dependent cells can be inputp + ) + (when (trcp c) (break "go optimizing ~a" c)) + (trc c "optimizing away" c (c-state c)) (count-it :c-optimized)

(setf (c-state c) :optimized-away) - + (let ((entry (rassoc c (cells (c-model c))))) ; move from cells to cells-flushed + (unless entry + (describe c)) (c-assert entry) + (trc c "c-optimize-away?! moving cell to flushed list" c) (setf (cells (c-model c)) (delete entry (cells (c-model c)))) (push entry (cells-flushed (c-model c)))) - + (dolist (caller (c-callers c)) + (break "got opti of called") (setf (cd-useds caller) (delete c (cd-useds caller))) (c-optimize-away?! caller) ;; rare but it happens when rule says (or .cache ...) ))) --- /project/cells/cvsroot/cells/md-utilities.lisp 2006/10/17 21:28:39 1.9 +++ /project/cells/cvsroot/cells/md-utilities.lisp 2006/10/28 18:20:48 1.10 @@ -33,13 +33,18 @@ ;___________________ birth / death__________________________________

(defmethod not-to-be :around (self) - (trc nil "not-to-be nailing" self) + (trc nil "not-to-be nailing") (c-assert (not (eq (md-state self) :eternal-rest)))

(call-next-method) - + (setf (fm-parent self) nil (md-state self) :eternal-rest) + + (md-map-cells self nil + (lambda (c) + (c-assert (eq :quiesced (c-state c))))) ;; fails if user obstructs not-to-be with primary method (use :before etc) + (trc nil "not-to-be cleared 2 fm-parent, eternal-rest" self))

(defmethod not-to-be ((self model-object)) @@ -47,7 +52,7 @@ (md-quiesce self))

(defun md-quiesce (self) - (trc nil "md-quiesce doing" self (type-of self)) + (trc nil "md-quiesce nailing cells" self (type-of self)) (md-map-cells self nil (lambda (c) (trc nil "quiescing" c) (c-assert (not (find c *call-stack*))) @@ -56,13 +61,13 @@ (defun c-quiesce (c) (typecase c (cell - (trc c "c-quiesce unlinking" c) + (trc nil "c-quiesce unlinking" c) (c-unlink-from-used c) - (when (typep c 'cell) - (dolist (caller (c-callers c)) - (setf (c-value-state caller) :uncurrent) - (c-unlink-caller c caller))) - (trc nil "cell quiesce nulled cell awake" c)))) + (dolist (caller (c-callers c)) + (setf (c-value-state caller) :uncurrent) + (c-unlink-caller c caller)) + (setf (c-state c) :quiesced) ;; 20061024 for debugging for now, might break some code tho + )))

(defmethod not-to-be (other) other) --- /project/cells/cvsroot/cells/trc-eko.lisp 2006/10/17 21:28:39 1.4 +++ /project/cells/cvsroot/cells/trc-eko.lisp 2006/10/28 18:20:48 1.5 @@ -85,9 +85,11 @@ (defmethod trcp :around (other) (unless (call-next-method other)(break)))

+(export! trcp) + (defmethod trcp (other) (eq other t)) - + (defmethod trcp (($ string)) t)