[cells-cvs] CVS cells

[ktilton]

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

Modified Files:
	cells.asd cells.lisp cells.lpr md-slot-value.lisp 
	propagate.lisp 
Log Message:
Beginnings of tutorial/porting suite of demonstration/example/regression test code. Also, a fix to core Cells so rules can happen to return multiple values (say by using ROUND as the last form) without tripping over Synapse-handling.

--- /project/cells/cvsroot/cells/cells.asd	2006/03/19 00:28:38	1.3
+++ /project/cells/cvsroot/cells/cells.asd	2006/05/30 02:47:45	1.4
@@ -8,7 +8,7 @@
     :name "cells"
   :author "Kenny Tilton <kentilton at gmail.com>"
   :maintainer "Kenny Tilton <kentilton at gmail.com>"
-  :licence "MIT Style"
+  :licence "Lisp LGPL"
   :description "Cells"
   :long-description "Cells: a dataflow extension to CLOS."
   :serial t
--- /project/cells/cvsroot/cells/cells.lisp	2006/05/20 06:32:19	1.9
+++ /project/cells/cvsroot/cells/cells.lisp	2006/05/30 02:47:45	1.10
@@ -84,11 +84,11 @@
 (define-condition unbound-cell (unbound-slot) ())
 
 (defgeneric slot-value-observe (slotname self new old old-boundp)
-  #-(or cormanlisp clisp)
+  #-(or cormanlisp)
   (:method-combination progn))
 
 #-cells-testing
-(defmethod slot-value-observe #-(or cormanlisp clisp) progn
+(defmethod slot-value-observe #-(or cormanlisp) progn
   (slot-name self new old old-boundp)
   (declare (ignorable slot-name self new old old-boundp)))
 
--- /project/cells/cvsroot/cells/cells.lpr	2006/05/24 20:39:38	1.13
+++ /project/cells/cvsroot/cells/cells.lpr	2006/05/30 02:47:45	1.14
@@ -27,9 +27,7 @@
                  (make-instance 'module :name
                                 "doc\\01-Cell-basics.lisp")
                  (make-instance 'module :name
-                                "doc\\motor-control.lisp")
-                 (make-instance 'module :name
-                                "porting\\do-no-harm.lisp"))
+                                "doc\\motor-control.lisp"))
   :projects (list (make-instance 'project-module :name
                                  "utils-kt\\utils-kt"))
   :libraries nil
--- /project/cells/cvsroot/cells/md-slot-value.lisp	2006/05/20 06:32:19	1.14
+++ /project/cells/cvsroot/cells/md-slot-value.lisp	2006/05/30 02:47:45	1.15
@@ -191,9 +191,9 @@
         
         ; --- data flow propagation -----------
         ;
-        (trc nil "md-sv comparing no-prop" c prior-state absorbed-value prior-value)
+        (trc nil "md-sv testing propagation" c propagation-code prior-state absorbed-value prior-value)
         (if (or (eq propagation-code :no-propagate) ;; possible if c is a cell serving as a synapse between two cells
-              (and (null propagation-code)
+              (and (not (eq propagation-code :propagate))
                 (eql prior-state :valid)
                 (c-no-news c absorbed-value prior-value)))
             (progn
--- /project/cells/cvsroot/cells/propagate.lisp	2006/05/20 06:32:19	1.12
+++ /project/cells/cvsroot/cells/propagate.lisp	2006/05/30 02:47:45	1.13
@@ -119,7 +119,7 @@
        ,(if (eql (last1 output-body) :test)
             (let ((temp1 (gensym))
                   (loc-self (gensym)))
-              `(defmethod slot-value-observe #-(or clisp cormanlisp) ,(if aroundp :around 'progn)
+              `(defmethod slot-value-observe #-(or cormanlisp) ,(if aroundp :around 'progn)
                  ((slotname (eql ',slotname)) ,self-arg ,new-varg ,oldvarg ,oldvargboundp)
                  (let ((,temp1 (bump-output-count ,slotname))
                        (,loc-self ,(if (listp self-arg)
@@ -129,7 +129,7 @@
                      (format t "~&output ~d (~a ~a) old: ~a" ,temp1 ',slotname ,loc-self ,oldvarg))
                    (format t "~&output ~d (~a ~a) new: ~a" ,temp1 ',slotname ,loc-self ,new-varg))))
           `(defmethod slot-value-observe
-               #-(or clisp cormanlisp) ,(if aroundp :around 'progn)
+               #-(or cormanlisp) ,(if aroundp :around 'progn)
              ((slotname (eql ',slotname)) ,self-arg ,new-varg ,oldvarg ,oldvargboundp)
              (declare (ignorable
                        ,@(flet ((arg-name (arg-spec)
@@ -138,9 +138,7 @@
                                     (atom arg-spec))))
                            (list (arg-name self-arg)(arg-name new-varg)
                              (arg-name oldvarg)(arg-name oldvargboundp)))))
-             , at output-body
-             ;;broke cells-gtk #+(or clisp cormanlisp) (call-next-method)
-             )))))
+             , at output-body)))))
 
 (defmacro bump-output-count (slotname) ;; pure test func
   `(if (get ',slotname :outputs)