[cells-cvs] CVS cells

[ktilton]

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

Modified Files:
	link.lisp md-slot-value.lisp propagate.lisp 
Log Message:
evolving geometry; refinement of test case 01c-cascade

--- /project/cells/cvsroot/cells/link.lisp	2006/05/20 06:32:19	1.9
+++ /project/cells/cvsroot/cells/link.lisp	2006/06/05 00:01:22	1.10
@@ -22,30 +22,14 @@
 (eval-when (compile load)
  (proclaim '(optimize (speed 3) (safety 0) (space 0) (debug 0))))
 
-
 (defun c-link-ex (used &aux (user (car *c-calculators*)))
-  (c-assert user)
-  (c-assert used)
   (when (c-optimized-away-p used) ;; 2005-05-21 removed slow type check that used is cell
     (return-from c-link-ex nil))
-
-
-  ;
-  ; --------- debug stuff --------------
-  (c-assert user)
-  (c-assert (c-model user))
-  (c-assert (c-model used))
-
-  #+dfdbg (trc user "c-link > user, used" user used)
-  (c-assert (not (eq :eternal-rest (md-state (c-model user)))))
-  (c-assert (not (eq :eternal-rest (md-state (c-model used)))))
-  (count-it :c-link-entry)
-
+  (trc nil "c-link-ex entry: used=" used :user user)
   (multiple-value-bind (used-pos useds-len)
       (loop with u-pos
           for known in (cd-useds user)
           counting known into length
-            ;; do (print (list :data known length))
           when (eq used known)
           do
             (count-it :known-used)
@@ -56,7 +40,9 @@
       (trc nil "c-link > new user,used " user used)
       (count-it :new-used)
       (setf used-pos useds-len)
-      (push used (cd-useds user)))
+      (push used (cd-useds user))
+      (user-ensure used user) ;; 060604 experiment was in unlink
+      )
 
     (handler-case
         (setf (sbit (cd-usage user) used-pos) 1)
@@ -68,7 +54,6 @@
   used)
 
 
-
 ;--- c-unlink-unused --------------------------------
 
 (defun c-unlink-unused (c &aux (usage (cd-usage c)))
@@ -81,7 +66,10 @@
                                 (count-it :unlink-unused)
                                 (c-unlink-user (car useds) c)
                                 (rplaca useds nil))
-                            (user-ensure (car useds) c))))
+                            (progn
+                              ;; moved into c-link-ex 060604 (user-ensure (car useds) c)
+                              )
+                            )))
                    (if (cdr useds)
                        (progn
                          (nail-unused (cdr useds))
--- /project/cells/cvsroot/cells/md-slot-value.lisp	2006/05/30 02:47:45	1.15
+++ /project/cells/cvsroot/cells/md-slot-value.lisp	2006/06/05 00:01:22	1.16
@@ -42,13 +42,12 @@
   (if c
       (prog1
           (with-integrity ()
-            (c-value-ensure-current c :md-slot-value))
+            (c-value-ensure-current c))
         (when (car *c-calculators*)
           (c-link-ex c)))
     (values (bd-slot-value self slot-name) nil)))
   
-(defun c-value-ensure-current (c &optional (debug-id :anon-caller))
-  (declare (ignorable debug-id))
+(defun c-value-ensure-current (c)
   (count-it :c-value-ensure-current)
   (trc nil "c-value-ensure-current >" c)
   (cond
@@ -59,7 +58,7 @@
 
    ((or (not (c-validp c))
       (some (lambda (used)
-              (c-value-ensure-current used :recursive-used)
+              (c-value-ensure-current used)
               (trc nil "comparing pulses (user, used): " (c-pulse c)(c-pulse used))
               (when (and (c-changed used) (> (c-pulse used)(c-pulse c)))
                  (trc nil "used changed" c used)
--- /project/cells/cvsroot/cells/propagate.lisp	2006/05/30 02:47:45	1.13
+++ /project/cells/cvsroot/cells/propagate.lisp	2006/06/05 00:01:22	1.14
@@ -165,11 +165,11 @@
       (with-integrity (:tell-dependents c)
         (assert (null *c-calculators*))
         (let ((*causation* causation))
-          (trc nil "c-propagate-to-users > notifying users of" c)
+          (trc "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)
-              (c-value-ensure-current user :user-propagation))))))))
+              (c-value-ensure-current user))))))))