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 synaptic changed - (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 @@ debug md-info)

-(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) #+notsureaboutthis - (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$ ,@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 @@ `t))))

(defmacro without-c-dependency (&body body) - `(let (*c-calculators*) ,@body)) + `(let (*call-stack*) ,@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 &key (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 (append (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) *unfinished-business* *defer-changes* - *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) do @@ -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 )

(handler-case - (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)))) used)

@@ -64,10 +64,10 @@ (if (zerop (sbit usage rpos)) (progn (count-it :unlink-unused) - (c-unlink-user (car useds) c) + (c-unlink-caller (car useds) c) (rplaca useds nil)) (progn - ;; 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 @@ (prog1 (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) t)) @@ -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 @@ (body))))

(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) (multiple-value-prog1 --- /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 ...) ) t)

--- /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 (,@closure-vars) (make-c-dependent - :model (c-model ,syn-user) + :model (c-model ,syn-caller) :slot-name ,syn-id :code ',body :synaptic t :rule (c-lambda ,@body))))) - (c-link-ex new-syn) + (record-caller new-syn) new-syn)))) (prog1 (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