Update of /project/cells/cvsroot/cells In directory common-lisp.net:/tmp/cvs-serv14384
Modified Files: cell-types.lisp cells.lpr defmodel.lisp md-slot-value.lisp optimization.lisp propagate.lisp synapse.lisp test.lisp Log Message: Have slot-value reset to nil as well as c-value, on c-ephemeral-reset Date: Sun May 8 01:12:41 2005 Author: ktilton
Index: cells/cell-types.lisp diff -u cells/cell-types.lisp:1.1 cells/cell-types.lisp:1.2 --- cells/cell-types.lisp:1.1 Fri May 6 23:05:45 2005 +++ cells/cell-types.lisp Sun May 8 01:12:40 2005 @@ -136,8 +136,6 @@ (defmethod c-useds (other) (declare (ignore other))) (defmethod c-useds ((c c-dependent)) (cd-useds c))
- - (defun c-validp (c) (eql (c-value-state c) :valid))
Index: cells/cells.lpr diff -u cells/cells.lpr:1.1 cells/cells.lpr:1.2 --- cells/cells.lpr:1.1 Fri May 6 23:05:45 2005 +++ cells/cells.lpr Sun May 8 01:12:40 2005 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "7.0 [Windows] (Dec 28, 2004 17:34)"; cg: "1.54.2.17"; -*- +;; -*- lisp-version: "7.0 [Windows] (May 6, 2005 8:25)"; cg: "1.54.2.17"; -*-
(in-package :cg-user)
@@ -46,7 +46,7 @@ :old-space-size 256000 :new-space-size 6144 :runtime-build-option :standard - :on-initialization 'cells::cv-test + :on-initialization 'cells::test-cells :on-restart 'do-default-restart)
;; End of Project Definition
Index: cells/defmodel.lisp diff -u cells/defmodel.lisp:1.1 cells/defmodel.lisp:1.2 --- cells/defmodel.lisp:1.1 Fri May 6 23:05:45 2005 +++ cells/defmodel.lisp Sun May 8 01:12:40 2005 @@ -60,7 +60,7 @@ ; ------- defclass --------------- (^slot-value ,model ',',slotname) ;
- (prog1 + (progn (defclass ,class ,(or directsupers '(model-object));; now we can def the class ,(mapcar (lambda (s) (list* (car s) @@ -123,5 +123,5 @@ ) )) )) - slotspecs)))) - + slotspecs) + (find-class ',class))))
Index: cells/md-slot-value.lisp diff -u cells/md-slot-value.lisp:1.1 cells/md-slot-value.lisp:1.2 --- cells/md-slot-value.lisp:1.1 Fri May 6 23:05:45 2005 +++ cells/md-slot-value.lisp Sun May 8 01:12:40 2005 @@ -56,7 +56,7 @@ (defun c-influenced-by-pulse (c); &aux (ip *data-pulse-id*)) (unless (c-currentp c) (count-it :c-influenced-by-pulse) - (trc c "c-influenced-by-pulse> " c (c-useds c)) + (trc nil "c-influenced-by-pulse> " c (c-useds c)) (some (lambda (used) (c-value-ensure-current used) (when (and (c-changed used) (> (c-pulse used)(c-pulse c))) @@ -209,4 +209,4 @@ absorbed-value)))
- \ No newline at end of file +
Index: cells/optimization.lisp diff -u cells/optimization.lisp:1.1 cells/optimization.lisp:1.2 --- cells/optimization.lisp:1.1 Fri May 6 23:05:45 2005 +++ cells/optimization.lisp Sun May 8 01:12:40 2005 @@ -34,6 +34,7 @@ (not (c-optimized-away-p c)) ;; c-streams come this way repeatedly even if optimized away (c-validp c) (not (c-synaptic c)) ;; no slot to cache invariant result, so they have to stay around) + (every (lambda (syn) (null (cd-useds syn))) (cd-synapses c)) (null (cd-useds c)))
(progn
Index: cells/propagate.lisp diff -u cells/propagate.lisp:1.1 cells/propagate.lisp:1.2 --- cells/propagate.lisp:1.1 Fri May 6 23:05:45 2005 +++ cells/propagate.lisp Sun May 8 01:12:40 2005 @@ -99,6 +99,7 @@ (when c (when (c-ephemeral-p 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...?
;----------------- change detection ---------------------------------
Index: cells/synapse.lisp diff -u cells/synapse.lisp:1.1 cells/synapse.lisp:1.2 --- cells/synapse.lisp:1.1 Fri May 6 23:05:45 2005 +++ cells/synapse.lisp Sun May 8 01:12:40 2005 @@ -48,12 +48,14 @@ :synaptic t :rule (c-lambda-var (,c-var) (let ((,new-value (progn ,@body))) - (trc nil "generic synaptic rule sees body value" ,c-var ,new-value) + (trc "generic synaptic rule sees body value" ,c-var ,new-value) (if ,(if fire-p `(funcall ,fire-p ,c-var ,new-value) t) (progn - (trc nil "Synapse fire YES!!" ,c-var) + (trc "Synapse fire YES!!" ,c-var) (funcall ,fire-value ,c-var ,new-value)) - .cache)))))) + (progn + (trc "Synapse fire NO!! use cache" .cache) + .cache)))))))
;__________________________________________________________________________________ ;
Index: cells/test.lisp diff -u cells/test.lisp:1.1 cells/test.lisp:1.2 --- cells/test.lisp:1.1 Fri May 6 23:05:45 2005 +++ cells/test.lisp Sun May 8 01:12:41 2005 @@ -71,6 +71,36 @@ (ct-assert (= 21 (aa m))) :okay-m-null))
+(defmodel m-ephem () + ((m-ephem-a :cell :ephemeral :initform nil :initarg :m-ephem-a :accessor m-ephem-a) + (m-test-a :cell nil :initform nil :initarg :m-test-a :accessor m-test-a) + (m-ephem-b :cell :ephemeral :initform nil :initarg :m-ephem-b :accessor m-ephem-b) + (m-test-b :cell nil :initform nil :initarg :m-test-b :accessor m-test-b))) + +(def-c-output m-ephem-a () + (setf (m-test-a self) new-value)) + +(def-c-output m-ephem-b () + (setf (m-test-b self) new-value)) + +(def-cell-test m-ephem + (let ((m (make-be 'm-ephem :m-ephem-a (c-in nil) :m-ephem-b (c? (* 2 (or (^m-ephem-a) 0)))))) + (ct-assert (null (slot-value m 'm-ephem-a))) + (ct-assert (null (m-ephem-a m))) + (ct-assert (null (m-test-a m))) + (ct-assert (null (slot-value m 'm-ephem-b))) + (ct-assert (null (m-ephem-b m))) + (ct-assert (zerop (m-test-b m))) + (setf (m-ephem-a m) 3) + (ct-assert (null (slot-value m 'm-ephem-a))) + (ct-assert (null (m-ephem-a m))) + (ct-assert (eql 3 (m-test-a m))) + ; + (ct-assert (null (slot-value m 'm-ephem-b))) + (ct-assert (null (m-ephem-b m))) + (ct-assert (eql 6 (m-test-b m))) + )) + (defmodel m-var () ((m-var-a :initform nil :initarg :m-var-a :accessor m-var-a) (m-var-b :initform nil :initarg :m-var-b :accessor m-var-b)))