Update of /project/cells/cvsroot/cells In directory clnet:/tmp/cvs-serv6247
Modified Files: cell-types.lisp cells.lisp cells.lpr md-slot-value.lisp Log Message:
--- /project/cells/cvsroot/cells/cell-types.lisp 2006/07/24 05:03:07 1.16 +++ /project/cells/cvsroot/cells/cell-types.lisp 2006/07/25 10:51:48 1.17 @@ -45,9 +45,10 @@ (defun caller-drop (used caller) (fifo-delete (c-caller-store used) caller))
-;;;(defmethod trcp ((c cell)) -;;; (and ;; (typep (c-model c) 'index) -;;; (find (c-slot-name c) '(celtk::state mathx::problem)))) +(defmethod trcp ((c cell)) + #+not (and ;; (typep (c-model c) 'index) + (find (c-slot-name c) '(celtk::state mathx::problem)))) +
; --- ephemerality -------------------------------------------------- ; @@ -131,7 +132,7 @@ ;_____________________ print __________________________________
(defmethod print-object :before ((c cell) stream) - (unless *print-readably* + (unless (or *stop* *print-readably*) (format stream "[~a~a:" (if (c-inputp c) "i" "?") (cond ((null (c-model c)) #\0) @@ -139,8 +140,9 @@ ((not (c-currentp c)) ##) (t #\space)))))
+ (defmethod print-object ((c cell) stream) - (if *print-readably* + (if (or *stop* *print-readably*) (call-next-method) (progn (c-print-value c stream) @@ -149,6 +151,7 @@ (symbol-name (or (c-slot-name c) :anoncell)) (or (c-model c) :anonmd)))))
+ ;__________________
(defmethod c-print-value ((c c-ruled) stream) --- /project/cells/cvsroot/cells/cells.lisp 2006/06/25 21:30:34 1.14 +++ /project/cells/cvsroot/cells/cells.lisp 2006/07/25 10:51:48 1.15 @@ -45,8 +45,8 @@ (trc nil "------ cell reset ----------------------------"))
(defun c-stop (&optional why) - (format t "~&C-STOP> stopping because ~a" why) - (setf *stop* t)) + (setf *stop* t) + (format t "~&C-STOP> stopping because ~a" why) )
(define-symbol-macro .stop (c-stop :user)) @@ -132,9 +132,12 @@
(defun c-break (&rest args) (unless *stop* - (c-stop args) - (format t "c-break > stopping > ~a" args) - (apply 'break args))) + (LET ((*print-level* 3) + (*print-circle* t) + ) + (c-stop args) + (format t "c-break > stopping > ~a" args) + (apply 'break args))))
--- /project/cells/cvsroot/cells/cells.lpr 2006/07/24 05:03:08 1.18 +++ /project/cells/cvsroot/cells/cells.lpr 2006/07/25 10:51:48 1.19 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Jul 19, 2006 19:38)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Jul 24, 2006 15:27)"; cg: "1.81"; -*-
(in-package :cg-user)
--- /project/cells/cvsroot/cells/md-slot-value.lisp 2006/07/24 05:03:08 1.25 +++ /project/cells/cvsroot/cells/md-slot-value.lisp 2006/07/25 10:51:48 1.26 @@ -18,7 +18,7 @@
(in-package :cells)
-(defparameter *ide-app-hard-to-kill* nil) +(defparameter *ide-app-hard-to-kill* t)
(defun md-slot-value (self slot-name &aux (c (md-slot-cell self slot-name))) (tagbody @@ -83,15 +83,18 @@ (return-from calculate-and-set))
(when (find c *call-stack*) ;; circularity - (trc "cell appears in call stack:" c) - (loop with caller-reiterated + (trc "cell appears in call stack:" *stop*) + (setf *stop* t) + (break) + #+not (loop with caller-reiterated for caller in *call-stack* until caller-reiterated do (trc "caller:" caller) (pprint (cr-code c)) (setf caller-reiterated (eq caller c))) (c-break ;; break is problem when testing cells on some CLs - "cell ~a midst askers (see above)" c)) + "cell ~a midst askers (see above)" c) + (break))
(multiple-value-bind (raw-value propagation-code) (calculate-and-link c)