cells-cvs

cells-cvs@common-lisp.net

721 discussions

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

08 May '05

Update of /project/cells/cvsroot/cells In directory common-lisp.net:/tmp/cvs-serv3918 Modified Files: md-slot-value.lisp Log Message: Fix great honking bug in md-slot-value, introduced earlier today. Date: Sun May 8 18:47:21 2005 Author: ktilton Index: cells/md-slot-value.lisp diff -u cells/md-slot-value.lisp:1.3 cells/md-slot-value.lisp:1.4 --- cells/md-slot-value.lisp:1.3 Sun May 8 14:42:12 2005 +++ cells/md-slot-value.lisp Sun May 8 18:47:20 2005 @@ -40,16 +40,16 @@ (reset-cells () :report "Reset cells and retry getting the slot value." (cell-reset) - (go retry))))) - - ;; (count-it :md-slot-value slot-name) - (if c - (prog1 - (with-integrity (:md-slot-value) - (c-value-ensure-current c)) - (when (car *c-calculators*) - (c-link-ex c))) - (values (bd-slot-value self slot-name) nil)))) + (go retry)))))) + + ;; (count-it :md-slot-value slot-name) + (if c + (prog1 + (with-integrity (:md-slot-value) + (c-value-ensure-current c)) + (when (car *c-calculators*) + (c-link-ex c))) + (values (bd-slot-value self slot-name) nil))) (defun c-value-ensure-current (c) (count-it :c-value-ensure-current)

1 0

[cells-cvs] CVS update: cl-6502/assembler.lisp cl-6502/cl-6502.lpr cl-6502/hello-165.lisp cl-6502/hello.l65 cl-6502/instructions.lisp cl-6502/package.lisp
by ktilton＠common-lisp.net 08 May '05

08 May '05

Update of /project/cells/cvsroot/cl-6502 In directory common-lisp.net:/tmp/cvs-serv16583 Added Files: assembler.lisp cl-6502.lpr hello-165.lisp hello.l65 instructions.lisp package.lisp Log Message: Introducing James Bielman's 6502 Assembler with Cells Inside(tm). Date: Sun May 8 14:46:56 2005 Author: ktilton

1 0

[cells-cvs] CVS update: Module imported: cl-6502
by ktilton＠common-lisp.net 08 May '05

08 May '05

Update of /project/cells/cvsroot/cl-6502 In directory common-lisp.net:/tmp/cvs-serv15693 Log Message: James Bielman's 6502 Assembler with Cells Inside(tm). Status: Vendor Tag: tcvs-vendor Release Tags: tcvs-release No conflicts created by this import Date: Sun May 8 14:45:03 2005 Author: ktilton New module cl-6502 added

1 0

[cells-cvs] CVS update: cells/cells.lisp cells/constructors.lisp cells/defpackage.lisp cells/integrity.lisp cells/md-slot-value.lisp cells/optimization.lisp cells/propagate.lisp cells/test.lisp
by ktilton＠common-lisp.net 08 May '05

08 May '05

Update of /project/cells/cvsroot/cells In directory common-lisp.net:/tmp/cvs-serv15583 Modified Files: cells.lisp constructors.lisp defpackage.lisp integrity.lisp md-slot-value.lisp optimization.lisp propagate.lisp test.lisp Log Message: Test for *stop*ped Cells. Eliminate *causation*, auto-detection of causal looping. Date: Sun May 8 14:42:13 2005 Author: ktilton Index: cells/cells.lisp diff -u cells/cells.lisp:1.1 cells/cells.lisp:1.2 --- cells/cells.lisp:1.1 Fri May 6 23:05:45 2005 +++ cells/cells.lisp Sun May 8 14:42:12 2005 @@ -30,7 +30,6 @@ (define-constant *c-optimizep* t) (defparameter *c-prop-depth* 0) -(defparameter *causation* nil) (defparameter *data-pulse-id* 0) (defparameter *data-pulses* nil) @@ -88,9 +87,6 @@ (defmacro without-c-dependency (&body body) `(let (*c-calculators*) ,@body)) - -(define-symbol-macro .cause - (car *causation*)) (define-condition unbound-cell (unbound-slot) ()) Index: cells/constructors.lisp diff -u cells/constructors.lisp:1.1 cells/constructors.lisp:1.2 --- cells/constructors.lisp:1.1 Fri May 6 23:05:45 2005 +++ cells/constructors.lisp Sun May 8 14:42:12 2005 @@ -62,7 +62,7 @@ :lazy t :rule (c-lambda ,@body))) -(defmacro c?? ((&key (tagp nil) (in nil) (trigger nil) (out t))&body body) +(defmacro c?? ((&key (tagp nil) (in nil) (out t))&body body) (let ((result (copy-symbol 'result)) (thetag (gensym))) `(make-c-dependent @@ -75,7 +75,6 @@ (declare (ignorable self ,thetag)) ,(when in `(trc "c??> entry" (c-slot-name c) (c-model c) (when ,tagp ,thetag))) - ,(when trigger `(trc "c??> trigger" .cause c)) (count-it :c?? (c-slot-name c) (md-name (c-model c))) (let ((,result (progn ,@body))) ,(when out `(trc "c?? result:" ,result (c-slot-name c) (when ,tagp ,thetag))) Index: cells/defpackage.lisp diff -u cells/defpackage.lisp:1.1 cells/defpackage.lisp:1.2 --- cells/defpackage.lisp:1.1 Fri May 6 23:05:45 2005 +++ cells/defpackage.lisp Sun May 8 14:42:12 2005 @@ -47,7 +47,7 @@ (:export #:cell #:c-input #:c-in #:c-in8 #:c-formula #:c? #:c?8 #:c?_ #:c?? #:with-integrity #:with-deference #:without-c-dependency #:self - #:.cache #:c-lambda #:.cause + #:.cache #:c-lambda #:defmodel #:c-awaken #:def-c-output #:def-c-unchanged-test #:new-value #:old-value #:old-value-boundp #:c... #:make-be Index: cells/integrity.lisp diff -u cells/integrity.lisp:1.1 cells/integrity.lisp:1.2 --- cells/integrity.lisp:1.1 Fri May 6 23:05:45 2005 +++ cells/integrity.lisp Sun May 8 14:42:12 2005 @@ -106,7 +106,7 @@ -(defun finish-business (&aux task some-output setfs (setf-ct 0)) +(defun finish-business (&aux task some-output setfs) (declare (ignorable setfs)) (assert (ufb-queue :user-notify)) (assert (consp (ufb-queue :user-notify))) @@ -141,16 +141,11 @@ ; --- do deferred setfs ------------------------ (setf task (fifo-pop (ufb-queue :setf))) (when task - (incf setf-ct) (destructuring-bind ((c new-value) . task-fn) task (trc nil "finbiz: deferred setf" c new-value) - (if (find c *causation*) - (break "setf looping setting ~a to ~a with history ~a" - c new-value *causation*) - (progn - (push c setfs) - (data-pulse-next (list :finbiz c new-value)) - (funcall task-fn)))) + (push c setfs) + (data-pulse-next (list :finbiz c new-value)) + (funcall task-fn)) (go notify-users)) ; --- do finalizations ------------------------ Index: cells/md-slot-value.lisp diff -u cells/md-slot-value.lisp:1.2 cells/md-slot-value.lisp:1.3 --- cells/md-slot-value.lisp:1.2 Sun May 8 01:12:40 2005 +++ cells/md-slot-value.lisp Sun May 8 14:42:12 2005 @@ -22,19 +22,34 @@ (in-package :cells) +(defparameter *ide-app-hard-to-kill* nil) (defun md-slot-value (self slot-name &aux (c (md-slot-cell self slot-name))) - (when *stop* - (princ #\.) - (return-from md-slot-value)) - ;; (count-it :md-slot-value slot-name) - (if c - (prog1 - (with-integrity (:md-slot-value) - (c-value-ensure-current c)) - (when (car *c-calculators*) - (c-link-ex c))) - (values (bd-slot-value self slot-name) nil))) + (tagbody + retry + (when *stop* + (if *ide-app-hard-to-kill* + (progn + (princ #\.) + (return-from md-slot-value)) + (restart-case + (error "Cells is stopped due to a prior error.") + (continue () + :report "Return a slot value of nil." + (return-from md-slot-value nil)) + (reset-cells () + :report "Reset cells and retry getting the slot value." + (cell-reset) + (go retry))))) + + ;; (count-it :md-slot-value slot-name) + (if c + (prog1 + (with-integrity (:md-slot-value) + (c-value-ensure-current c)) + (when (car *c-calculators*) + (c-link-ex c))) + (values (bd-slot-value self slot-name) nil)))) (defun c-value-ensure-current (c) (count-it :c-value-ensure-current) @@ -123,10 +138,8 @@ (when (eql '.kids (c-slot-name c)) (md-kids-change (c-model c) nil prior-value :makunbound)) - (let ((causation *causation*)) - (with-integrity (:makunbound :makunbound c) - (let ((*causation* causation)) - (c-propagate c prior-value t))))))) + (with-integrity (:makunbound :makunbound c) + (c-propagate c prior-value t))))) (defun (setf md-slot-value) (new-value self slot-name @@ -137,26 +150,13 @@ (when *c-debug* (c-setting-debug self slot-name c new-value)) - (if c - (when (find c *causation*) - (case (c-cyclicp c) - (:run-on (trc "cyclicity running on" c)) - ((t) - (progn - (trc "cyclicity handled gracefully" c) - (c-pulse-update c :cyclicity-1) - (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))) + (unless c + (c-break "(setf md-slot-value)> cellular slot ~a of ~a cannot be setf unless initialized as inputp" + slot-name self)) - (let ((causation *causation*)) - (with-integrity (:setf :setf c new-value) - (let ((*causation* causation)) - (trc nil "(setf md-slot-value) calling assume" c new-value) - (md-slot-value-assume c new-value)))) + (with-integrity (:setf :setf c new-value) + (trc nil "(setf md-slot-value) calling assume" c new-value) + (md-slot-value-assume c new-value)) new-value) @@ -164,13 +164,6 @@ (defmethod md-slot-value-assume (c raw-value) (assert c) - (bif (c-pos (position c *causation*)) - (bif (cyclic-pos (position-if 'c-cyclicp *causation* :end c-pos)) - (progn - (c-pulse-update c :cyclicity-0) - (return-from md-slot-value-assume raw-value)) - (c-break "md-slot-value-assume looping ~a ~a" c *causation*))) - (without-c-dependency (let ((prior-state (c-value-state c)) (prior-value (c-value c)) Index: cells/optimization.lisp diff -u cells/optimization.lisp:1.2 cells/optimization.lisp:1.3 --- cells/optimization.lisp:1.2 Sun May 8 01:12:40 2005 +++ cells/optimization.lisp Sun May 8 14:42:12 2005 @@ -34,7 +34,7 @@ (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) - (every (lambda (syn) (null (cd-useds syn))) (cd-synapses c)) + (every (lambda (lbl-syn) (null (cd-useds (cdr lbl-syn)))) (cd-synapses c)) (null (cd-useds c))) (progn Index: cells/propagate.lisp diff -u cells/propagate.lisp:1.2 cells/propagate.lisp:1.3 --- cells/propagate.lisp:1.2 Sun May 8 01:12:40 2005 +++ cells/propagate.lisp Sun May 8 14:42:12 2005 @@ -57,11 +57,10 @@ (c-value c) prior-value prior-value-supplied))) (defun c-propagate-to-users (c) - (trc nil "c-propagate-to-users > queueing" c :cause *causation*) - (let ((causation (cons c *causation*))) ;; in case deferred - (with-integrity (:user-notify :user-notify c) + (trc nil "c-propagate-to-users > queueing" c) + (with-integrity (:user-notify :user-notify c) (assert (null *c-calculators*)) - (let ((*causation* causation)) + (progn (trc nil "c-propagate-to-users > notifying users of" c) (dolist (user (c-users c)) (bwhen (dead (catch :mdead @@ -72,7 +71,7 @@ (when (eq dead (c-model c)) (trc nil "!!! aborting further user prop of dead" dead) (return-from c-propagate-to-users)) - (trc nil "!!! continuing user prop following: user => dead" user dead))))))) + (trc nil "!!! continuing user prop following: user => dead" user dead)))))) (defun c-user-cares (c) (not (or (c-currentp c) @@ -82,18 +81,15 @@ (getf (symbol-plist slot-name) :output-defined)) (defun c-output-slot (c slot-name self new-value prior-value prior-value-supplied) - (let ((causation *causation*)) ;; in case deferred - (with-integrity (:c-output-slot :output c) - (let ((*causation* causation)) - (trc nil "c-output-slot > causation" c *causation* causation) - (trc nil "c-output-slot > now!!" self slot-name new-value prior-value) - (count-it :output slot-name) - (c-output-slot-name slot-name - self - new-value - prior-value - prior-value-supplied) - (c-ephemeral-reset c))))) + (with-integrity (:c-output-slot :output c) + (trc nil "c-output-slot > now!!" self slot-name new-value prior-value) + (count-it :output slot-name) + (c-output-slot-name slot-name + self + new-value + prior-value + prior-value-supplied) + (c-ephemeral-reset c))) (defun c-ephemeral-reset (c) (when c Index: cells/test.lisp diff -u cells/test.lisp:1.2 cells/test.lisp:1.3 --- cells/test.lisp:1.2 Sun May 8 01:12:41 2005 +++ cells/test.lisp Sun May 8 14:42:12 2005 @@ -54,6 +54,7 @@ `(progn (pushnew ',name *cell-tests*) (defun ,name () + (cell-reset) ,@body))) (defmacro ct-assert (form &rest stuff) @@ -100,6 +101,56 @@ (ct-assert (null (m-ephem-b m))) (ct-assert (eql 6 (m-test-b m))) )) + +(defmodel m-cyc () + ((m-cyc-a :initform (c-in nil) :initarg :m-cyc-a :accessor m-cyc-a) + (m-cyc-b :initform (c-in nil) :initarg :m-cyc-b :accessor m-cyc-b))) + +(def-c-output m-cyc-a () + (print `(output m-cyc-a ,self ,new-value ,old-value)) + (setf (m-cyc-b self) new-value)) + +(def-c-output m-cyc-b () + (print `(output m-cyc-b ,self ,new-value ,old-value)) + (setf (m-cyc-a self) new-value)) + +(defun m-cyc () ;;def-cell-test m-cyc + (let ((m (make-be 'm-cyc))) + (print `(start ,(m-cyc-a m))) + (setf (m-cyc-a m) 42) + (assert (= (m-cyc-a m) 42)) + (assert (= (m-cyc-b m) 42)))) + +#+test +(m-cyc) + +(defmodel m-cyc2 () + ((m-cyc2-a :initform (c-in 0) :initarg :m-cyc2-a :accessor m-cyc2-a) + (m-cyc2-b :initform (c? (1+ (^m-cyc2-a))) + :initarg :m-cyc2-b :accessor m-cyc2-b))) + +(def-c-output m-cyc2-a () + (print `(output m-cyc2-a ,self ,new-value ,old-value)) + #+not (when (< new-value 45) + (setf (m-cyc2-b self) (1+ new-value)))) + +(def-c-output m-cyc2-b () + (print `(output m-cyc2-b ,self ,new-value ,old-value)) + (when (< new-value 45) + (setf (m-cyc2-a self) (1+ new-value)))) + +(def-cell-test m-cyc2 + (cell-reset) + (let ((m (make-be 'm-cyc2))) + (print '(start)) + (setf (m-cyc2-a m) 42) + (describe m) + (assert (= (m-cyc2-a m) 44)) + (assert (= (m-cyc2-b m) 45)) + )) + +#+test +(m-cyc2) (defmodel m-var () ((m-var-a :initform nil :initarg :m-var-a :accessor m-var-a)

1 0

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

08 May '05

Update of /project/cells/cvsroot/cells/utils-kt In directory common-lisp.net:/tmp/cvs-serv14384/utils-kt Modified Files: utils-kt.lpr Log Message: Have slot-value reset to nil as well as c-value, on c-ephemeral-reset Date: Sun May 8 01:12:44 2005 Author: ktilton Index: cells/utils-kt/utils-kt.lpr diff -u cells/utils-kt/utils-kt.lpr:1.1 cells/utils-kt/utils-kt.lpr:1.2 --- cells/utils-kt/utils-kt.lpr:1.1 Fri May 6 23:05:56 2005 +++ cells/utils-kt/utils-kt.lpr Sun May 8 01:12:44 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] (May 6, 2005 8:25)"; cg: "1.54.2.17"; -*- (in-package :cg-user)

1 0

[cells-cvs] CVS update: cells/cell-types.lisp cells/cells.lpr cells/defmodel.lisp cells/md-slot-value.lisp cells/optimization.lisp cells/propagate.lisp cells/synapse.lisp cells/test.lisp
by ktilton＠common-lisp.net 08 May '05

08 May '05

Update of /project/cells/cvsroot/cells In directory common-lisp.net:/tmp/cvs-serv14384 Modified Files: cell-types.lisp cells.lpr defmodel.lisp md-slot-value.lisp optimization.lisp propagate.lisp synapse.lisp test.lisp Log Message: Have slot-value reset to nil as well as c-value, on c-ephemeral-reset Date: Sun May 8 01:12:41 2005 Author: ktilton Index: cells/cell-types.lisp diff -u cells/cell-types.lisp:1.1 cells/cell-types.lisp:1.2 --- cells/cell-types.lisp:1.1 Fri May 6 23:05:45 2005 +++ cells/cell-types.lisp Sun May 8 01:12:40 2005 @@ -136,8 +136,6 @@ (defmethod c-useds (other) (declare (ignore other))) (defmethod c-useds ((c c-dependent)) (cd-useds c)) - - (defun c-validp (c) (eql (c-value-state c) :valid)) Index: cells/cells.lpr diff -u cells/cells.lpr:1.1 cells/cells.lpr:1.2 --- cells/cells.lpr:1.1 Fri May 6 23:05:45 2005 +++ cells/cells.lpr Sun May 8 01:12:40 2005 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "7.0 [Windows] (Dec 28, 2004 17:34)"; cg: "1.54.2.17"; -*- +;; -*- lisp-version: "7.0 [Windows] (May 6, 2005 8:25)"; cg: "1.54.2.17"; -*- (in-package :cg-user) @@ -46,7 +46,7 @@ :old-space-size 256000 :new-space-size 6144 :runtime-build-option :standard - :on-initialization 'cells::cv-test + :on-initialization 'cells::test-cells :on-restart 'do-default-restart) ;; End of Project Definition Index: cells/defmodel.lisp diff -u cells/defmodel.lisp:1.1 cells/defmodel.lisp:1.2 --- cells/defmodel.lisp:1.1 Fri May 6 23:05:45 2005 +++ cells/defmodel.lisp Sun May 8 01:12:40 2005 @@ -60,7 +60,7 @@ ; ------- defclass --------------- (^slot-value ,model ',',slotname) ; - (prog1 + (progn (defclass ,class ,(or directsupers '(model-object));; now we can def the class ,(mapcar (lambda (s) (list* (car s) @@ -123,5 +123,5 @@ ) )) )) - slotspecs)))) - + slotspecs) + (find-class ',class)))) Index: cells/md-slot-value.lisp diff -u cells/md-slot-value.lisp:1.1 cells/md-slot-value.lisp:1.2 --- cells/md-slot-value.lisp:1.1 Fri May 6 23:05:45 2005 +++ cells/md-slot-value.lisp Sun May 8 01:12:40 2005 @@ -56,7 +56,7 @@ (defun c-influenced-by-pulse (c); &aux (ip *data-pulse-id*)) (unless (c-currentp c) (count-it :c-influenced-by-pulse) - (trc c "c-influenced-by-pulse> " c (c-useds c)) + (trc nil "c-influenced-by-pulse> " c (c-useds c)) (some (lambda (used) (c-value-ensure-current used) (when (and (c-changed used) (> (c-pulse used)(c-pulse c))) @@ -209,4 +209,4 @@ absorbed-value))) - \ No newline at end of file + Index: cells/optimization.lisp diff -u cells/optimization.lisp:1.1 cells/optimization.lisp:1.2 --- cells/optimization.lisp:1.1 Fri May 6 23:05:45 2005 +++ cells/optimization.lisp Sun May 8 01:12:40 2005 @@ -34,6 +34,7 @@ (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) + (every (lambda (syn) (null (cd-useds syn))) (cd-synapses c)) (null (cd-useds c))) (progn Index: cells/propagate.lisp diff -u cells/propagate.lisp:1.1 cells/propagate.lisp:1.2 --- cells/propagate.lisp:1.1 Fri May 6 23:05:45 2005 +++ cells/propagate.lisp Sun May 8 01:12:40 2005 @@ -99,6 +99,7 @@ (when c (when (c-ephemeral-p c) (trc nil "!!!!!!!!!!!!!! c-ephemeral-reset resetting:" c) + (md-slot-value-store (c-model c) (c-slot-name c) nil) (setf (c-value c) nil)))) ;; good q: what does (setf <ephem> 'x) return? historically nil, but...? ;----------------- change detection --------------------------------- Index: cells/synapse.lisp diff -u cells/synapse.lisp:1.1 cells/synapse.lisp:1.2 --- cells/synapse.lisp:1.1 Fri May 6 23:05:45 2005 +++ cells/synapse.lisp Sun May 8 01:12:40 2005 @@ -48,12 +48,14 @@ :synaptic t :rule (c-lambda-var (,c-var) (let ((,new-value (progn ,@body))) - (trc nil "generic synaptic rule sees body value" ,c-var ,new-value) + (trc "generic synaptic rule sees body value" ,c-var ,new-value) (if ,(if fire-p `(funcall ,fire-p ,c-var ,new-value) t) (progn - (trc nil "Synapse fire YES!!" ,c-var) + (trc "Synapse fire YES!!" ,c-var) (funcall ,fire-value ,c-var ,new-value)) - .cache)))))) + (progn + (trc "Synapse fire NO!! use cache" .cache) + .cache))))))) ;__________________________________________________________________________________ ; Index: cells/test.lisp diff -u cells/test.lisp:1.1 cells/test.lisp:1.2 --- cells/test.lisp:1.1 Fri May 6 23:05:45 2005 +++ cells/test.lisp Sun May 8 01:12:41 2005 @@ -71,6 +71,36 @@ (ct-assert (= 21 (aa m))) :okay-m-null)) +(defmodel m-ephem () + ((m-ephem-a :cell :ephemeral :initform nil :initarg :m-ephem-a :accessor m-ephem-a) + (m-test-a :cell nil :initform nil :initarg :m-test-a :accessor m-test-a) + (m-ephem-b :cell :ephemeral :initform nil :initarg :m-ephem-b :accessor m-ephem-b) + (m-test-b :cell nil :initform nil :initarg :m-test-b :accessor m-test-b))) + +(def-c-output m-ephem-a () + (setf (m-test-a self) new-value)) + +(def-c-output m-ephem-b () + (setf (m-test-b self) new-value)) + +(def-cell-test m-ephem + (let ((m (make-be 'm-ephem :m-ephem-a (c-in nil) :m-ephem-b (c? (* 2 (or (^m-ephem-a) 0)))))) + (ct-assert (null (slot-value m 'm-ephem-a))) + (ct-assert (null (m-ephem-a m))) + (ct-assert (null (m-test-a m))) + (ct-assert (null (slot-value m 'm-ephem-b))) + (ct-assert (null (m-ephem-b m))) + (ct-assert (zerop (m-test-b m))) + (setf (m-ephem-a m) 3) + (ct-assert (null (slot-value m 'm-ephem-a))) + (ct-assert (null (m-ephem-a m))) + (ct-assert (eql 3 (m-test-a m))) + ; + (ct-assert (null (slot-value m 'm-ephem-b))) + (ct-assert (null (m-ephem-b m))) + (ct-assert (eql 6 (m-test-b m))) + )) + (defmodel m-var () ((m-var-a :initform nil :initarg :m-var-a :accessor m-var-a) (m-var-b :initform nil :initarg :m-var-b :accessor m-var-b)))

1 0

[cells-cvs] CVS update: cell-cultures/utils-kt/debug.lisp cell-cultures/utils-kt/defpackage.lisp cell-cultures/utils-kt/detritus.lisp cell-cultures/utils-kt/flow-control.lisp cell-cultures/utils-kt/quad.lisp cell-cultures/utils-kt/strings.lisp cell-cultures/utils-kt/utils-kt.asd cell-cultures/utils-kt/utils-kt.lpr
by ktilton＠common-lisp.net 06 May '05

06 May '05

Update of /project/cells/cvsroot/cell-cultures/utils-kt In directory common-lisp.net:/tmp/cvs-serv15540/utils-kt Removed Files: debug.lisp defpackage.lisp detritus.lisp flow-control.lisp quad.lisp strings.lisp utils-kt.asd utils-kt.lpr Log Message: Establish Cells II (aka Cells 2.0, aka Cells) as Cells module in Cells project CVS tree Date: Fri May 6 23:18:36 2005 Author: ktilton

1 0

[cells-cvs] CVS update: cell-cultures/hello-c/hello-c.lpr
by ktilton＠common-lisp.net 06 May '05

06 May '05

Update of /project/cells/cvsroot/cell-cultures/hello-c In directory common-lisp.net:/tmp/cvs-serv15540/hello-c Modified Files: hello-c.lpr Log Message: Establish Cells II (aka Cells 2.0, aka Cells) as Cells module in Cells project CVS tree Date: Fri May 6 23:18:30 2005 Author: ktilton Index: cell-cultures/hello-c/hello-c.lpr diff -u cell-cultures/hello-c/hello-c.lpr:1.2 cell-cultures/hello-c/hello-c.lpr:1.3 --- cell-cultures/hello-c/hello-c.lpr:1.2 Wed Apr 6 20:06:22 2005 +++ cell-cultures/hello-c/hello-c.lpr Fri May 6 23:18:30 2005 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "7.0 [Windows] (Dec 28, 2004 17:34)"; cg: "1.54.2.17"; -*- +;; -*- lisp-version: "7.0 [Windows] (Apr 6, 2005 17:03)"; cg: "1.54.2.17"; -*- (in-package :cg-user)

1 0

[cells-cvs] CVS update: cell-cultures/cl-openal/cl-openal-demo.lisp cell-cultures/cl-openal/cl-openal.lisp cell-cultures/cl-openal/cl-openal.lpr
by ktilton＠common-lisp.net 06 May '05

06 May '05

Update of /project/cells/cvsroot/cell-cultures/cl-openal In directory common-lisp.net:/tmp/cvs-serv15540/cl-openal Modified Files: cl-openal-demo.lisp cl-openal.lisp cl-openal.lpr Log Message: Establish Cells II (aka Cells 2.0, aka Cells) as Cells module in Cells project CVS tree Date: Fri May 6 23:18:23 2005 Author: ktilton Index: cell-cultures/cl-openal/cl-openal-demo.lisp diff -u cell-cultures/cl-openal/cl-openal-demo.lisp:1.1 cell-cultures/cl-openal/cl-openal-demo.lisp:1.2 --- cell-cultures/cl-openal/cl-openal-demo.lisp:1.1 Sat Jun 26 20:38:40 2004 +++ cell-cultures/cl-openal/cl-openal-demo.lisp Fri May 6 23:18:23 2005 @@ -4,7 +4,7 @@ (defparameter g-buffers (fgn-alloc 'al-uint num_buffers)) (defun cl-openal-test () - (let ((w$ (list "/dvl/sounds/click2.wav" ))) + (let ((w$ (list "/cell-cultures/cell-cultures-user/sounds/click2.wav" ))) (apply 'wav-play-till-end (lambda (dur sources) (loop for source in sources Index: cell-cultures/cl-openal/cl-openal.lisp diff -u cell-cultures/cl-openal/cl-openal.lisp:1.2 cell-cultures/cl-openal/cl-openal.lisp:1.3 --- cell-cultures/cl-openal/cl-openal.lisp:1.2 Thu Oct 28 02:09:25 2004 +++ cell-cultures/cl-openal/cl-openal.lisp Fri May 6 23:18:23 2005 @@ -41,14 +41,6 @@ (in-package :cl-openal) -(defparameter *al-dynamic-lib* :unconfigured) -(defparameter *alut-dynamic-lib* :unconfigured) -(defparameter *audio-files* :unconfigured) - -(eval-when (compile load) - (load (merge-pathnames "cl-openal-config" - cl-user::*cell-cultures-config*))) - #+doit (xoa) Index: cell-cultures/cl-openal/cl-openal.lpr diff -u cell-cultures/cl-openal/cl-openal.lpr:1.2 cell-cultures/cl-openal/cl-openal.lpr:1.3 --- cell-cultures/cl-openal/cl-openal.lpr:1.2 Fri Apr 8 11:11:18 2005 +++ cell-cultures/cl-openal/cl-openal.lpr Fri May 6 23:18:23 2005 @@ -1,11 +1,12 @@ -;; -*- lisp-version: "7.0 [Windows] (Dec 28, 2004 17:34)"; cg: "1.54.2.17"; -*- +;; -*- lisp-version: "7.0 [Windows] (Apr 6, 2005 17:03)"; cg: "1.54.2.17"; -*- (in-package :cg-user) (defpackage :CL-OPENAL) (define-project :name :cl-openal - :modules (list (make-instance 'module :name "cl-openal.lisp") + :modules (list (make-instance 'module :name "cl-openal-config.lisp") + (make-instance 'module :name "cl-openal.lisp") (make-instance 'module :name "altypes.lisp") (make-instance 'module :name "al.lisp") (make-instance 'module :name "alctypes.lisp")

1 0

[cells-cvs] CVS update: cell-cultures/cells/cells.lpr cell-cultures/cells/defmodel.lisp cell-cultures/cells/md-slot-value.lisp cell-cultures/cells/optimization.lisp cell-cultures/cells/synapse-types.lisp cell-cultures/cells/synapse.lisp
by ktilton＠common-lisp.net 06 May '05

06 May '05

Update of /project/cells/cvsroot/cell-cultures/cells In directory common-lisp.net:/tmp/cvs-serv15540/cells Modified Files: cells.lpr defmodel.lisp md-slot-value.lisp optimization.lisp synapse-types.lisp synapse.lisp Log Message: Establish Cells II (aka Cells 2.0, aka Cells) as Cells module in Cells project CVS tree Date: Fri May 6 23:18:16 2005 Author: ktilton Index: cell-cultures/cells/cells.lpr diff -u cell-cultures/cells/cells.lpr:1.3 cell-cultures/cells/cells.lpr:1.4 --- cell-cultures/cells/cells.lpr:1.3 Fri Apr 8 11:11:12 2005 +++ cell-cultures/cells/cells.lpr Fri May 6 23:18:15 2005 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "7.0 [Windows] (Dec 28, 2004 17:34)"; cg: "1.54.2.17"; -*- +;; -*- lisp-version: "7.0 [Windows] (May 6, 2005 8:25)"; cg: "1.54.2.17"; -*- (in-package :cg-user) Index: cell-cultures/cells/defmodel.lisp diff -u cell-cultures/cells/defmodel.lisp:1.3 cell-cultures/cells/defmodel.lisp:1.4 --- cell-cultures/cells/defmodel.lisp:1.3 Wed Sep 29 04:50:13 2004 +++ cell-cultures/cells/defmodel.lisp Fri May 6 23:18:15 2005 @@ -22,6 +22,7 @@ (in-package :cells) + (defmacro defmodel (class directsupers slotspecs &rest options) ;;(print `(defmodel sees directsupers ,directsupers using ,(or directsupers :model-object))) `(progn @@ -59,7 +60,7 @@ ; ------- defclass --------------- (^slot-value ,model ',',slotname) ; - (prog1 + (progn (defclass ,class ,(or directsupers '(model-object));; now we can def the class ,(mapcar (lambda (s) (list* (car s) @@ -121,5 +122,6 @@ ) )) )) - slotspecs)))) + slotspecs) + (find-class ',class)))) Index: cell-cultures/cells/md-slot-value.lisp diff -u cell-cultures/cells/md-slot-value.lisp:1.6 cell-cultures/cells/md-slot-value.lisp:1.7 --- cell-cultures/cells/md-slot-value.lisp:1.6 Fri Apr 8 11:11:12 2005 +++ cell-cultures/cells/md-slot-value.lisp Fri May 6 23:18:15 2005 @@ -56,7 +56,7 @@ (defun c-influenced-by-pulse (c); &aux (ip *data-pulse-id*)) (unless (c-currentp c) (count-it :c-influenced-by-pulse) - (trc c "c-influenced-by-pulse> " c (c-useds c)) + (trc nil "c-influenced-by-pulse> " c (c-useds c)) (some (lambda (used) (c-value-ensure-current used) (when (and (c-changed used) (> (c-pulse used)(c-pulse c))) Index: cell-cultures/cells/optimization.lisp diff -u cell-cultures/cells/optimization.lisp:1.2 cell-cultures/cells/optimization.lisp:1.3 --- cell-cultures/cells/optimization.lisp:1.2 Sun Dec 5 05:50:32 2004 +++ cell-cultures/cells/optimization.lisp Fri May 6 23:18:15 2005 @@ -34,6 +34,7 @@ (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) + (every (lambda (syn) (null (cd-useds syn))) (cd-synapses c)) (null (cd-useds c))) (progn Index: cell-cultures/cells/synapse-types.lisp diff -u cell-cultures/cells/synapse-types.lisp:1.2 cell-cultures/cells/synapse-types.lisp:1.3 --- cell-cultures/cells/synapse-types.lisp:1.2 Wed Sep 29 04:50:13 2004 +++ cell-cultures/cells/synapse-types.lisp Fri May 6 23:18:15 2005 @@ -52,16 +52,17 @@ last-relay-basis (delta-identity new-basis ',type)) ',type))) - (trc "tdelta, threshhold" ,tdelta ,threshold) + (trc nil "tdelta, threshhold" ,tdelta ,threshold) (setf delta-cum ,tdelta) - (eko ("delta fire-p") + (eko (nil "delta fire-p") (or (null ,threshold) (delta-exceeds ,tdelta ,threshold ',type))))) :fire-value (lambda (syn new-basis) (declare (ignorable syn)) - (trc "f-delta fire-value gets" delta-cum new-basis syn) - (trc "fdelta > new lastrelay" syn last-relay-basis) + (trc nil "f-delta fire-value gets" delta-cum new-basis syn) + (trc nil "fdelta > new lastrelay" syn last-relay-basis) + (trc "f-delta fire-value" delta-cum) (setf last-bound-p t) (setf last-relay-basis new-basis) delta-cum)) Index: cell-cultures/cells/synapse.lisp diff -u cell-cultures/cells/synapse.lisp:1.3 cell-cultures/cells/synapse.lisp:1.4 --- cell-cultures/cells/synapse.lisp:1.3 Wed Sep 29 04:50:13 2004 +++ cell-cultures/cells/synapse.lisp Fri May 6 23:18:16 2005 @@ -31,11 +31,11 @@ `(let ((synapse (or (cdr (assoc ',lex-loc-key (cd-synapses (car *c-calculators*)))) (cdar (push (cons ',lex-loc-key - (let (,@closure-vars) - (make-synaptic-ruled slot-c (,fire-p ,fire-value) - ,@body))) - (cd-synapses - (car *c-calculators*))))))) + (let (,@closure-vars) + (make-synaptic-ruled slot-c (,fire-p ,fire-value) + ,@body))) + (cd-synapses + (car *c-calculators*))))))) (c-value-ensure-current synapse)))) (defmacro make-synaptic-ruled (syn-user (fire-p fire-value) &body body) @@ -48,12 +48,14 @@ :synaptic t :rule (c-lambda-var (,c-var) (let ((,new-value (progn ,@body))) - (trc nil "generic synaptic rule sees body value" ,c-var ,new-value) + (trc "generic synaptic rule sees body value" ,c-var ,new-value) (if ,(if fire-p `(funcall ,fire-p ,c-var ,new-value) t) (progn - (trc nil "Synapse fire YES!!" ,c-var) + (trc "Synapse fire YES!!" ,c-var) (funcall ,fire-value ,c-var ,new-value)) - .cache)))))) + (progn + (trc "Synapse fire NO!! use cache" .cache) + .cache))))))) ;__________________________________________________________________________________ ;

1 0

← Newer
1
...
45
46
47
48
49
50
51
...
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