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@gmail.com" :maintainer "Kenny Tilton kentilton@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))))) - ,@output-body - ;;broke cells-gtk #+(or clisp cormanlisp) (call-next-method) - ))))) + ,@output-body)))))

(defmacro bump-output-count (slotname) ;; pure test func `(if (get ',slotname :outputs)