September 2005 - cells-cvs@common-lisp.net

[cells-cvs] CVS update: cells/cells-test/internal-combustion.lisp
by ktilton＠common-lisp.net 26 Sep '05

26 Sep '05

Update of /project/cells/cvsroot/cells/cells-test In directory common-lisp.net:/tmp/cvs-serv10081/cells-test Modified Files: internal-combustion.lisp Log Message: Use #+(or) to reliably comment out forms Date: Mon Sep 26 17:38:35 2005 Author: ktilton Index: cells/cells-test/internal-combustion.lisp diff -u cells/cells-test/internal-combustion.lisp:1.3 cells/cells-test/internal-combustion.lisp:1.4 --- cells/cells-test/internal-combustion.lisp:1.3 Mon Sep 26 17:36:00 2005 +++ cells/cells-test/internal-combustion.lisp Mon Sep 26 17:38:35 2005 @@ -100,7 +100,7 @@ (eql :diesel (setf (fuel (make-be 'engine :fuel :gas)) :diesel))) ;; ;; - #+(or)error ;; Cloucell needed to hold a Cell in a non cellular slot. duh. + #+(or) ;; not an error: Cloucell needed to hold a Cell in a non cellular slot. duh. (cv-assert (handler-case (progn

1 0

[cells-cvs] CVS update: cells/utils-kt/debug.lisp cells/utils-kt/detritus.lisp cells/utils-kt/strings.lisp
by ktilton＠common-lisp.net 26 Sep '05

26 Sep '05

Update of /project/cells/cvsroot/cells/utils-kt In directory common-lisp.net:/tmp/cvs-serv9970/utils-kt Modified Files: debug.lisp detritus.lisp strings.lisp Log Message: Use #+(or) to reliably comment out forms Date: Mon Sep 26 17:36:05 2005 Author: ktilton Index: cells/utils-kt/debug.lisp diff -u cells/utils-kt/debug.lisp:1.4 cells/utils-kt/debug.lisp:1.5 --- cells/utils-kt/debug.lisp:1.4 Mon Sep 26 17:05:43 2005 +++ cells/utils-kt/debug.lisp Mon Sep 26 17:36:05 2005 @@ -159,7 +159,7 @@ (defmacro count-it (&rest keys) (declare (ignorable keys)) - #+not `(progn) + #+(or) `(progn) `(when *counting* (call-count-it ,@keys))) Index: cells/utils-kt/detritus.lisp diff -u cells/utils-kt/detritus.lisp:1.1 cells/utils-kt/detritus.lisp:1.2 --- cells/utils-kt/detritus.lisp:1.1 Fri May 6 23:05:56 2005 +++ cells/utils-kt/detritus.lisp Mon Sep 26 17:36:05 2005 @@ -71,7 +71,7 @@ (loop until (fifo-empty q) do (funcall fn (fifo-pop q)))) -#+test +#+(or) (let ((*print-circle* t)) (let ((q (make-fifo-queue))) (loop for n below 3 Index: cells/utils-kt/strings.lisp diff -u cells/utils-kt/strings.lisp:1.1 cells/utils-kt/strings.lisp:1.2 --- cells/utils-kt/strings.lisp:1.1 Fri May 6 23:05:56 2005 +++ cells/utils-kt/strings.lisp Mon Sep 26 17:36:05 2005 @@ -143,7 +143,7 @@ (or (null s) (if (stringp s) (string-equal "" (trim$ s)) - #+not (trc nil "empty$> sees non-string" (type-of s))) + #+(or) (trc nil "empty$> sees non-string" (type-of s))) )) (defmacro find$ (it where &rest args)

1 0

[cells-cvs] CVS update: cells/doc/hw.lisp
by ktilton＠common-lisp.net 26 Sep '05

26 Sep '05

Update of /project/cells/cvsroot/cells/doc In directory common-lisp.net:/tmp/cvs-serv9970/doc Modified Files: hw.lisp Log Message: Use #+(or) to reliably comment out forms Date: Mon Sep 26 17:36:04 2005 Author: ktilton Index: cells/doc/hw.lisp diff -u cells/doc/hw.lisp:1.1 cells/doc/hw.lisp:1.2 --- cells/doc/hw.lisp:1.1 Fri May 6 23:05:55 2005 +++ cells/doc/hw.lisp Mon Sep 26 17:36:04 2005 @@ -54,7 +54,7 @@ (setf (salutation system) "hiya") (values))) -#+test +#+(or) (hello-world) #| output

1 0

[cells-cvs] CVS update: cells/cells-test/boiler-examples.lisp cells/cells-test/echo-setf.lisp cells/cells-test/hello-world-q.lisp cells/cells-test/hello-world.lisp cells/cells-test/internal-combustion.lisp cells/cells-test/lazy-propagation.lisp cells/cells-test/output-setf.lisp cells/cells-test/person.lisp cells/cells-test/test-family.lisp cells/cells-test/test-lazy.lisp cells/cells-test/test.lisp
by ktilton＠common-lisp.net 26 Sep '05

26 Sep '05

Update of /project/cells/cvsroot/cells/cells-test In directory common-lisp.net:/tmp/cvs-serv9970/cells-test Modified Files: boiler-examples.lisp echo-setf.lisp hello-world-q.lisp hello-world.lisp internal-combustion.lisp lazy-propagation.lisp output-setf.lisp person.lisp test-family.lisp test-lazy.lisp test.lisp Log Message: Use #+(or) to reliably comment out forms Date: Mon Sep 26 17:36:00 2005 Author: ktilton Index: cells/cells-test/boiler-examples.lisp diff -u cells/cells-test/boiler-examples.lisp:1.1 cells/cells-test/boiler-examples.lisp:1.2 --- cells/cells-test/boiler-examples.lisp:1.1 Fri May 6 23:05:51 2005 +++ cells/cells-test/boiler-examples.lisp Mon Sep 26 17:36:00 2005 @@ -60,7 +60,7 @@ (cv-assert (eql :closed (vent b))) )) -#+test +#+(or) (boiler-1) ; @@ -157,7 +157,7 @@ (cv-assert (eql :closed (vent b))) )) -#+test +#+(or) (boiler-2) ;;; *********************************************** @@ -242,10 +242,10 @@ ;; ;; de-comment 'trc statements above to see what is happening ;; -#+test +#+(or) (boiler-3) -#+test +#+(or) (boiler-4) (defun boiler-5 () @@ -267,7 +267,7 @@ (incf (temp (thermometer b)))) (setf (status b) (case (status b) (:on :off)(:off :on)))))) -#+test +#+(or) (boiler-5) @@ -287,4 +287,4 @@ (declare (ignorable syn)) (eko ("f-sensitivity relays") (setf prior-fire-value new-value)) ;; no modulation of value, but do record for next time - ))) \ No newline at end of file + ))) Index: cells/cells-test/echo-setf.lisp diff -u cells/cells-test/echo-setf.lisp:1.1 cells/cells-test/echo-setf.lisp:1.2 --- cells/cells-test/echo-setf.lisp:1.1 Fri May 6 23:05:51 2005 +++ cells/cells-test/echo-setf.lisp Mon Sep 26 17:36:00 2005 @@ -43,5 +43,5 @@ :kids (c-in nil)))) (push (make-instance 'bings) (kids top)))) -#+test -(cv-echo-setf) \ No newline at end of file +#+(or) +(cv-echo-setf) Index: cells/cells-test/hello-world-q.lisp diff -u cells/cells-test/hello-world-q.lisp:1.1 cells/cells-test/hello-world-q.lisp:1.2 --- cells/cells-test/hello-world-q.lisp:1.1 Fri May 6 23:05:51 2005 +++ cells/cells-test/hello-world-q.lisp Mon Sep 26 17:36:00 2005 @@ -58,10 +58,10 @@ (setf (happen dell) :world) (values))) -#+test +#+(or) (hello-world) -#+test +#+(or) (traceo sm-echo) Index: cells/cells-test/hello-world.lisp diff -u cells/cells-test/hello-world.lisp:1.1 cells/cells-test/hello-world.lisp:1.2 --- cells/cells-test/hello-world.lisp:1.1 Fri May 6 23:05:51 2005 +++ cells/cells-test/hello-world.lisp Mon Sep 26 17:36:00 2005 @@ -58,7 +58,7 @@ (setf (happen dell) :world) (values))) -#+test +#+(or) (hello-world) Index: cells/cells-test/internal-combustion.lisp diff -u cells/cells-test/internal-combustion.lisp:1.2 cells/cells-test/internal-combustion.lisp:1.3 --- cells/cells-test/internal-combustion.lisp:1.2 Fri Aug 26 16:27:59 2005 +++ cells/cells-test/internal-combustion.lisp Mon Sep 26 17:36:00 2005 @@ -100,7 +100,7 @@ (eql :diesel (setf (fuel (make-be 'engine :fuel :gas)) :diesel))) ;; ;; - #+noterror ;; Cloucell needed to hold a Cell in a non cellular slot. duh. + #+(or)error ;; Cloucell needed to hold a Cell in a non cellular slot. duh. (cv-assert (handler-case (progn @@ -246,7 +246,7 @@ ;; ;; - #+not (let ((e (make-be 'engine + #+(or) (let ((e (make-be 'engine :mod3 (c-in 3) :mod3ek (c-in 3) :cylinders (c? (* 4 (mod3 self)))))) @@ -357,6 +357,6 @@ (cv-assert (not valves-fired)) (cv-assert (valves e))(cv-assert valves-fired))) -#+test +#+(or) -(cv-test-engine) \ No newline at end of file +(cv-test-engine) Index: cells/cells-test/lazy-propagation.lisp diff -u cells/cells-test/lazy-propagation.lisp:1.1 cells/cells-test/lazy-propagation.lisp:1.2 --- cells/cells-test/lazy-propagation.lisp:1.1 Fri May 6 23:05:51 2005 +++ cells/cells-test/lazy-propagation.lisp Mon Sep 26 17:36:00 2005 @@ -35,7 +35,7 @@ (/ 1000 (^area))) :initarg :density :accessor density))) -#+test +#+(or) (cv-laziness) (defun cv-laziness () @@ -73,7 +73,7 @@ (chk 4 1) it)))) -#+test +#+(or) (cv-laziness) (def-c-output area () Index: cells/cells-test/output-setf.lisp diff -u cells/cells-test/output-setf.lisp:1.1 cells/cells-test/output-setf.lisp:1.2 --- cells/cells-test/output-setf.lisp:1.1 Fri May 6 23:05:51 2005 +++ cells/cells-test/output-setf.lisp Mon Sep 26 17:36:00 2005 @@ -32,7 +32,7 @@ (bwhen (p .parent) (with-deference (setf (bang p) new-value))) - #+not (dolist (k (^kids)) + #+(or) (dolist (k (^kids)) (setf (bang k) (if (numberp new-value) (1+ new-value) 0)))) @@ -53,5 +53,5 @@ (dolist (k (kids (car (kids top)))) (setf (bang k) (kid-no k))))) -#+test +#+(or) (cv-output-setf) Index: cells/cells-test/person.lisp diff -u cells/cells-test/person.lisp:1.1 cells/cells-test/person.lisp:1.2 --- cells/cells-test/person.lisp:1.1 Fri May 6 23:05:51 2005 +++ cells/cells-test/person.lisp Mon Sep 26 17:36:00 2005 @@ -286,7 +286,7 @@ (trc "start guarded cyclic") - #+not (cv-assert-error + #+(or) (cv-assert-error (let ((tk (make-be 'talker))) (setf (idea tk) "yes") (cv-assert (string-equal "yes" (words tk))) @@ -298,9 +298,9 @@ ;; is being given the same value it already has, and propagation stops. ;; (make-be 'talker8) - #+not (let ((tk (make-be 'talker8))) + #+(or) (let ((tk (make-be 'talker8))) (setf (idea8 tk) "yes") (string-equal "yes" (words8 tk)) (setf (words8 tk) "no") (string-equal "no" (idea8 tk))) - ) \ No newline at end of file + ) Index: cells/cells-test/test-family.lisp diff -u cells/cells-test/test-family.lisp:1.1 cells/cells-test/test-family.lisp:1.2 --- cells/cells-test/test-family.lisp:1.1 Fri May 6 23:05:51 2005 +++ cells/cells-test/test-family.lisp Mon Sep 26 17:36:00 2005 @@ -83,7 +83,7 @@ (pop (kids mom)) (nat-age 40)))) -#+test +#+(or) (cv-test-family) @@ -119,7 +119,7 @@ (defmodel bottle (model) ((label :initarg :label :initform "unlabeled" :accessor label))) -#+test +#+(or) (cv-family-values) (defun cv-family-values () @@ -154,5 +154,5 @@ )) -#+test -(cv-family-values) \ No newline at end of file +#+(or) +(cv-family-values) Index: cells/cells-test/test-lazy.lisp diff -u cells/cells-test/test-lazy.lisp:1.1 cells/cells-test/test-lazy.lisp:1.2 --- cells/cells-test/test-lazy.lisp:1.1 Fri May 6 23:05:51 2005 +++ cells/cells-test/test-lazy.lisp Mon Sep 26 17:36:00 2005 @@ -116,4 +116,4 @@ (unbound-error-p (md-slot-makunbound self 'val2)))) 2 nil nil) -#+test (do-tests) \ No newline at end of file +#+(or) (do-tests) Index: cells/cells-test/test.lisp diff -u cells/cells-test/test.lisp:1.2 cells/cells-test/test.lisp:1.3 --- cells/cells-test/test.lisp:1.2 Fri Aug 26 16:27:59 2005 +++ cells/cells-test/test.lisp Mon Sep 26 17:36:00 2005 @@ -74,7 +74,7 @@ (cv-test-lazy)))) -#+test +#+(or) (progn (let ((*c-debug* t)) (cell-reset)

1 0

[cells-cvs] CVS update: cells/cell-types.lisp cells/cells.lisp cells/family.lisp cells/integrity.lisp cells/link.lisp cells/test.lisp
by ktilton＠common-lisp.net 26 Sep '05

26 Sep '05

Update of /project/cells/cvsroot/cells In directory common-lisp.net:/tmp/cvs-serv9970 Modified Files: cell-types.lisp cells.lisp family.lisp integrity.lisp link.lisp test.lisp Log Message: Use #+(or) to reliably comment out forms Date: Mon Sep 26 17:35:58 2005 Author: ktilton Index: cells/cell-types.lisp diff -u cells/cell-types.lisp:1.6 cells/cell-types.lisp:1.7 --- cells/cell-types.lisp:1.6 Fri May 27 03:34:34 2005 +++ cells/cell-types.lisp Mon Sep 26 17:35:58 2005 @@ -39,7 +39,7 @@ md-info) (defmethod trcp ((c cell)) - nil #+not (and (typep (c-model c) 'index) + nil #+(or) (and (typep (c-model c) 'index) (eql 'state (c-slot-name c)))) (defun c-unboundp (c) @@ -89,7 +89,7 @@ (defstruct streamer from stepper donep to) -#+notyet +#+(or) (defmacro c~~~ (&key (from 0) stepper (donep (c-lambda (> .cache (streamer-to slot-c)))) @@ -114,20 +114,6 @@ ;;; (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: cells/cells.lisp diff -u cells/cells.lisp:1.5 cells/cells.lisp:1.6 --- cells/cells.lisp:1.5 Fri Aug 26 16:28:00 2005 +++ cells/cells.lisp Mon Sep 26 17:35:58 2005 @@ -58,7 +58,7 @@ (defmacro c-assert (assertion &optional places fmt$ &rest fmt-args) (declare (ignorable assertion places fmt$ fmt-args)) - `(progn) #+not + `(progn) #+(or) `(unless *stop* (unless ,assertion ,(if fmt$ Index: cells/family.lisp diff -u cells/family.lisp:1.2 cells/family.lisp:1.3 --- cells/family.lisp:1.2 Wed May 18 23:47:29 2005 +++ cells/family.lisp Mon Sep 26 17:35:58 2005 @@ -159,7 +159,7 @@ (c-assert (not (member nil new-kids))) (trc nil "md-kids-change > entry" usage new-kids old-kids) - #+not (when (and (trcp self) + #+(or) (when (and (trcp self) (eql usage :mdslotvalueassume)) (c-break "how here? ~a" self)) Index: cells/integrity.lisp diff -u cells/integrity.lisp:1.3 cells/integrity.lisp:1.4 --- cells/integrity.lisp:1.3 Wed May 18 23:47:29 2005 +++ cells/integrity.lisp Mon Sep 26 17:35:58 2005 @@ -85,7 +85,7 @@ (ufb-add opcode (cons (cdr defer-info) action)) (when (and (not *deference-acknowledged*) (member opcode '(:setf :makunbound))) - #+not (error 'c-opcode-deferred + #+(or) (error 'c-opcode-deferred :defer-info defer-info) (trc nil "!!! New pulse, event" *data-pulse-id* defer-info))) (funcall action)) Index: cells/link.lisp diff -u cells/link.lisp:1.6 cells/link.lisp:1.7 --- cells/link.lisp:1.6 Fri May 27 03:34:34 2005 +++ cells/link.lisp Mon Sep 26 17:35:58 2005 @@ -22,7 +22,7 @@ (in-package :cells) -#+not +#+(or) (eval-when (compile load) (proclaim '(optimize (speed 3) (safety 0) (space 0) (debug 0)))) Index: cells/test.lisp diff -u cells/test.lisp:1.6 cells/test.lisp:1.7 --- cells/test.lisp:1.6 Fri May 27 03:34:34 2005 +++ cells/test.lisp Mon Sep 26 17:35:58 2005 @@ -108,21 +108,6 @@ (kids i))) (trc "index total" (md-value i)))) -#+test -(let* ((a (make-array 16 :element-type 'bit - ;;:adjustable t - :initial-element 0)) - (asz (array-dimension a 0))) - (DESCRIBE A) - (inspect a) - (print a) - (dotimes (n 20) - (print n) - #+not (unless (< n asz) - (adjust-array a (incf asz 16) :initial-element 0)) - (setf (sbit a n) 1)) - a) - (defmodel m-null () ((aa :initform nil :cell nil :initarg :aa :accessor aa)))

1 0

[cells-cvs] CVS update: cells/utils-kt/debug.lisp cells/utils-kt/utils-kt.lpr
by ktilton＠common-lisp.net 26 Sep '05

26 Sep '05

Update of /project/cells/cvsroot/cells/utils-kt In directory common-lisp.net:/tmp/cvs-serv7918/utils-kt Modified Files: debug.lisp utils-kt.lpr Log Message: mere synchronization Date: Mon Sep 26 17:05:43 2005 Author: ktilton Index: cells/utils-kt/debug.lisp diff -u cells/utils-kt/debug.lisp:1.3 cells/utils-kt/debug.lisp:1.4 --- cells/utils-kt/debug.lisp:1.3 Wed May 25 07:04:47 2005 +++ cells/utils-kt/debug.lisp Mon Sep 26 17:05:43 2005 @@ -61,23 +61,24 @@ (defun call-trc (stream s &rest os) (if #+cormanlisp nil #-cormanlisp (and (boundp '*trcdepth*) - *trcdepth*) - (format stream "~&~v,,,'.<~d~>> " (mod *trcdepth* 100) *trcdepth*) - (format stream "~&")) - - (format stream "~a" s) - (let (pkwp) - (dolist (o os) - (format stream (if pkwp " ~s" " | ~s") o) - (setf pkwp (keywordp o)))) - (values)) - + *trcdepth*) + (format stream "~&~v,,,'.<~d~>> " (mod *trcdepth* 100) *trcdepth*) + (format stream "~&")) + + (format stream "~a" s) + (let (pkwp) + (dolist (o os) + (format stream (if pkwp " ~s" " | ~s") o) + (setf pkwp (keywordp o)))) + (force-output stream) + (values)) + (defun call-trc-to-string (fmt$ &rest fmt-args) - (let ((o$ (make-array '(0) :element-type 'base-char - :fill-pointer 0 :adjustable t))) - (with-output-to-string (os-stream o$) - (apply 'call-trc os-stream fmt$ fmt-args)) - o$)) + (let ((o$ (make-array '(0) :element-type 'base-char + :fill-pointer 0 :adjustable t))) + (with-output-to-string (os-stream o$) + (apply 'call-trc os-stream fmt$ fmt-args)) + o$)) #+findtrcevalnils (defmethod trcp :around (other) Index: cells/utils-kt/utils-kt.lpr diff -u cells/utils-kt/utils-kt.lpr:1.3 cells/utils-kt/utils-kt.lpr:1.4 --- cells/utils-kt/utils-kt.lpr:1.3 Fri Aug 26 16:28:02 2005 +++ cells/utils-kt/utils-kt.lpr Mon Sep 26 17:05:43 2005 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "7.0 [Windows] (Aug 5, 2005 12:23)"; cg: "1.54.2.17"; -*- +;; -*- lisp-version: "7.0 [Windows] (Sep 4, 2005 16:25)"; cg: "1.54.2.17"; -*- (in-package :cg-user)

1 0

[cells-cvs] CVS update: cells/cells.lpr cells/fm-utilities.lisp cells/md-utilities.lisp
by ktilton＠common-lisp.net 26 Sep '05

26 Sep '05

Update of /project/cells/cvsroot/cells In directory common-lisp.net:/tmp/cvs-serv7918 Modified Files: cells.lpr fm-utilities.lisp md-utilities.lisp Log Message: mere synchronization Date: Mon Sep 26 17:05:42 2005 Author: ktilton Index: cells/cells.lpr diff -u cells/cells.lpr:1.5 cells/cells.lpr:1.6 --- cells/cells.lpr:1.5 Fri Aug 26 16:28:00 2005 +++ cells/cells.lpr Mon Sep 26 17:05:42 2005 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "7.0 [Windows] (Aug 5, 2005 12:23)"; cg: "1.54.2.17"; -*- +;; -*- lisp-version: "7.0 [Windows] (Sep 4, 2005 16:25)"; cg: "1.54.2.17"; -*- (in-package :cg-user) Index: cells/fm-utilities.lisp diff -u cells/fm-utilities.lisp:1.2 cells/fm-utilities.lisp:1.3 --- cells/fm-utilities.lisp:1.2 Sat May 21 03:40:53 2005 +++ cells/fm-utilities.lisp Mon Sep 26 17:05:42 2005 @@ -25,9 +25,10 @@ (defparameter *fmdbg* nil) (eval-when (compile eval load) - (export '(make-part mk-part fm-other fm-other? fm-traverse fm-descendant-typed do-like-fm-parts + (export '(make-part mk-part fm-other fm-other? fm-traverse fm-descendant-typed + do-like-fm-parts container-typed *fmdbg* fm-other-v fm! fm^ fm-find-one fm-kid-named - + fm-prior-sib fm-value-dictionary fm-otherv?))) (defun make-part (partname part-class &rest initargs) Index: cells/md-utilities.lisp diff -u cells/md-utilities.lisp:1.1 cells/md-utilities.lisp:1.2 --- cells/md-utilities.lisp:1.1 Fri May 6 23:05:45 2005 +++ cells/md-utilities.lisp Mon Sep 26 17:05:42 2005 @@ -104,3 +104,18 @@ (defun make-be (class &rest initargs) (to-be (apply 'make-instance class initargs))) +(defmacro defparts (partName (partClass &rest partDefArgs) + &optional customArgs customValuesList + &rest commonArgPairs) + (assert (null partDefArgs)) + (let ((part-no (gensym)) + (cvls (gensym))) + `(loop with ,cvls = (list ,@customValuesList) + for ,part-no below ,(max 1 (length customValuesList)) + for custom-values = (elt ,part-no cvs) + collecting (make-instance ',partClass + :md-name ',partName + ,@(loop for arg in customargs + for n below (length customargs) + nconcing (list arg `(elt ,n custom-values))) + ,@commonArgPairs)))) \ No newline at end of file

1 0