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 (,@closure-vars) - (make-synaptic-ruled slot-c (,fire-p ,fire-value) - ,@body))) - (cd-synapses - (car *c-calculators*))))))) + (let (,@closure-vars) + (make-synaptic-ruled slot-c (,fire-p ,fire-value) + ,@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 ,@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)))))))
;__________________________________________________________________________________ ;