Update of /project/cells/cvsroot/cells In directory common-lisp.net:/tmp/cvs-serv29610

Modified Files: propagate.lisp synapse-types.lisp synapse.lisp Log Message: Fix make-synaptic-ruled to evaluate synapse ID Date: Wed May 25 07:04:46 2005 Author: ktilton

Index: cells/propagate.lisp diff -u cells/propagate.lisp:1.6 cells/propagate.lisp:1.7 --- cells/propagate.lisp:1.6 Sat May 21 03:40:53 2005 +++ cells/propagate.lisp Wed May 25 07:04:46 2005 @@ -65,7 +65,7 @@ (bwhen (dead (catch :mdead (trc nil "c-propagate-to-users> *data-pulse-id*, user, c:" *data-pulse-id* user c) (when (c-user-cares user) - (trc user "propagating to user is (used,user):" c user) + (trc nil "propagating to user is (used,user):" c user) (c-value-ensure-current user)) nil)) (when (eq dead (c-model c))

Index: cells/synapse-types.lisp diff -u cells/synapse-types.lisp:1.2 cells/synapse-types.lisp:1.3 --- cells/synapse-types.lisp:1.2 Thu May 19 22:17:47 2005 +++ cells/synapse-types.lisp Wed May 25 07:04:46 2005 @@ -40,7 +40,7 @@ :no-propagate))) (values (if (eq prop-code :propagate) (progn - (trc "sense prior fire value now" new-value) + (trc nil "sense prior fire value now" new-value) (setf prior-fire-value new-value)) new-value) prop-code)))))

Index: cells/synapse.lisp diff -u cells/synapse.lisp:1.4 cells/synapse.lisp:1.5 --- cells/synapse.lisp:1.4 Thu May 19 22:17:47 2005 +++ cells/synapse.lisp Wed May 25 07:04:46 2005 @@ -27,26 +27,29 @@

(defmacro with-synapse (synapse-id (&rest closure-vars) &body body) (declare (ignorable trcp)) - `(let* ((synapse-user (car *c-calculators*)) - (synapse (or (bIf (ku (find ,synapse-id (cd-useds synapse-user) :key 'c-slot-name)) - (progn - (trc "withsyn reusing known" ,synapse-id ku) - ku)) - (let ((new-syn - (let (,@closure-vars) - (trc "withsyn making new syn" ,synapse-id) - (make-synaptic-ruled ,synapse-id synapse-user ,@body)))) - (c-link-ex new-syn) - new-syn)))) - (prog1 - (with-integrity (:with-synapse) - (c-value-ensure-current synapse)) - (c-link-ex synapse)))) + (let ((syn-id (gensym))) + `(let* ((,syn-id (eko ("!!! syn-id =") ,synapse-id)) + (synapse-user (car *c-calculators*)) + (synapse (or (bIf (ku (find ,syn-id (cd-useds synapse-user) :key 'c-slot-name)) + (progn + (trc "withsyn reusing known" ,syn-id ku) + ku)) + (let ((new-syn + (let (,@closure-vars) + (trc "withsyn making new syn" ,syn-id + :known (mapcar 'c-slot-name (cd-useds synapse-user))) + (make-synaptic-ruled ,syn-id synapse-user ,@body)))) + (c-link-ex new-syn) + new-syn)))) + (prog1 + (with-integrity (:with-synapse) + (c-value-ensure-current synapse)) + (c-link-ex synapse)))))

(defmacro make-synaptic-ruled (syn-pseudo-slot syn-user &body body) `(make-c-dependent :model (c-model ,syn-user) - :slot-name ',syn-pseudo-slot + :slot-name ,syn-pseudo-slot :code ',body :synaptic t :rule (c-lambda ,@body)))