[cells-cvs] CVS cells

ktilton ktilton at common-lisp.net
Fri Jun 23 01:04:56 UTC 2006

Update of /project/cells/cvsroot/cells
In directory clnet:/tmp/cvs-serv31550

Modified Files:
	cell-types.lisp cells-manifesto.txt cells.lisp cells.lpr 
	defmodel.lisp initialize.lisp integrity.lisp link.lisp 
	md-slot-value.lisp md-utilities.lisp model-object.lisp 
	optimization.lisp propagate.lisp synapse.lisp test.lisp 
Log Message:
New abbreviated defmodel: defmd

Starting to change internals names as the mood hits me.

--- /project/cells/cvsroot/cells/cell-types.lisp	2006/06/20 14:16:44	1.13
+++ /project/cells/cvsroot/cells/cell-types.lisp	2006/06/23 01:04:55	1.14
@@ -26,7 +26,7 @@
   inputp ;; t for old c-variable class
-  (users-store (make-fifo-queue) :type cons) ;; (C3) probably better to notify users FIFO
+  (caller-store (make-fifo-queue) :type cons) ;; (C3) probably better to notify callers FIFO
   (state :nascent :type symbol) ;; :nascent, :awake, :optimized-away
   (value-state :unbound :type symbol) ;; {:unbound | :unevaluated | :valid}
@@ -34,16 +34,16 @@
-(defun c-users (c)
+(defun c-callers (c)
   "Make it easier to change implementation"
-  (fifo-data (c-users-store c)))
+  (fifo-data (c-caller-store c)))
-(defun user-ensure (used new-user)
-  (unless (find new-user (c-users used))
-    (fifo-add (c-users-store used) new-user)))
+(defun caller-ensure (used new-caller)
+  (unless (find new-caller (c-callers used))
+    (fifo-add (c-caller-store used) new-caller)))
-(defun user-drop (used user)
-  (fifo-delete (c-users-store used) user))
+(defun caller-drop (used caller)
+  (fifo-delete (c-caller-store used) caller))
 (defmethod trcp ((c cell))
   nil #+(or) (and (typep (c-model c) 'index)
@@ -61,7 +61,7 @@
     ; as of Cells3 we defer resetting ephemerals because everything
     ; else gets deferred and we cannot /really/ reset it until
-    ; within finish-business we are sure all users have been recalculated
+    ; within finish-business we are sure all callers have been recalculated
     ; and all outputs completed.
     ; ;; good q: what does (setf <ephem> 'x) return? historically nil, but...?
@@ -71,8 +71,8 @@
       (md-slot-value-store (c-model c) (c-slot-name c) nil)
       (setf (c-value c) nil)
-      (loop for user in (c-users c)
-            do (calculate-and-link user)))))
+      (loop for caller in (c-callers c)
+            do (calculate-and-link caller)))))
 ; -----------------------------------------------------
--- /project/cells/cvsroot/cells/cells-manifesto.txt	2006/06/20 14:16:44	1.6
+++ /project/cells/cvsroot/cells/cells-manifesto.txt	2006/06/23 01:04:56	1.7
@@ -61,7 +61,8 @@
 way around it, and thus his prediction that a software silver bullet was
 in principle impossible.
-Which brings us to Cells.
+Which brings us to Cells. See also [axiom] Phillip Eby's developiong axiomatic 
+definition he is developing in support of Ryan Forseth's SoC project.
 DEFMODEL and Slot types
@@ -392,3 +393,118 @@
 was done on having slots of DEFSTRUCTs mediated by Cells, and ports to C++, Java, and
 Python have been explored.
+[axiom] Phillip Eby's axiomatic specification of Cells:
+Data Pulse Axioms
+Overview: updates must be synchronous (all changed cells are updated at
+once), consistent (no cell rule sees out of date values), and minimal (only
+necessary rules run).
+1. Global Update Counter:
+   There is a global update counter. (Guarantees that there is a
+globally-consistent notion of the "time" at which updates occur.)
+2. Per-Cell "As Of" Value:
+   Every cell has a "current-as-of" update count, that is initialized with
+a value that is less than the global update count will ever be.
+3. Out-of-dateness:
+   A cell is out of date if its update count is lower than the update
+count of any of the cells it depends on.
+4. Out-of-date Before:
+   When a rule-driven cell's value is queried, its rule is only run if the
+cell is out of date; otherwise a cached previous value is
+returned.  (Guarantees that a rule is not run unless its dependencies have
+changed since the last time the rule was run.)
+5. Up-to-date After:
+   Once a cell's rule is run (or its value is changed, if it is an input
+cell), its update count must be equal to the global update
+count.  (Guarantees that a rule cannot run more than once per update.)
+6. Inputs Move The System Forward
+   When an input cell changes, it increments the global update count and
+stores the new value in its own update count.
+Dependency Discovery Axioms
+Overview: cells automatically notice when other cells depend on them, then
+notify them at most once if there is a change.
+1. Thread-local "current rule cell":
+   There is a thread-local variable that always contains the cell whose
+rule is currently being evaluated in the corresponding thread.  This
+variable can be empty (e.g. None).
+2. "Currentness" Maintenance:
+   While a cell rule's is being run, the variable described in #1 must be
+set to point to the cell whose rule is being run.  When the rule is
+finished, the variable must be restored to whatever value it had before the
+rule began.  (Guarantees that cells will be able to tell who is asking for
+their values.)
+3. Dependency Creation:
+   When a cell is read, it adds the "currently-being evaluated" cell as a
+listener that it will notify of changes.
+4. Dependency Creation Order:
+   New listeners are added only *after* the cell being read has brought
+itself up-to-date, and notified any *previous* listeners of the
+change.  (Ensures that the listening cell does not receive redundant
+notification if the listened-to cell has to be brought up-to-date first.)
+5. Dependency Minimalism:
+   A listener should only be added if it does not already present in the
+cell's listener collection.  (This isn't strictly mandatory, the system
+behavior will be correct but inefficient if this requirement isn't met.)
+6. Dependency Removal:
+   Just before a cell's rule is run, it must cease to be a listener for
+any other cells.  (Guarantees that a dependency from a previous update
+cannot trigger an unnecessary repeated calculation.)
+7. Dependency Notification
+   Whenever a cell's value changes (due to a rule change or input change),
+it must notify all of its listeners that it has changed, in such a way that
+*none* of the listeners are asked to recalculate their value until *all* of
+the listeners have first been notified of the change.  (This guarantees
+that inconsistent views cannot occur.)
+7a. Deferred Recalculation
+    The recalculation of listeners (not the notification of the listeners'
+out-of-dateness) must be deferred if a cell's value is currently being
+calculated.  As soon as there are no cells being calculated, the deferred
+recalculations must occur.  (This guarantees that in the absence of
+circular dependencies, no cell can ask for a value that's in the process of
+being calculated.)
+8. One-Time Notification Only
+   A cell's listeners are removed from its listener collection as soon as
+they have been notified.  In particular, the cell's collection of listeners
+must be cleared *before* *any* of the listeners are asked to recalculate
+themselves.  (This guarantees that listeners reinstated as a side effect of
+recalculation will not get a duplicate notification in the current update,
+or miss a notification in a future update.)
+9. Conversion to Constant
+   If a cell's rule is run and no dependencies were created, the cell must
+become a "constant" cell, and do no further listener additions or
+notification, once any necessary notifications to existing listeners are
+completed.  (That is, if the rule's run changed the cell's value, it must
+notify its existing listeners, but then the listener collection must be
+cleared -- *again*, in addition to the clearing described in #8.)
+10. No Changes During Notification:
+   It is an error to change an input cell's value while change
+notifications are taking place.
+11. Weak Notification
+   Automatically created inter-cell links must not inhibit garbage
+collection of either cell.  (Technically optional, but very easy to do.)
--- /project/cells/cvsroot/cells/cells.lisp	2006/06/10 22:16:35	1.12
+++ /project/cells/cvsroot/cells/cells.lisp	2006/06/23 01:04:56	1.13
@@ -64,7 +64,7 @@
             `(c-break ,fmt$ , at fmt-args)
           `(c-break "failed assertion: ~a" ',assertion)))))
-(defvar *c-calculators* nil)
+(defvar *call-stack* nil)
 (defmacro def-c-trace (model-type &optional slot cell-type)
   `(defmethod trcp ((self ,(case cell-type
@@ -76,7 +76,7 @@
 (defmacro without-c-dependency (&body body)
-  `(let (*c-calculators*) , at body))
+  `(let (*call-stack*) , at body))
 (define-symbol-macro .cause
     (car *causation*))
--- /project/cells/cvsroot/cells/cells.lpr	2006/05/30 02:47:45	1.14
+++ /project/cells/cvsroot/cells/cells.lpr	2006/06/23 01:04:56	1.15
@@ -1,4 +1,4 @@
-;; -*- lisp-version: "8.0 [Windows] (May 22, 2006 0:51)"; cg: "1.81"; -*-
+;; -*- lisp-version: "8.0 [Windows] (Jun 21, 2006 9:54)"; cg: "1.81"; -*-
 (in-package :cg-user)
--- /project/cells/cvsroot/cells/defmodel.lisp	2006/06/20 14:16:44	1.5
+++ /project/cells/cvsroot/cells/defmodel.lisp	2006/06/23 01:04:56	1.6
@@ -124,6 +124,7 @@
 (defun defmd-canonicalize-slot (slotname
                                  (cell nil cell-p)
+                                (type nil type-p)
                                  (initform nil initform-p)
                                  (initarg (intern (symbol-name slotname) :keyword))
                                  (documentation nil documentation-p)
@@ -135,6 +136,7 @@
   (list* slotname :initarg initarg
      (when cell-p (list :cell cell))
+     (when type-p (list :type type))
      (when initform-p (list :initform initform))
      (when unchanged-if-p (list :unchanged-if unchanged-if))
      (when reader-p (list :reader reader))
@@ -158,7 +160,7 @@
                          ((keywordp (car spec))
                           (assert (find (car spec) '(:documentation :metaclass)))
                           (push spec class-options))
-                         ((find (cadr spec) '(:initarg :cell :initform :allocation :reader :writer :accessor :documentation))
+                         ((find (cadr spec) '(:initarg :type :cell :initform :allocation :reader :writer :accessor :documentation))
                           (push (apply 'defmd-canonicalize-slot spec) slots))
                          (t ;; shortform (slotname initform &rest slotdef-key-values)
                           (push (apply 'defmd-canonicalize-slot
--- /project/cells/cvsroot/cells/initialize.lisp	2006/06/13 16:19:35	1.7
+++ /project/cells/cvsroot/cells/initialize.lisp	2006/06/23 01:04:56	1.8
@@ -36,13 +36,13 @@
   (ephemeral-reset c))
 (defmethod awaken-cell ((c c-ruled))
-  (let (*c-calculators*)
+  (let (*call-stack*)
     (calculate-and-set c)))
 #+cormanlisp ; satisfy CormanCL bug
 (defmethod awaken-cell ((c c-dependent))
-  (let (*c-calculators*)
-    (trc nil "awaken-cell c-dependent clearing *c-calculators*" c)
+  (let (*call-stack*)
+    (trc nil "awaken-cell c-dependent clearing *call-stack*" c)
     (calculate-and-set c)))
 (defmethod awaken-cell ((c c-drifter))
--- /project/cells/cvsroot/cells/integrity.lisp	2006/05/20 06:32:19	1.9
+++ /project/cells/cvsroot/cells/integrity.lisp	2006/06/23 01:04:56	1.10
@@ -64,7 +64,7 @@
   (let ((*within-integrity* nil)
-        *c-calculators*
+        *call-stack*
         (*data-pulse-id* 0))
     (funcall action)))
@@ -138,7 +138,7 @@
     ; of cells3, I coded an ephemeral cell and initialized it to non-nil, hitting a runtime
     ; error (now gone) saying I had no idea what a non-nil ephemeral would mean. That had been
     ; my conclusion when the idea occurred to me the first time, so I stuck in an assertion
-    ; to warn off users. 
+    ; to warn off callers. 
     ; But the new
     ; datachange progression defined by Cells3 had already forced me to manage ephemeral resets
--- /project/cells/cvsroot/cells/link.lisp	2006/06/20 14:16:44	1.12
+++ /project/cells/cvsroot/cells/link.lisp	2006/06/23 01:04:56	1.13
@@ -22,13 +22,13 @@
 (eval-when (compile load)
  (proclaim '(optimize (speed 3) (safety 0) (space 0) (debug 0))))
-(defun c-link-ex (used &aux (user (car *c-calculators*)))
+(defun record-caller (used &aux (caller (car *call-stack*)))
   (when (c-optimized-away-p used) ;; 2005-05-21 removed slow type check that used is cell
-    (return-from c-link-ex nil))
-  (trc nil "c-link-ex entry: used=" used :user user)
+    (return-from record-caller nil))
+  (trc nil "record-caller entry: used=" used :caller caller)
   (multiple-value-bind (used-pos useds-len)
       (loop with u-pos
-          for known in (cd-useds user)
+          for known in (cd-useds caller)
           counting known into length
           when (eq used known)
@@ -37,20 +37,20 @@
           finally (return (values (when u-pos (- length u-pos)) length)))
     (when (null used-pos)
-      (trc nil "c-link > new user,used " user used)
+      (trc nil "c-link > new caller,used " caller used)
       (count-it :new-used)
       (setf used-pos useds-len)
-      (push used (cd-useds user))
-      (user-ensure used user) ;; 060604 experiment was in unlink
+      (push used (cd-useds caller))
+      (caller-ensure used caller) ;; 060604 experiment was in unlink
-        (setf (sbit (cd-usage user) used-pos) 1)
+        (setf (sbit (cd-usage caller) used-pos) 1)
       (type-error (error)
         (declare (ignorable error))
-        (setf (cd-usage user)
-          (adjust-array (cd-usage user) (+ used-pos 16) :initial-element 0))
-        (setf (sbit (cd-usage user) used-pos) 1))))
+        (setf (cd-usage caller)
+          (adjust-array (cd-usage caller) (+ used-pos 16) :initial-element 0))
+        (setf (sbit (cd-usage caller) used-pos) 1))))
@@ -64,10 +64,10 @@
                           (if (zerop (sbit usage rpos))
                                 (count-it :unlink-unused)
-                                (c-unlink-user (car useds) c)
+                                (c-unlink-caller (car useds) c)
                                 (rplaca useds nil))
-                              ;; moved into c-link-ex 060604 (user-ensure (car useds) c)
+                              ;; moved into record-caller 060604 (caller-ensure (car useds) c)
                    (if (cdr useds)
@@ -78,12 +78,12 @@
         (nail-unused (cd-useds c))
         (setf (cd-useds c) (delete-if #'null (cd-useds c)))))))
-(defun c-user-path-exists-p (from-used to-user)
-  (count-it :user-path-exists-p)
-  (or (find to-user (c-users from-used))
-    (find-if (lambda (from-used-user)
-               (c-user-path-exists-p from-used-user to-user))
-      (c-users from-used))))
+(defun c-caller-path-exists-p (from-used to-caller)
+  (count-it :caller-path-exists-p)
+  (or (find to-caller (c-callers from-used))
+    (find-if (lambda (from-used-caller)
+               (c-caller-path-exists-p from-used-caller to-caller))
+      (c-callers from-used))))
 ; ---------------------------------------------
@@ -93,11 +93,11 @@
 ;--- unlink from used ----------------------
-(defmethod c-unlink-from-used ((user c-dependent))
-  (dolist (used (cd-useds user))
-    #+dfdbg (trc user "unlinking from used" user used)
-    (c-unlink-user used user))
-  ;; shouldn't be necessary (setf (cd-useds user) nil)
+(defmethod c-unlink-from-used ((caller c-dependent))
+  (dolist (used (cd-useds caller))
+    #+dfdbg (trc caller "unlinking from used" caller used)
+    (c-unlink-caller used caller))
+  ;; shouldn't be necessary (setf (cd-useds caller) nil)
 (defmethod c-unlink-from-used (other)
@@ -105,20 +105,20 @@
-(defun c-unlink-user (used user)
-  (trc nil "user unlinking from used" user used)
-  (user-drop used user)
-  (c-unlink-used user used))
+(defun c-unlink-caller (used caller)
+  (trc nil "caller unlinking from used" caller used)
+  (caller-drop used caller)
+  (c-unlink-used caller used))
-(defun c-unlink-used (user used)
-  (setf (cd-useds user) (delete used (cd-useds user))))
+(defun c-unlink-used (caller used)
+  (setf (cd-useds caller) (delete used (cd-useds caller))))
 ;----------------- link debugging ---------------------
-(defun dump-users (c &optional (depth 0))
+(defun dump-callers (c &optional (depth 0))
      (format t "~&~v,4t~s" depth c)
-     (dolist (user (c-users c))
-          (dump-users user (+ 1 depth))))
+     (dolist (caller (c-callers c))
+          (dump-callers caller (+ 1 depth))))
 (defun dump-useds (c &optional (depth 0))
      ;(c.trc "dump-useds> entry " c (+ 1 depth))
@@ -130,3 +130,9 @@
           (dolist (used (cd-useds c))
                (dump-useds used (+ 1 depth)))))
+(defun test-wk ()
+  (let ((h (make-hash-table :test 'eq :weak-keys t)))
+    (loop for n below 10
+          do (setf (gethash (make-cell :value n) h) n))
+    (maphash (lambda (k v) (print (list k v))) h)))
\ No newline at end of file
--- /project/cells/cvsroot/cells/md-slot-value.lisp	2006/06/15 15:55:01	1.21
+++ /project/cells/cvsroot/cells/md-slot-value.lisp	2006/06/23 01:04:56	1.22
@@ -43,8 +43,8 @@
           (with-integrity ()
             (ensure-value-is-current c))
-        (when (car *c-calculators*)
-          (c-link-ex c)))
+        (when (car *call-stack*)
+          (record-caller c)))
     (values (bd-slot-value self slot-name) nil)))
 (defun ensure-value-is-current (c)
@@ -59,7 +59,7 @@
    ((or (not (c-validp c))
       (some (lambda (used)
               (ensure-value-is-current used)
-              (trc nil "comparing pulses (user, used): " (c-pulse c)(c-pulse used))
+              (trc nil "comparing pulses (caller, used): " (c-pulse c)(c-pulse used))
               (when (and (c-changed used) (> (c-pulse used)(c-pulse c)))
                  (trc nil "used changed" c used)
@@ -80,9 +80,9 @@
              (princ #\.)
              (return-from calculate-and-set))
-           (when (find c *c-calculators*) ;; circularity
+           (when (find c *call-stack*) ;; circularity
              (c-break ;; break is problem when testing cells on some CLs
-              "cell ~a midst askers: ~a" c *c-calculators*))
+              "cell ~a midst askers: ~a" c *call-stack*))
            (multiple-value-bind (raw-value propagation-code)
                (calculate-and-link c)
@@ -97,7 +97,7 @@
 (defun calculate-and-link (c)
-  (let ((*c-calculators* (cons c *c-calculators*))
+  (let ((*call-stack* (cons c *call-stack*))
         (*defer-changes* t))
     (cd-usage-clear-all c)
--- /project/cells/cvsroot/cells/md-utilities.lisp	2006/06/13 05:05:13	1.5
+++ /project/cells/cvsroot/cells/md-utilities.lisp	2006/06/23 01:04:56	1.6
@@ -47,7 +47,7 @@
   (trc nil "md-quiesce doing" self (type-of self))
   (md-map-cells self nil (lambda (c)
                            (trc nil "quiescing" c)
-                           (c-assert (not (find c *c-calculators*)))
+                           (c-assert (not (find c *call-stack*)))
                            (c-quiesce c))))
 (defun c-quiesce (c)
@@ -56,8 +56,8 @@
      (trc nil "c-quiesce unlinking" c)
      (c-unlink-from-used c)
      (when (typep c 'cell)
-       (dolist (user (c-users c))
-         (c-unlink-user c user)))
+       (dolist (caller (c-callers c))
+         (c-unlink-caller c caller)))
       (trc nil "cell quiesce nulled cell awake" c))))
 (defmethod not-to-be (other)
--- /project/cells/cvsroot/cells/model-object.lisp	2006/06/13 16:19:35	1.7
+++ /project/cells/cvsroot/cells/model-object.lisp	2006/06/23 01:04:56	1.8
@@ -194,7 +194,7 @@
   (bif (entry (assoc slot-name (cells self)))
     (let ((old (cdr entry))) ;; s/b being supplanted by kid-slotter
       (declare (ignorable old))
-      (c-assert (null (c-users old)))
+      (c-assert (null (c-callers old)))
       (c-assert (null (cd-useds old)))
       (trc nil "replacing in model .cells" old new-cell self)
       (rplacd entry new-cell))
--- /project/cells/cvsroot/cells/optimization.lisp	2006/06/10 22:16:35	1.7
+++ /project/cells/cvsroot/cells/optimization.lisp	2006/06/23 01:04:56	1.8
@@ -45,9 +45,9 @@
              (setf (cells (c-model c)) (delete entry (cells (c-model c))))
              (push entry (cells-flushed (c-model c))))
-           (dolist (user (c-users c))
-             (setf (cd-useds user) (delete c (cd-useds user)))
-             (c-optimize-away?! user) ;; rare but it happens when rule says (or .cache ...)
+           (dolist (caller (c-callers c))
+             (setf (cd-useds caller) (delete c (cd-useds caller)))
+             (c-optimize-away?! caller) ;; rare but it happens when rule says (or .cache ...)
--- /project/cells/cvsroot/cells/propagate.lisp	2006/06/13 16:19:35	1.17
+++ /project/cells/cvsroot/cells/propagate.lisp	2006/06/23 01:04:56	1.18
@@ -61,17 +61,17 @@
   (count-it :c-propagate)
-  (let (*c-calculators* 
+  (let (*call-stack* 
         (*c-prop-depth*  (1+ *c-prop-depth*))
         (*defer-changes* t))
-    (trc nil "c-propagate clearing *c-calculators*" c)
+    (trc nil "c-propagate clearing *call-stack*" c)
     ;------ debug stuff ---------
     (when *stop*
       (princ #\.)(princ #\!)
       (return-from c-propagate))    
-    (trc nil "c-propagate> propping" c (c-value c) :user-ct (length (c-users c)) c)
+    (trc nil "c-propagate> propping" c (c-value c) :caller-ct (length (c-callers c)) c)
     (when *c-debug*
       (when (> *c-prop-depth* 250)
@@ -81,7 +81,7 @@
     ; --- manifest new value as needed ---
-    ; propagation to users jumps back in front of client slot-value-observe handling in cells3
+    ; propagation to callers jumps back in front of client slot-value-observe handling in cells3
     ; because model adopting (once done by the kids change handler) can now be done in
     ; shared-initialize (since one is now forced to supply the parent to make-instance).
@@ -89,7 +89,7 @@
     ; expected to have side-effects, so we want to propagate fully and be sure no rule
     ; wants a rollback before starting with the side effects.
-    (c-propagate-to-users c)
+    (c-propagate-to-callers c)
     (slot-value-observe (c-slot-name c) (c-model c)
       (c-value c) prior-value prior-value-supplied)
@@ -98,7 +98,7 @@
     ; let the fn decide if C really is ephemeral. Note that it might be possible to leave
     ; this out and use the datapulse to identify obsolete ephemerals and clear them
     ; when read. That would avoid ever making again bug I had in which I had the reset inside slot-value-observe,
-    ; thinking that that always followed propagation to users. It would also make
+    ; thinking that that always followed propagation to callers. It would also make
     ; debugging easier in that I could find the last ephemeral value in the inspector.
     ; would this be bad for persistent CLOS, in which a DB would think there was still a link
     ; between two records until the value actually got cleared?
@@ -147,29 +147,29 @@
 ; --- recalculate dependents ----------------------------------------------------
-(defun c-propagate-to-users (c)
+(defun c-propagate-to-callers (c)
-  ;  We must defer propagation to users because of an edge case in which:
+  ;  We must defer propagation to callers because of an edge case in which:
   ;    - X tells A to recalculate
   ;    - A asks B for its current value
   ;    - B must recalculate because it too uses X
-  ;    - if B propagates to its users after recalculating instead of deferring it
+  ;    - if B propagates to its callers after recalculating instead of deferring it
   ;       - B might tell H to reclaculate, where H decides this time to use A
   ;       - but A is in the midst of recalculating, and cannot complete until B returns.
   ;         but B is busy eagerly propagating. "This time" is important because it means
   ;         there is no way one can reliably be sure H will not ask for A
-  (when (c-users c)
-    (trc nil "c-propagate-to-users > queueing" c)
+  (when (c-callers c)
+    (trc nil "c-propagate-to-callers > queueing" c)
     (let ((causation (cons c *causation*))) ;; in case deferred
       (with-integrity (:tell-dependents c)
-        (assert (null *c-calculators*))
+        (assert (null *call-stack*))
         (let ((*causation* causation))
-          (trc nil "c-propagate-to-users > notifying users of" c (mapcar 'c-slot-name (c-users c)))
-          (dolist (user (c-users c))
-            (unless (member (cr-lazy user) '(t :always :once-asked))
-              (trc nil "propagating to user is (used,user):" c user)
-              (ensure-value-is-current user))))))))
+          (trc nil "c-propagate-to-callers > notifying callers of" c (mapcar 'c-slot-name (c-callers c)))
+          (dolist (caller (c-callers c))
+            (unless (member (cr-lazy caller) '(t :always :once-asked))
+              (trc nil "propagating to caller is (used,caller):" c caller)
+              (ensure-value-is-current caller))))))))
--- /project/cells/cvsroot/cells/synapse.lisp	2006/06/13 05:05:13	1.11
+++ /project/cells/cvsroot/cells/synapse.lisp	2006/06/23 01:04:56	1.12
@@ -23,19 +23,19 @@
 (defmacro with-synapse (synapse-id (&rest closure-vars) &body body)
   (declare (ignorable trcp))
-  (let ((syn-id (gensym))(syn-user (gensym)))
+  (let ((syn-id (gensym))(syn-caller (gensym)))
     `(let* ((,syn-id ,synapse-id)
-            (,syn-user (car *c-calculators*))
-            (synapse (or (find ,syn-id (cd-useds ,syn-user) :key 'c-slot-name)
+            (,syn-caller (car *call-stack*))
+            (synapse (or (find ,syn-id (cd-useds ,syn-caller) :key 'c-slot-name)
                        (let ((new-syn
                               (let (, at closure-vars)
-                                 :model (c-model ,syn-user)
+                                 :model (c-model ,syn-caller)
                                  :slot-name ,syn-id
                                  :code ',body
                                  :synaptic t
                                  :rule (c-lambda , at body)))))
-                         (c-link-ex new-syn)
+                         (record-caller new-syn)
            (multiple-value-bind (v p)
@@ -43,7 +43,7 @@
                  (ensure-value-is-current synapse))
              (trc nil "with-synapse: synapse, v, prop" synapse v p)
              (values v p))
-         (c-link-ex synapse)))))
+         (record-caller synapse)))))
--- /project/cells/cvsroot/cells/test.lisp	2005/09/26 15:35:58	1.7
+++ /project/cells/cvsroot/cells/test.lisp	2006/06/23 01:04:56	1.8
@@ -34,14 +34,14 @@
 - make sure they fire when they should, and do not when they should not
-- make sure they survive an evaluation by the user which does not branch to
+- make sure they survive an evaluation by the caller which does not branch to
 them (ie, does not access them)
 - make sure they optimize away
 - test with forms which access multiple other cells
-- look at direct alteration of a user
+- look at direct alteration of a caller
 - does SETF honor not propagating, as well as a c-ruled after re-calcing

More information about the Cells-cvs mailing list