[cells-cvs] CVS update: cells/propagate.lisp cells/synapse-types.lisp cells/synapse.lisp

[Kenny Tilton]

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 (, at closure-vars)
-                              (trc "withsyn making new syn" ,synapse-id)
-                              (make-synaptic-ruled ,synapse-id synapse-user , at 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 (, at 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 , at 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 , at body)))