cells-cvs

cells-cvs@common-lisp.net

721 discussions

[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/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/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/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

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

26 Aug '05

Update of /project/cells/cvsroot/cells/utils-kt In directory common-lisp.net:/tmp/cvs-serv6383/utils-kt Modified Files: utils-kt.lpr Log Message: resurrect cells-test; restore c-optimize somehow disabled at some point Date: Fri Aug 26 16:28:03 2005 Author: ktilton Index: cells/utils-kt/utils-kt.lpr diff -u cells/utils-kt/utils-kt.lpr:1.2 cells/utils-kt/utils-kt.lpr:1.3 --- cells/utils-kt/utils-kt.lpr:1.2 Sun May 8 01:12:44 2005 +++ cells/utils-kt/utils-kt.lpr Fri Aug 26 16:28:02 2005 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "7.0 [Windows] (May 6, 2005 8:25)"; cg: "1.54.2.17"; -*- +;; -*- lisp-version: "7.0 [Windows] (Aug 5, 2005 12:23)"; cg: "1.54.2.17"; -*- (in-package :cg-user)

1 0

[cells-cvs] CVS update: cells/cells.lisp cells/cells.lpr cells/md-slot-value.lisp
by ktilton＠common-lisp.net 26 Aug '05

26 Aug '05

Update of /project/cells/cvsroot/cells In directory common-lisp.net:/tmp/cvs-serv6383 Modified Files: cells.lisp cells.lpr md-slot-value.lisp Log Message: resurrect cells-test; restore c-optimize somehow disabled at some point Date: Fri Aug 26 16:28:01 2005 Author: ktilton Index: cells/cells.lisp diff -u cells/cells.lisp:1.4 cells/cells.lisp:1.5 --- cells/cells.lisp:1.4 Thu May 26 03:15:50 2005 +++ cells/cells.lisp Fri Aug 26 16:28:00 2005 @@ -40,7 +40,6 @@ (defun cell-reset () (utils-kt-reset) (setf - *c-debug* nil *c-prop-depth* 0 *data-pulse-id* 0 *data-pulses* nil Index: cells/cells.lpr diff -u cells/cells.lpr:1.4 cells/cells.lpr:1.5 --- cells/cells.lpr:1.4 Wed Jun 15 23:06:06 2005 +++ cells/cells.lpr Fri Aug 26 16:28:00 2005 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "7.0 [Windows] (May 6, 2005 8:25)"; cg: "1.54.2.17"; -*- +;; -*- lisp-version: "7.0 [Windows] (Aug 5, 2005 12:23)"; cg: "1.54.2.17"; -*- (in-package :cg-user) Index: cells/md-slot-value.lisp diff -u cells/md-slot-value.lisp:1.9 cells/md-slot-value.lisp:1.10 --- cells/md-slot-value.lisp:1.9 Thu May 26 03:15:50 2005 +++ cells/md-slot-value.lisp Fri Aug 26 16:28:01 2005 @@ -177,8 +177,8 @@ (c-value-state c) :valid (c-state c) :awake) -;;; (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 + (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 -----------

1 0

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

26 Aug '05

Update of /project/cells/cvsroot/cells/cells-test In directory common-lisp.net:/tmp/cvs-serv6383/cells-test Modified Files: cells-test.lpr internal-combustion.lisp synapse-testing.lisp test.lisp Log Message: resurrect cells-test; restore c-optimize somehow disabled at some point Date: Fri Aug 26 16:27:59 2005 Author: ktilton Index: cells/cells-test/cells-test.lpr diff -u cells/cells-test/cells-test.lpr:1.1 cells/cells-test/cells-test.lpr:1.2 --- cells/cells-test/cells-test.lpr:1.1 Fri May 6 23:05:51 2005 +++ cells/cells-test/cells-test.lpr Fri Aug 26 16:27:59 2005 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "7.0 [Windows] (Apr 6, 2005 17:03)"; cg: "1.54.2.17"; -*- +;; -*- lisp-version: "7.0 [Windows] (Aug 5, 2005 12:23)"; cg: "1.54.2.17"; -*- (in-package :cg-user) Index: cells/cells-test/internal-combustion.lisp diff -u cells/cells-test/internal-combustion.lisp:1.1 cells/cells-test/internal-combustion.lisp:1.2 --- cells/cells-test/internal-combustion.lisp:1.1 Fri May 6 23:05:51 2005 +++ cells/cells-test/internal-combustion.lisp Fri Aug 26 16:27:59 2005 @@ -225,14 +225,16 @@ (cell-reset) t))) ;; something non-nil to satisfy assert - (cv-assert - (handler-case - (let ((e (make-be 'engine :cylinders (c? (+ 2 2))))) - (setf (cylinders e) 6) - nil) ;; bad to reach here - (t (error) (trc "error correctly is" error) - (setf *stop* nil) - t))) + (let ((e (make-be 'engine :cylinders (c? (+ 2 2))))) + (assert *c-debug*) + (cv-assert + (handler-case + (progn + (setf (cylinders e) 6) + nil) ;; bad to reach here + (t (error) (trc "error correctly is" error) + (setf *stop* nil) + t)))) (when *stop* (break "stopped! 1")) (cv-test-propagation-on-slot-write) (cv-test-no-prop-unchanged) Index: cells/cells-test/synapse-testing.lisp diff -u cells/cells-test/synapse-testing.lisp:1.1 cells/cells-test/synapse-testing.lisp:1.2 --- cells/cells-test/synapse-testing.lisp:1.1 Fri May 6 23:05:51 2005 +++ cells/cells-test/synapse-testing.lisp Fri Aug 26 16:27:59 2005 @@ -33,7 +33,7 @@ (let ((self (make-be 'counter-10 :ct (c-in 0) :ct10 (c? (count-it :ct10-rule) - (f-sensitivity (10) + (f-sensitivity :dummy-id (10) (^ct)))))) (cv-assert (zerop (^ct10))) (loop for n below 30 @@ -48,7 +48,7 @@ :ct (c-in 0) :ct10 (c? (count-it :ct10-rule) (trc "runnning ct10-rule 1") - (f-delta () + (f-delta :dummy () (^ct)))))) (cv-assert (zerop (^ct10))) (cv-assert (zerop (^ct))) @@ -62,7 +62,7 @@ (let ((self (make-be 'counter-10 :ct (c-in 0) :ct10 (c? (count-it :ct10-rule) - (f-delta (:sensitivity 4) + (f-delta :xxx (:sensitivity 4) (^ct)))))) (cv-assert (null (^ct10))) (cv-assert (zerop (^ct))) Index: cells/cells-test/test.lisp diff -u cells/cells-test/test.lisp:1.1 cells/cells-test/test.lisp:1.2 --- cells/cells-test/test.lisp:1.1 Fri May 6 23:05:51 2005 +++ cells/cells-test/test.lisp Fri Aug 26 16:27:59 2005 @@ -52,26 +52,26 @@ (length *failed-tests*) ',(length tests) *failed-tests*)))) (defun cv-test () - (let ((*c-debug* t)) - (with-testing - (cell-reset) - (test-cells) + (with-testing (cell-reset) - (hello-world) ;; non-assertive + (let ((*c-debug* t)) + (test-cells) + (cell-reset) + (hello-world) ;; non-assertive - (cv-test-engine) - (cv-test-person) - (df-test) - (cv-test-family) - (cv-family-values) - (cv-kid-slotting) - (boiler-1) - (boiler-2) - (boiler-3) ;; non-assertive - (boiler-4) ;; non-assertive - (cv-laziness) - (cv-output-setf) - (cv-test-lazy)))) + (cv-test-engine) + (cv-test-person) + (df-test) + (cv-test-family) + (cv-family-values) + (cv-kid-slotting) + (boiler-1) + (boiler-2) + (boiler-3) ;; non-assertive + (boiler-4) ;; non-assertive + (cv-laziness) + (cv-output-setf) + (cv-test-lazy)))) #+test

1 0

[cells-cvs] CVS update: cells/cells.lpr cells/synapse.lisp
by ktilton＠common-lisp.net 15 Jun '05

15 Jun '05

Update of /project/cells/cvsroot/cells In directory common-lisp.net:/tmp/cvs-serv25207 Modified Files: cells.lpr synapse.lisp Log Message: minor synapse work? Date: Wed Jun 15 23:06:06 2005 Author: ktilton Index: cells/cells.lpr diff -u cells/cells.lpr:1.3 cells/cells.lpr:1.4 --- cells/cells.lpr:1.3 Thu May 19 22:17:47 2005 +++ cells/cells.lpr Wed Jun 15 23:06:06 2005 @@ -27,7 +27,8 @@ (make-instance 'module :name "test.lisp") (make-instance 'module :name "test-ephemeral.lisp") (make-instance 'module :name "test-cycle.lisp") - (make-instance 'module :name "test-synapse.lisp")) + (make-instance 'module :name "test-synapse.lisp") + (make-instance 'module :name "ipcells.lisp")) :projects (list (make-instance 'project-module :name "utils-kt\\utils-kt")) :libraries nil Index: cells/synapse.lisp diff -u cells/synapse.lisp:1.7 cells/synapse.lisp:1.8 --- cells/synapse.lisp:1.7 Fri May 27 03:34:34 2005 +++ cells/synapse.lisp Wed Jun 15 23:06:06 2005 @@ -28,13 +28,11 @@ (defmacro with-synapse (synapse-id (&rest closure-vars) &body body) (declare (ignorable trcp)) (let ((syn-id (gensym))(syn-user (gensym))) - `(let* ((,syn-id (eko ("!!! syn-id =") ,synapse-id)) + `(let* ((,syn-id ,synapse-id) (,syn-user (car *c-calculators*)) (synapse (or (find ,syn-id (cd-useds ,syn-user) :key 'c-slot-name) (let ((new-syn (let (,@closure-vars) - (trc "withsyn making new syn" ,syn-id - :known (mapcar 'c-slot-name (cd-useds ,syn-user))) (make-c-dependent :model (c-model ,syn-user) :slot-name ,syn-id

1 0

[cells-cvs] CVS update: cells/cell-types.lisp cells/link.lisp cells/synapse.lisp cells/test.lisp
by ktilton＠common-lisp.net 27 May '05

27 May '05

Update of /project/cells/cvsroot/cells In directory common-lisp.net:/tmp/cvs-serv26417 Modified Files: cell-types.lisp link.lisp synapse.lisp test.lisp Log Message: Remove limitation on number of dependencies one cell can have. Date: Fri May 27 03:34:35 2005 Author: ktilton Index: cells/cell-types.lisp diff -u cells/cell-types.lisp:1.5 cells/cell-types.lisp:1.6 --- cells/cell-types.lisp:1.5 Sat May 21 03:40:53 2005 +++ cells/cell-types.lisp Fri May 27 03:34:34 2005 @@ -78,8 +78,9 @@ (:conc-name cd-)) ;; chop (synapses nil :type list) (useds nil :type list) - (usage (make-array *cd-usagect* :element-type 'bit - :initial-element 0) :type vector)) + (usage (make-array 16 :element-type 'bit + :initial-element 0) :type simple-bit-vector)) + (defstruct (c-stream (:include c-dependent) Index: cells/link.lisp diff -u cells/link.lisp:1.5 cells/link.lisp:1.6 --- cells/link.lisp:1.5 Thu May 26 03:15:50 2005 +++ cells/link.lisp Fri May 27 03:34:34 2005 @@ -22,6 +22,7 @@ (in-package :cells) +#+not (eval-when (compile load) (proclaim '(optimize (speed 3) (safety 0) (space 0) (debug 0)))) @@ -54,68 +55,47 @@ when (eq used known) do (count-it :known-used) - (setf u-pos (1- length)) - finally (return (values u-pos length))) + (setf u-pos length) + finally (return (values (when u-pos (- length u-pos)) length))) (when (null used-pos) (trc nil "c-link > new user,used " user used) (count-it :new-used) - (incf useds-len) - (setf used-pos 0) + (setf used-pos useds-len) ;; 050525kt - wait till eval completes (push user (c-users used)) (push used (cd-useds user))) - (let ((mapn (- *cd-usagect* - (- useds-len used-pos)))) - ;; (trc user "c-link> setting usage bit" user mapn used) - (if (minusp mapn) - (c-break "whoa. more than ~d used by ~a? i see ~d" - *cd-usagect* user (length (cd-useds user))) - (cd-usage-set user mapn)))) + (handler-case + (setf (sbit (cd-usage user) used-pos) 1) + (type-error (error) + (declare (ignorable error)) + (setf (cd-usage user) + (adjust-array (cd-usage user) (+ used-pos 16) :initial-element 0)) + (setf (sbit (cd-usage user) used-pos) 1)))) used) -#+test -(dotimes (used 3) - (print (multiple-value-bind (p l) - (loop with u-pos - for known in '(0 2) - counting known into length - ;; do (print (list :data known length)) - when (eql used known) do (setf u-pos (1- length)) - finally (return (values u-pos length))) - (list p l)))) -#+TEST -(dotimes (n 3) - (trc "mapn" n (get-mapn n '(0 1 2)))) - -(defun get-mapn (seek map) - (declare (fixnum *cd-usagect*)) - (- *cd-usagect* - (loop with seek-pos = nil - for m in map - for pos fixnum upfrom 0 - counting m into m-len fixnum - when (eq seek m) - do (setf seek-pos pos) - finally (return (- m-len seek-pos))))) + + ;--- c-unlink-unused -------------------------------- (defun c-unlink-unused (c &aux (usage (cd-usage c))) - (loop for useds on (cd-useds c) - for used = (car useds) - for mapn upfrom (- *cd-usagect* (length (cd-useds c))) - if (zerop (sbit usage mapn)) - do - (c-assert (not (minusp mapn))) - (c-assert (< mapn *cd-usagect*)) - - (trc nil "dropping unused" used :mapn-usage mapn usage) - (count-it :unlink-unused) - (c-unlink-user used c) - (rplaca useds nil) - else do (pushnew c (c-users used)) ;; 050525 deferred from c-link-ex - ) - (setf (cd-useds c) (delete-if #'null (cd-useds c)))) + (when (cd-useds c) + (let (rev-pos) + (labels ((nail-unused (useds) + (flet ((handle-used (rpos) + (if (zerop (sbit usage rpos)) + (progn + (count-it :unlink-unused) + (c-unlink-user (car useds) c) + (rplaca useds nil)) + (pushnew c (c-users (car useds)))))) + (if (cdr useds) + (progn + (nail-unused (cdr useds)) + (handle-used (incf rev-pos))) + (handle-used (setf rev-pos 0)))))) + (nail-unused (cd-useds c)) + (setf (cd-useds c) (delete-if #'null (cd-useds c))))))) (defun c-user-path-exists-p (from-used to-user) (count-it :user-path-exists-p) @@ -126,13 +106,12 @@ ; --------------------------------------------- -(defun cd-usage-set (c mapn) - (setf (sbit (cd-usage c) mapn) 1)) (defun cd-usage-clear-all (c) - (bit-and (cd-usage c) - #*0000000000000000000000000000000000000000000000000000000000000000 - t)) + (loop with a = (cd-usage c) + for bitn below (array-dimension a 0) + do (setf (sbit a bitn) 0))) + ;--- unlink from used ---------------------- Index: cells/synapse.lisp diff -u cells/synapse.lisp:1.6 cells/synapse.lisp:1.7 --- cells/synapse.lisp:1.6 Thu May 26 03:15:50 2005 +++ cells/synapse.lisp Fri May 27 03:34:34 2005 @@ -48,13 +48,6 @@ (c-value-ensure-current synapse)) (c-link-ex synapse))))) -(defmacro make-synaptic-ruled (syn-pseudo-slot syn-user &body body) - `(make-c-dependent - :model (c-model ,syn-user) - :slot-name ,syn-pseudo-slot - :code ',body - :synaptic t - :rule (c-lambda ,@body))) ;__________________________________________________________________________________ ; Index: cells/test.lisp diff -u cells/test.lisp:1.5 cells/test.lisp:1.6 --- cells/test.lisp:1.5 Thu May 19 22:17:47 2005 +++ cells/test.lisp Fri May 27 03:34:34 2005 @@ -92,6 +92,37 @@ (print `(attempting ,',form)) (assert ,form () "Error with ~a >> ~a" ',form (list ,@stuff)))) +;; test huge number of useds by one rule + +(defmodel m-index (family) + () + (:default-initargs + :md-value (c? (bwhen (ks (^kids)) + (apply '+ (mapcar 'md-value ks)))))) + +(def-cell-test many-useds + (let ((i (make-instance 'm-index))) + (loop for n below 100 + do (push (make-instance 'model + :md-value (c-in n)) + (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

← Newer
1
...
43
44
45
46
47
48
49
...
73
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

2003

cells-cvs