Just trying to get a patch in for record-caller

cell-types.lisp

@@ -60,7 +60,13 @@ See the Lisp Lesser GNU Public License for more details.
 
 (defmethod print-object ((c cell) stream)
   (declare (ignorable stream))
-  (unless *stop*
+  (if *stop*
+      (format stream "<~d:~a ~a/~a = ~a>"
+        (c-pulse c)
+        (subseq (string (c-state c)) 0 1)
+        (symbol-name (or (c-slot-name c) :anoncell))
+        (md-name (c-model c))
+        (type-of (c-value c)))
     (let ((*print-circle* t))
       #+failsafe (format stream "~a/~a" (c-model c)(c-slot-name c))
       (if *print-readably*
@@ -72,16 +78,18 @@ See the Lisp Lesser GNU Public License for more details.
             (subseq (string (c-state c)) 0 1)
             (symbol-name (or (c-slot-name c) :anoncell))
             (print-cell-model (c-model c))
-            (c-value c)))))))
+            (if (consp (c-value c))
+                "LST" (c-value c))))))))
 
 (export! print-cell-model)
 
 (defgeneric print-cell-model (md)
   (:method (other) (print-object other nil)))
 
 (defmethod trcp :around ((c cell))
-  (or (c-debug c)
-    (call-next-method)))
+  (and ;*c-debug*
+    (or (c-debug c)
+      (call-next-method))))
 
 (defun c-callers (c)
   "Make it easier to change implementation"
@@ -107,7 +115,7 @@ See the Lisp Lesser GNU Public License for more details.
     ;
     ; 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 callers 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...?

cells-test/cells-test.asd

@@ -9,21 +9,18 @@
   :long-description "Informatively-commented regression tests for Cells"
   :serial t
   :depends-on (:cells)
-  :components ((:module "cells-test"
-                 :serial t
-                 :components ((:file "test")
-                              (:file "hello-world")
-                              (:file "test-kid-slotting")
-                              (:file "test-lazy")
-                              (:file "person")
-                              (:file "df-interference")
-                              (:file "test-family")
-                              (:file "output-setf")
-                              (:file "test-cycle")
-                              (:file "test-ephemeral")
-                              (:file "test-synapse")
-                              (:file "deep-cells")))))
+  :components ((:file "test")
+               (:file "hello-world")
+               (:file "test-kid-slotting")
+               (:file "test-lazy")
+               (:file "person")
+               (:file "df-interference")
+               (:file "test-family")
+               (:file "output-setf")
+               (:file "test-cycle")
+               (:file "test-ephemeral")
+               (:file "test-synapse")
+               (:file "deep-cells")))
+
 
-(defmethod perform :after ((op load-op) (system (eql (find-system :cells-test))))
-  (funcall (find-symbol "TEST-CELLS" "CELLS")))
 

cells-test/cells-test.lpr

@@ -1,4 +1,4 @@
-;; -*- lisp-version: "8.1 [Windows] (Apr 3, 2008 23:47)"; cg: "1.103.2.10"; -*-
+;; -*- lisp-version: "8.1 [Windows] (Oct 11, 2008 17:00)"; cg: "1.103.2.10"; -*-
 
 (in-package :cg-user)
 
@@ -16,8 +16,11 @@
                  (make-instance 'module :name "test-cycle.lisp")
                  (make-instance 'module :name "test-ephemeral.lisp")
                  (make-instance 'module :name "test-synapse.lisp")
-                 (make-instance 'module :name "deep-cells.lisp"))
-  :projects (list (make-instance 'project-module :name "..\\cells"))
+                 (make-instance 'module :name "deep-cells.lisp")
+                 (make-instance 'module :name "clos-training.lisp")
+                 (make-instance 'module :name "do-req.lisp"))
+  :projects (list (make-instance 'project-module :name "..\\cells"
+                                 :show-modules nil))
   :libraries nil
   :distributed-files nil
   :internally-loaded-files nil
@@ -94,6 +97,7 @@
   :old-space-size 256000
   :new-space-size 6144
   :runtime-build-option :standard
+  :build-number 0
   :on-initialization 'cells::test-cells
   :on-restart 'do-default-restart)
 

cells-test/deep-cells.lisp

@@ -4,9 +4,9 @@
 (defvar *obs-1-count*)
 
 (defmodel deep ()
-  ((cell-2 :cell :ephemeral :initform (c-in 'two) :accessor :cell-2)
-   (cell-1 :initform (c? (list 'one (^cell-2) (^cell-3))) :accessor :cell-1)
-   (cell-3 :initform (c-in 'c3-unset) :accessor :cell-3)))
+  ((cell-2 :cell :ephemeral :initform (c-in 'two) :accessor cell-2)
+   (cell-1 :initform (c? (list 'one (^cell-2) (^cell-3))) :accessor cell-1)
+   (cell-3 :initform (c-in 'c3-unset) :accessor cell-3)))
 
 (defobserver cell-1 ()
   (trc "cell-1 observer raw now enqueing client to run first. (new,old)=" new-value old-value)

cells-test/person.lisp

@@ -36,6 +36,16 @@
                           (incf *name-ct-calc*)
                           (length (names self))))))
 
+#+test
+(progn
+  (cells-reset)
+  (inspect
+   (make-instance 'person
+     :names '("speedy" "chill")
+     :pulse (c-in 60)
+     :speech (c? (car (names self)))
+     :thought (c? (when (< (pulse self) 100) (speech self))))))
+
 (defobserver names ((self person) new-names)
   (format t "~&you can call me ~a" new-names))
 
@@ -124,6 +134,8 @@
     ;;
     (ct-assert (null (thought p)))))
 
+
+
 (def-cell-test cv-test-person-3 ()
   ;; -------------------------------------------------------
   ;;  dynamic dependency graph maintenance
@@ -154,6 +166,7 @@
     (setf (pulse p) 50)
     (ct-assert (eql 1 (length (cd-useds (md-slot-cell p 'thought)))))))
 
+
 (def-cell-test cv-test-person-4 ()
   (let ((p (make-instance 'person
              :names '("speedy" "chill")
@@ -167,8 +180,10 @@
     ;;    - all cells accessed are constant.
     ;;
     (ct-assert (null (md-slot-cell p 'speech)))
-    (ct-assert (assoc 'speech (cells-flushed  p)))
-    (ct-assert (c-optimized-away-p (cdr (assoc 'speech (cells-flushed  p)))))
+    #-its-alive!
+    (progn
+      (ct-assert (assoc 'speech (cells-flushed  p)))
+      (ct-assert (c-optimized-away-p (cdr (assoc 'speech (cells-flushed  p))))))
 
     (ct-assert (not (c-optimized-away-p (md-slot-cell p 'thought)))) ;; pulse is variable, so cannot opti
     (ct-assert (eql 1 (length (cd-useds (md-slot-cell p 'thought))))) ;; but speech is opti, so only 1 used
@@ -195,6 +210,8 @@
   ;;   make sure cyclic dependencies are trapped:
   ;;
   (cells-reset)
+  #+its-alive! t
+  #-its-alive!
   (ct-assert
    (handler-case
        (progn
@@ -205,10 +222,9 @@
                            (length (names self)))))
          nil)
      (t (error)
-        (describe  error)
+       (describe  error)
        (setf *stop* nil)
-        t)))
-  )
+       t))))
 ;;
 ;; we'll toss off a quick class to test tolerance of cyclic
 

cells-test/test.lisp

@@ -69,15 +69,21 @@ subclass for them?)
 
 
 (defun test-cells ()
-  (loop for test in (reverse *cell-tests*)
-        when t ; (eq 'cv-test-person-5 test)
-        do (cell-test-init test)
-        (funcall test))
-  (print (make-string 40 :initial-element #\*))
-  (print (make-string 40 :initial-element #\*))
-  (print "*** Cells-test successfully completed **")
-  (print (make-string 40 :initial-element #\*))
-  (print (make-string 40 :initial-element #\*)))
+  (dribble "c:/0algebra/cells-test.txt")
+  (progn ;prof:with-profiling (:type :time)
+    (time
+     (progn
+       (loop for test in (reverse *cell-tests*)
+           when t ; (eq 'cv-test-person-5 test)
+           do (cell-test-init test)
+             (funcall test))
+       (print (make-string 40 :initial-element #\*))
+       (print (make-string 40 :initial-element #\*))
+       (print "*** Cells-test successfully completed **")
+       (print (make-string 40 :initial-element #\*))
+       (print (make-string 40 :initial-element #\*)))))
+  ;(prof:show-call-graph)
+  (dribble))
 
 (defun cell-test-init (name)
   (print (make-string 40 :initial-element #\!))

cells.asd

@@ -33,8 +33,9 @@
                (:file "family")
                (:file "fm-utilities")
                (:file "family-values")
-	       (:file "test-propagation")
-	       (:file "cells-store")))
+               (:file "test-propagation")
+               (:file "cells-store")
+               (:file "test-cc")))
 
 (defmethod perform ((o load-op) (c (eql (find-system :cells))))
   (pushnew :cells *features*))

cells.lisp

@@ -31,17 +31,17 @@ a cellular slot (or in a list in such) and then mop those up on not-to-be.
 
 |#
 
-
-(eval-when (compile load)
-  (proclaim '(optimize (speed 2) (safety 1) (space 1) (debug 3))))
-
 (in-package :cells)
 
 (defparameter *c-prop-depth* 0)
 (defparameter *causation* nil)
 
 (defparameter *data-pulse-id* 0)
+(define-symbol-macro .dpid *data-pulse-id*)
+(defparameter *finbiz-id* 0) ;; debugging tool only
+(define-symbol-macro .fbid *finbiz-id*)
 
+(export! .dpid .fbid)
 (defparameter *c-debug* nil)
 (defparameter *defer-changes* nil)
 (defparameter *within-integrity* nil)
@@ -50,6 +50,9 @@ a cellular slot (or in a list in such) and then mop those up on not-to-be.
 (defparameter *unfinished-business* nil)
 (defparameter *not-to-be* nil)
 
+(defparameter *awake* nil)
+(defparameter *awake-ct* nil)
+
 #+test
 (cells-reset)
 
@@ -58,7 +61,11 @@ a cellular slot (or in a list in such) and then mop those up on not-to-be.
   (setf 
    *c-debug* debug
    *c-prop-depth* 0
+   *awake-ct* nil
+   *awake* nil
+   *not-to-be* nil
    *data-pulse-id* 0
+   *finbiz-id* 0
    *defer-changes* nil ;; should not be necessary, but cannot be wrong
    *client-queue-handler* client-queue-handler
    *within-integrity* nil
@@ -77,7 +84,10 @@ a cellular slot (or in a list in such) and then mop those up on not-to-be.
 (defun c-stopped ()
   *stop*)
 
-(export! .stopped)
+(export! .stopped .cdbg)
+
+(define-symbol-macro .cdbg
+    *c-debug*)
 
 (define-symbol-macro .stopped
     (c-stopped))

cells.lpr

@@ -1,4 +1,4 @@
-;; -*- lisp-version: "8.1 [Windows] (Apr 3, 2008 23:47)"; cg: "1.103.2.10"; -*-
+;; -*- lisp-version: "8.1 [Windows] (Oct 11, 2008 17:00)"; cg: "1.103.2.10"; -*-
 
 (in-package :cg-user)
 
@@ -25,9 +25,11 @@
                  (make-instance 'module :name "fm-utilities.lisp")
                  (make-instance 'module :name "family-values.lisp")
                  (make-instance 'module :name "test-propagation.lisp")
-                 (make-instance 'module :name "cells-store.lisp"))
+                 (make-instance 'module :name "cells-store.lisp")
+                 (make-instance 'module :name "test-cc.lisp"))
   :projects (list (make-instance 'project-module :name
-                                 "utils-kt\\utils-kt"))
+                                 "utils-kt\\utils-kt" :show-modules
+                                 nil))
   :libraries nil
   :distributed-files nil
   :internally-loaded-files nil
@@ -48,7 +50,8 @@
   :old-space-size 256000
   :new-space-size 6144
   :runtime-build-option :standard
-  :on-initialization 'cells::tcprop
+  :build-number 0
+  :on-initialization 'cells::test-with-cc
   :on-restart 'do-default-restart)
 
 ;; End of Project Definition