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))))))))