[cells-cvs] CVS update: cell-cultures/cells/cells.lpr cell-cultures/cells/defmodel.lisp cell-cultures/cells/md-slot-value.lisp cell-cultures/cells/optimization.lisp cell-cultures/cells/synapse-types.lisp cell-cultures/cells/synapse.lisp
Kenny Tilton
ktilton at common-lisp.net
Fri May 6 21:18:26 UTC 2005
Update of /project/cells/cvsroot/cell-cultures/cells
In directory common-lisp.net:/tmp/cvs-serv15540/cells
Modified Files:
cells.lpr defmodel.lisp md-slot-value.lisp optimization.lisp
synapse-types.lisp synapse.lisp
Log Message:
Establish Cells II (aka Cells 2.0, aka Cells) as Cells module in Cells project CVS tree
Date: Fri May 6 23:18:16 2005
Author: ktilton
Index: cell-cultures/cells/cells.lpr
diff -u cell-cultures/cells/cells.lpr:1.3 cell-cultures/cells/cells.lpr:1.4
--- cell-cultures/cells/cells.lpr:1.3 Fri Apr 8 11:11:12 2005
+++ cell-cultures/cells/cells.lpr Fri May 6 23:18:15 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)
Index: cell-cultures/cells/defmodel.lisp
diff -u cell-cultures/cells/defmodel.lisp:1.3 cell-cultures/cells/defmodel.lisp:1.4
--- cell-cultures/cells/defmodel.lisp:1.3 Wed Sep 29 04:50:13 2004
+++ cell-cultures/cells/defmodel.lisp Fri May 6 23:18:15 2005
@@ -22,6 +22,7 @@
(in-package :cells)
+
(defmacro defmodel (class directsupers slotspecs &rest options)
;;(print `(defmodel sees directsupers ,directsupers using ,(or directsupers :model-object)))
`(progn
@@ -59,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)
@@ -121,5 +122,6 @@
)
))
))
- slotspecs))))
+ slotspecs)
+ (find-class ',class))))
Index: cell-cultures/cells/md-slot-value.lisp
diff -u cell-cultures/cells/md-slot-value.lisp:1.6 cell-cultures/cells/md-slot-value.lisp:1.7
--- cell-cultures/cells/md-slot-value.lisp:1.6 Fri Apr 8 11:11:12 2005
+++ cell-cultures/cells/md-slot-value.lisp Fri May 6 23:18:15 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)))
Index: cell-cultures/cells/optimization.lisp
diff -u cell-cultures/cells/optimization.lisp:1.2 cell-cultures/cells/optimization.lisp:1.3
--- cell-cultures/cells/optimization.lisp:1.2 Sun Dec 5 05:50:32 2004
+++ cell-cultures/cells/optimization.lisp Fri May 6 23:18:15 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: cell-cultures/cells/synapse-types.lisp
diff -u cell-cultures/cells/synapse-types.lisp:1.2 cell-cultures/cells/synapse-types.lisp:1.3
--- cell-cultures/cells/synapse-types.lisp:1.2 Wed Sep 29 04:50:13 2004
+++ cell-cultures/cells/synapse-types.lisp Fri May 6 23:18:15 2005
@@ -52,16 +52,17 @@
last-relay-basis
(delta-identity new-basis ',type))
',type)))
- (trc "tdelta, threshhold" ,tdelta ,threshold)
+ (trc nil "tdelta, threshhold" ,tdelta ,threshold)
(setf delta-cum ,tdelta)
- (eko ("delta fire-p")
+ (eko (nil "delta fire-p")
(or (null ,threshold)
(delta-exceeds ,tdelta ,threshold ',type)))))
:fire-value (lambda (syn new-basis)
(declare (ignorable syn))
- (trc "f-delta fire-value gets" delta-cum new-basis syn)
- (trc "fdelta > new lastrelay" syn last-relay-basis)
+ (trc nil "f-delta fire-value gets" delta-cum new-basis syn)
+ (trc nil "fdelta > new lastrelay" syn last-relay-basis)
+ (trc "f-delta fire-value" delta-cum)
(setf last-bound-p t)
(setf last-relay-basis new-basis)
delta-cum))
Index: cell-cultures/cells/synapse.lisp
diff -u cell-cultures/cells/synapse.lisp:1.3 cell-cultures/cells/synapse.lisp:1.4
--- cell-cultures/cells/synapse.lisp:1.3 Wed Sep 29 04:50:13 2004
+++ cell-cultures/cells/synapse.lisp Fri May 6 23:18:16 2005
@@ -31,11 +31,11 @@
`(let ((synapse (or (cdr (assoc ',lex-loc-key (cd-synapses
(car *c-calculators*))))
(cdar (push (cons ',lex-loc-key
- (let (, at closure-vars)
- (make-synaptic-ruled slot-c (,fire-p ,fire-value)
- , at body)))
- (cd-synapses
- (car *c-calculators*)))))))
+ (let (, at closure-vars)
+ (make-synaptic-ruled slot-c (,fire-p ,fire-value)
+ , at body)))
+ (cd-synapses
+ (car *c-calculators*)))))))
(c-value-ensure-current synapse))))
(defmacro make-synaptic-ruled (syn-user (fire-p fire-value) &body body)
@@ -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)))))))
;__________________________________________________________________________________
;
More information about the Cells-cvs
mailing list