Update of /project/cells/cvsroot/cell-cultures/cells In directory common-lisp.net:/tmp/cvs-serv7571/cells
Modified Files: cell-types.lisp cells.asd md-slot-value.lisp md-utilities.lisp optimization.lisp propagate.lisp Log Message: Cleaning up Date: Sun Dec 5 05:50:33 2004 Author: ktilton
Index: cell-cultures/cells/cell-types.lisp diff -u cell-cultures/cells/cell-types.lisp:1.2 cell-cultures/cells/cell-types.lisp:1.3 --- cell-cultures/cells/cell-types.lisp:1.2 Sun Jul 4 20:59:41 2004 +++ cell-cultures/cells/cell-types.lisp Sun Dec 5 05:50:32 2004 @@ -79,14 +79,51 @@ :initial-element 0) :type vector))
(defstruct (c-stream - (:include c-ruled) + (:include c-dependent) (:conc-name cs-)) values)
-;;; (defmacro cell~ (&body body) -;;; `(make-c-stream -;;; :rule (lambda ,@*c-lambda* -;;; ,@body))) +(defstruct streamer from stepper donep to) + +#+notyet +(defmacro c~~~ (&key (from 0) + stepper + (donep (c-lambda (> .cache (streamer-to slot-c)))) + to) + `(make-c-stream + :rule (c-lambda (make-streamer + :from ,from + :stepper ,stepper + :to ,to :donep ,donep)))) + +(defmethod md-slot-value-assume :around ((c c-stream) (s streamer)) + (bif (to (streamer-to s)) + (loop for slot-value = (streamer-from s) + then (bIf (stepper (streamer-stepper s)) + (funcall stepper c) + (incf slot-value)) + until (bIf (to (streamer-to s)) + (> slot-value to) + (bwhen (donep-test (streamer-donep s)) + (funcall donep-test c))) + do (progn + (print `(assume doing ,slot-value)) + (call-next-method c slot-value)))) + (c-optimize-away?! c)) + +#+test +(progn + (defmodel streamertest () + ((val :accessor val :initform (c~~~ :from 0 :to (^oval))) + (oval :initarg :oval :accessor oval :initform (c-in 0)))) + + (def-c-output val ((self streamertest)) + (print `(streamertest old ,old-value new ,new-value))) + + (cell-reset) + (let ((it (make-be 'streamertest :oval 5))) + ;;(setf (oval it) 5) + it))
(defstruct (c-drifter (:include c-dependent)))
Index: cell-cultures/cells/cells.asd diff -u cell-cultures/cells/cells.asd:1.3 cell-cultures/cells/cells.asd:1.4 --- cell-cultures/cells/cells.asd:1.3 Thu Oct 28 02:09:13 2004 +++ cell-cultures/cells/cells.asd Sun Dec 5 05:50:32 2004 @@ -18,9 +18,9 @@ (:file "defpackage") (:file "cells" :depends-on ("defpackage")) (:file "cell-types" :depends-on ("defpackage")) - (:file "integrity" :depends-on ("defpackage")) + (:file "integrity" :depends-on ("cell-types")) (:file "constructors" :depends-on ("integrity" "cells")) - (:file "initialize" :depends-on ("cells")) + (:file "initialize" :depends-on ("cells" "cell-types")) (:file "md-slot-value" :depends-on ("integrity" "cell-types")) (:file "slot-utilities" :depends-on ("cells")) (:file "optimization" :depends-on ("cells")) @@ -33,7 +33,7 @@ (:file "md-utilities" :depends-on ("cells")) (:file "family" :depends-on ("defmodel")) (:file "fm-utilities" :depends-on ("cells")) - (:file "family-values" :depends-on ("propagate" "defmodel" )) + (:file "family-values" :depends-on ("family" "propagate" "defmodel" )) (:file "test" :depends-on ("family")) ))
Index: cell-cultures/cells/md-slot-value.lisp diff -u cell-cultures/cells/md-slot-value.lisp:1.4 cell-cultures/cells/md-slot-value.lisp:1.5 --- cell-cultures/cells/md-slot-value.lisp:1.4 Wed Sep 29 04:50:13 2004 +++ cell-cultures/cells/md-slot-value.lisp Sun Dec 5 05:50:32 2004 @@ -140,12 +140,15 @@
(if c (when (find c *causation*) - (if (c-cyclicp c) + (case (c-cyclicp c) + (:run-on (trc "cyclicity running on" c)) + ((t) (progn - (trc nil "cyclicity handled gracefully" c) + (trc "cyclicity handled gracefully" c) (c-pulse-update c :cyclicity-1) - (return-from md-slot-value new-value)) - (c-break "(setf md-slot-value) setf looping ~a ~a" c *causation*))) + (return-from md-slot-value new-value))) + (otherwise + (c-break "(setf md-slot-value) setf looping ~a ~a" c *causation*)))) (progn (c-break "(setf md-slot-value)> cellular slot ~a of ~a cannot be setf unless initialized as inputp" slot-name self))) @@ -158,7 +161,9 @@
new-value)
-(defun md-slot-value-assume (c raw-value) + + +(defmethod md-slot-value-assume (c raw-value) (assert c) (trc nil "md-slot-value-assume entry:" c raw-value) (bif (c-pos (position c *causation*)) @@ -185,7 +190,8 @@ (c-value-state c) :valid (c-state c) :awake)
- (c-optimize-away?! c) ;;; put optimize test here to avoid needless linking + (unless (typep c 'c-stream) ;; c-stream needs to run out first stream at least + (c-optimize-away?! c)) ;;; put optimize test here to avoid needless linking
; --- data flow propagation -----------
Index: cell-cultures/cells/md-utilities.lisp diff -u cell-cultures/cells/md-utilities.lisp:1.3 cell-cultures/cells/md-utilities.lisp:1.4 --- cell-cultures/cells/md-utilities.lisp:1.3 Thu Oct 28 02:09:13 2004 +++ cell-cultures/cells/md-utilities.lisp Sun Dec 5 05:50:32 2004 @@ -102,4 +102,5 @@ self)
(defun make-be (class &rest initargs) - (to-be (apply 'make-instance class initargs))) \ No newline at end of file + (to-be (apply 'make-instance class initargs))) +
Index: cell-cultures/cells/optimization.lisp diff -u cell-cultures/cells/optimization.lisp:1.1 cell-cultures/cells/optimization.lisp:1.2 --- cell-cultures/cells/optimization.lisp:1.1 Sat Jun 26 20:38:36 2004 +++ cell-cultures/cells/optimization.lisp Sun Dec 5 05:50:32 2004 @@ -31,12 +31,13 @@ (typecase c (c-dependent (if (and *c-optimizep* + (not (c-optimized-away-p c)) ;; c-streams come this way repeatedly even if optimized away (c-validp c) (not (c-synaptic c)) ;; no slot to cache invariant result, so they have to stay around) (null (cd-useds c)))
(progn - (trc nil "optimizing away" c) + (trc nil "optimizing away" c (c-state c)) (count-it :c-optimized)
(setf (c-state c) :optimized-away)
Index: cell-cultures/cells/propagate.lisp diff -u cell-cultures/cells/propagate.lisp:1.4 cell-cultures/cells/propagate.lisp:1.5 --- cell-cultures/cells/propagate.lisp:1.4 Wed Sep 29 04:50:13 2004 +++ cell-cultures/cells/propagate.lisp Sun Dec 5 05:50:32 2004 @@ -161,7 +161,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 c-output-slot-name - #-(or clisp cormanlisp) progn + #-(or clisp cormanlisp) progn #+(or clisp cormanlisp) :around ((slotname (eql ',slotname)) ,self-arg ,new-varg ,oldvarg ,oldvargboundp) (declare (ignorable ,@(flet ((arg-name (arg-spec) @@ -170,7 +170,8 @@ (atom arg-spec)))) (list (arg-name self-arg)(arg-name new-varg) (arg-name oldvarg)(arg-name oldvargboundp))))) - ,@output-body)))) + ,@output-body + #+(or clisp cormanlisp) (call-next-method)))))
(defmacro bump-output-count (slotname) ;; pure test func `(if (get ',slotname :outputs)