[cells-cvs] CVS update: cells/cell-types.lisp cells/cells.lpr cells/defmodel.lisp cells/md-slot-value.lisp cells/optimization.lisp cells/propagate.lisp cells/synapse.lisp cells/test.lisp
Kenny Tilton
ktilton at common-lisp.net
Sat May 7 23:12:44 UTC 2005
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 , at 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)))
More information about the Cells-cvs
mailing list