[cells-cvs] CVS cells
ktilton
ktilton at common-lisp.net
Mon Jul 24 05:03:08 UTC 2006
Update of /project/cells/cvsroot/cells
In directory clnet:/tmp/cvs-serv25652
Modified Files:
cell-types.lisp cells.lpr integrity.lisp link.lisp
md-slot-value.lisp propagate.lisp synapse.lisp
Log Message:
Looks like copying files back and forth has fooled CVS into thinking everything changed. <sigh>
--- /project/cells/cvsroot/cells/cell-types.lisp 2006/06/29 09:54:06 1.15
+++ /project/cells/cvsroot/cells/cell-types.lisp 2006/07/24 05:03:07 1.16
@@ -45,9 +45,9 @@
(defun caller-drop (used caller)
(fifo-delete (c-caller-store used) caller))
-(defmethod trcp ((c cell))
- nil #+(or) (and (typep (c-model c) 'index)
- (eql 'state (c-slot-name c))))
+;;;(defmethod trcp ((c cell))
+;;; (and ;; (typep (c-model c) 'index)
+;;; (find (c-slot-name c) '(celtk::state mathx::problem))))
; --- ephemerality --------------------------------------------------
;
@@ -131,20 +131,23 @@
;_____________________ print __________________________________
(defmethod print-object :before ((c cell) stream)
- (declare (ignorable c))
- (format stream "[~a~a:" (if (c-inputp c) "i" "?")
- (cond
- ((null (c-model c)) #\0)
- ((eq :eternal-rest (md-state (c-model c))) #\_)
- ((not (c-currentp c)) #\#)
- (t #\space))))
+ (unless *print-readably*
+ (format stream "[~a~a:" (if (c-inputp c) "i" "?")
+ (cond
+ ((null (c-model c)) #\0)
+ ((eq :eternal-rest (md-state (c-model c))) #\_)
+ ((not (c-currentp c)) #\#)
+ (t #\space)))))
(defmethod print-object ((c cell) stream)
- (c-print-value c stream)
- (format stream "=~d/~a/~a]"
- (c-pulse c)
- (symbol-name (or (c-slot-name c) :anoncell))
- (or (c-model c) :anonmd)))
+ (if *print-readably*
+ (call-next-method)
+ (progn
+ (c-print-value c stream)
+ (format stream "=~d/~a/~a]"
+ (c-pulse c)
+ (symbol-name (or (c-slot-name c) :anoncell))
+ (or (c-model c) :anonmd)))))
;__________________
--- /project/cells/cvsroot/cells/cells.lpr 2006/06/29 09:54:06 1.17
+++ /project/cells/cvsroot/cells/cells.lpr 2006/07/24 05:03:08 1.18
@@ -1,4 +1,4 @@
-;; -*- lisp-version: "8.0 [Windows] (Jun 28, 2006 10:53)"; cg: "1.81"; -*-
+;; -*- lisp-version: "8.0 [Windows] (Jul 19, 2006 19:38)"; cg: "1.81"; -*-
(in-package :cg-user)
--- /project/cells/cvsroot/cells/integrity.lisp 2006/07/06 22:10:01 1.11
+++ /project/cells/cvsroot/cells/integrity.lisp 2006/07/24 05:03:08 1.12
@@ -53,18 +53,21 @@
(funcall action)
(finish-business)))))
-(defmacro without-integrity ((&optional dbg-info) &rest body)
+(export! with-integrity-bubble)
+
+(defmacro with-integrity-bubble ((&optional dbg-info) &rest body)
"Whimsical name for launching a self-contained, dynamic integrity chunk, as with
string-to-mx in the math-paper project, where everything is fully isolated from the
outside computation."
- `(call-without-integrity ,dbg-info (lambda () , at body)))
+ `(call-with-integrity-bubble ,dbg-info (lambda () , at body)))
-(defun call-without-integrity (dbg-info action)
+(defun call-with-integrity-bubble (dbg-info action)
(declare (ignorable dbg-info))
(let ((*within-integrity* nil)
*unfinished-business*
*defer-changes*
- *call-stack*)
+ *call-stack*
+ (*data-pulse-id* 0))
(funcall action)))
(defun ufb-queue (opcode)
--- /project/cells/cvsroot/cells/link.lisp 2006/07/06 22:10:01 1.15
+++ /project/cells/cvsroot/cells/link.lisp 2006/07/24 05:03:08 1.16
@@ -95,7 +95,7 @@
(defmethod c-unlink-from-used ((caller c-dependent))
(dolist (used (cd-useds caller))
- #+dfdbg (trc caller "unlinking from used" caller used)
+ #+dfdbg (trc nil "unlinking from used" caller used)
(c-unlink-caller used caller))
;; shouldn't be necessary (setf (cd-useds caller) nil)
)
--- /project/cells/cvsroot/cells/md-slot-value.lisp 2006/06/29 09:54:06 1.24
+++ /project/cells/cvsroot/cells/md-slot-value.lisp 2006/07/24 05:03:08 1.25
@@ -42,14 +42,15 @@
(if c
(prog1
(with-integrity ()
- (ensure-value-is-current c))
+ (ensure-value-is-current c :mdsv nil))
(when (car *call-stack*)
(record-caller c)))
(values (bd-slot-value self slot-name) nil)))
-(defun ensure-value-is-current (c)
+(defun ensure-value-is-current (c debug-id caller)
+ (declare (ignorable debug-id caller))
(count-it :ensure-value-is-current)
- (trc nil "ensure-value-is-current >" c)
+ (trc nil "ensure-value-is-current > entry" c :now-pulse *data-pulse-id* debug-id caller)
(cond
((c-currentp c)(trc nil "c-currentp" c)) ;; used to follow c-inputp, but I am toying with letting ephemerals (inputs) fall obsolete
;; and then get reset here (ie, ((c-input-p c) (ephemeral-reset c))). ie, do not assume inputs are never obsolete
@@ -58,16 +59,17 @@
((or (not (c-validp c))
(some (lambda (used)
- (ensure-value-is-current used)
- (trc nil "comparing pulses (caller, used): " (c-pulse c)(c-pulse used))
+ (ensure-value-is-current used :nested c)
+ (trc nil "comparing pulses (caller, used, used-changed): " c used (c-changed used))
(when (and (c-changed used) (> (c-pulse used)(c-pulse c)))
- (trc nil "used changed" c used)
+ (trc nil "used changed and newer !!!!!!" c used)
t))
(cd-useds c)))
- (trc nil "ensuring current calc-set of" (c-slot-name c) debug-id)
+ (trc nil "ensuring current calc-set of" (c-slot-name c))
(calculate-and-set c))
- (t (c-pulse-update c :valid-uninfluenced)))
+ (t (trc nil "ensuring current decided current, updating pulse" (c-slot-name c) )
+ (c-pulse-update c :valid-uninfluenced)))
(when (c-unboundp c)
(error 'unbound-cell :cell c :instance (c-model c) :name (c-slot-name c)))
@@ -143,6 +145,7 @@
;
; --- data flow propagation -----------
;
+
(setf (c-changed c) t)
(without-c-dependency
(c-propagate c prior-value t)))))))
@@ -207,6 +210,7 @@
; --- data flow propagation -----------
(unless (eq propagation-code :no-propagate)
+ (trc nil "md-slot-value-assume flagging as changed" c)
(setf (c-changed c) t)
(c-propagate c prior-value (eq prior-state :valid))) ;; until 06-02-13 was (not (eq prior-state :unbound))
--- /project/cells/cvsroot/cells/propagate.lisp 2006/06/23 01:04:56 1.18
+++ /project/cells/cvsroot/cells/propagate.lisp 2006/07/24 05:03:08 1.19
@@ -46,7 +46,7 @@
(defun c-pulse-update (c key)
(declare (ignorable key))
- (trc nil "c-pulse-update updating" *data-pulse-id* c key)
+ (trc nil "c-pulse-update updating as unchanged!!!" *data-pulse-id* c key)
(setf (c-changed c) nil
(c-pulse c) *data-pulse-id*))
@@ -165,11 +165,11 @@
(with-integrity (:tell-dependents c)
(assert (null *call-stack*))
(let ((*causation* causation))
- (trc nil "c-propagate-to-callers > notifying callers of" c (mapcar 'c-slot-name (c-callers c)))
+ (trc nil "c-propagate-to-callers > actually 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))))))))
+ (trc nil "propagating to caller is caller:" caller)
+ (ensure-value-is-current caller :prop-from c))))))))
--- /project/cells/cvsroot/cells/synapse.lisp 2006/07/06 22:10:01 1.13
+++ /project/cells/cvsroot/cells/synapse.lisp 2006/07/24 05:03:08 1.14
@@ -39,7 +39,7 @@
(prog1
(multiple-value-bind (v p)
(with-integrity ()
- (ensure-value-is-current synapse))
+ (ensure-value-is-current synapse :synapse (car *call-stack*)))
(trc nil "with-synapse: synapse, v, prop" synapse v p)
(values v p))
(record-caller synapse)))))
More information about the Cells-cvs
mailing list