[cells-cvs] CVS update: cell-cultures/cells/cell-types.lisp cell-cultures/cells/cells.lisp cell-cultures/cells/constructors.lisp cell-cultures/cells/defpackage.lisp cell-cultures/cells/integrity.lisp cell-cultures/cells/md-slot-value.lisp cell-cultures/cells/model-object.lisp cell-cultures/cells/propagate.lisp cell-cultures/cells/synapse.lisp cell-cultures/cells/cells-test.asd cell-cultures/cells/cells-test.lpr cell-cultures/cells/rif.lisp
Kenny Tilton
ktilton at common-lisp.net
Sun Jul 4 18:59:42 UTC 2004
Update of /project/cells/cvsroot/cell-cultures/cells
In directory common-lisp.net:/tmp/cvs-serv5472/cells
Modified Files:
cell-types.lisp cells.lisp constructors.lisp defpackage.lisp
integrity.lisp md-slot-value.lisp model-object.lisp
propagate.lisp synapse.lisp
Removed Files:
cells-test.asd cells-test.lpr rif.lisp
Log Message:
Date: Sun Jul 4 11:59:41 2004
Author: ktilton
Index: cell-cultures/cells/cell-types.lisp
diff -u cell-cultures/cells/cell-types.lisp:1.1 cell-cultures/cells/cell-types.lisp:1.2
--- cell-cultures/cells/cell-types.lisp:1.1 Sat Jun 26 11:38:36 2004
+++ cell-cultures/cells/cell-types.lisp Sun Jul 4 11:59:41 2004
@@ -53,8 +53,8 @@
(defstruct (c-ruled
(:include cell)
(:conc-name cr-))
- (synapses nil :type list)
lazy
+ (code nil :type list) ;; /// feature this out on production build
rule)
(defun c-optimized-away-p (c)
@@ -73,8 +73,8 @@
(defstruct (c-dependent
(:include c-ruled)
(:conc-name cd-))
+ (synapses nil :type list)
(useds nil :type list)
- (code nil :type list) ;; /// feature this out on production build
(usage (make-array *cd-usagect* :element-type 'bit
:initial-element 0) :type vector))
Index: cell-cultures/cells/cells.lisp
diff -u cell-cultures/cells/cells.lisp:1.2 cell-cultures/cells/cells.lisp:1.3
--- cell-cultures/cells/cells.lisp:1.2 Tue Jun 29 01:58:49 2004
+++ cell-cultures/cells/cells.lisp Sun Jul 4 11:59:41 2004
@@ -112,6 +112,7 @@
(declare (ignorable slot-name self new old old-boundp)))
+
; -------- cell conditions (not much used) ---------------------------------------------
(define-condition xcell () ;; new 2k0227
Index: cell-cultures/cells/constructors.lisp
diff -u cell-cultures/cells/constructors.lisp:1.1 cell-cultures/cells/constructors.lisp:1.2
--- cell-cultures/cells/constructors.lisp:1.1 Sat Jun 26 11:38:36 2004
+++ cell-cultures/cells/constructors.lisp Sun Jul 4 11:59:41 2004
@@ -87,7 +87,7 @@
:code ',forms
:value-state :unevaluated
:rule (c-lambda , at forms)
- , at keys))
+ , at keys))
(defmacro c-input ((&rest keys) &optional (value nil valued-p))
`(make-cell
Index: cell-cultures/cells/defpackage.lisp
diff -u cell-cultures/cells/defpackage.lisp:1.3 cell-cultures/cells/defpackage.lisp:1.4
--- cell-cultures/cells/defpackage.lisp:1.3 Wed Jun 30 14:02:47 2004
+++ cell-cultures/cells/defpackage.lisp Sun Jul 4 11:59:41 2004
@@ -38,15 +38,19 @@
#:class-precedence-list #:class-slots #:slot-definition-name
)
-
- (:export #:cell #:c-input #:c-in #:c-in8 #:c? #:c?8 #:c?_ #:c??
+ #+clisp (:import-from #:clos #:class-slots #:class-precedence-list)
+ #+cmu (:import-from #:pcl #:class-precedence-list #:class-slots
+ #:slot-definition-name #:true)
+ #+lispworks (:import-from #:lw #:true)
+ (: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
#:defmodel #:c-awaken #:def-c-output #:def-c-unchanged-test
#:new-value #:old-value #:c...
#:make-be
#:mkpart #:the-kids #:nsib #:md-value #:^md-value #:.md-value #:kids #:^kids #:.kids
- #:cell-reset #:upper #:fm-max #:nearest #:^fm-min-kid #:^fm-max-kid #:mk-kid-slot
+ #:cell-reset #:upper #:fm-max #:nearest #:fm-min-kid #:fm-max-kid #:mk-kid-slot
#:def-kid-slots #:find-prior #:fm-pos #:kid-no #:fm-includes #:fm-ascendant-common
#:fm-kid-containing #:fm-find-if #:fm-ascendant-if #:c-abs #:fm-collect-if #:psib
#:to-be #:not-to-be #:ssibno #:md-awaken
Index: cell-cultures/cells/integrity.lisp
diff -u cell-cultures/cells/integrity.lisp:1.1 cell-cultures/cells/integrity.lisp:1.2
--- cell-cultures/cells/integrity.lisp:1.1 Sat Jun 26 11:38:36 2004
+++ cell-cultures/cells/integrity.lisp Sun Jul 4 11:59:41 2004
@@ -24,6 +24,7 @@
(defun data-pulse-next (pulse-info)
(declare (ignorable pulse-info))
+ (trc nil "data-pulse-next > " (1+ *data-pulse-id*) pulse-info)
(if (< *data-pulse-id* most-positive-fixnum)
(incf *data-pulse-id*)
(progn
@@ -93,7 +94,7 @@
(trc nil "!!!!!!!!!! started new *unfinished-business*" key defer-info)
(when (or (zerop *data-pulse-id*)
(member opcode '(:setf :makunbound)))
- (data-pulse-next defer-info)
+ (data-pulse-next (cons opcode defer-info))
(trc nil "!!! New pulse, event" *data-pulse-id* defer-info))
(prog1
(funcall action)
Index: cell-cultures/cells/md-slot-value.lisp
diff -u cell-cultures/cells/md-slot-value.lisp:1.1 cell-cultures/cells/md-slot-value.lisp:1.2
--- cell-cultures/cells/md-slot-value.lisp:1.1 Sat Jun 26 11:38:36 2004
+++ cell-cultures/cells/md-slot-value.lisp Sun Jul 4 11:59:41 2004
@@ -54,6 +54,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))
(some (lambda (used)
(c-value-ensure-current used)
(when (and (c-changed used) (> (c-pulse used)(c-pulse c)))
Index: cell-cultures/cells/model-object.lisp
diff -u cell-cultures/cells/model-object.lisp:1.1 cell-cultures/cells/model-object.lisp:1.2
--- cell-cultures/cells/model-object.lisp:1.1 Sat Jun 26 11:38:36 2004
+++ cell-cultures/cells/model-object.lisp Sun Jul 4 11:59:41 2004
@@ -96,15 +96,15 @@
(c-model c) self
(c-slot-name c) sn
(md-slot-cell self sn) c))
- (if (c-unboundp c)
- (progn (trc "unbound cell" (type-of c) c)
- (bd-slot-makunbound self sn))
- (setf (slot-value self sn)
- (if c-isa-cell
+
+ (if c-isa-cell
+ (if (c-unboundp c)
+ (bd-slot-makunbound self sn)
+ (setf (slot-value self sn)
(if (c-inputp c)
- (c-value c)
- nil)
- c))))
+ (c-value c)
+ nil)))
+ (setf (slot-value self sn) c)))
;------------------ md obj initialization ------------------
Index: cell-cultures/cells/propagate.lisp
diff -u cell-cultures/cells/propagate.lisp:1.1 cell-cultures/cells/propagate.lisp:1.2
--- cell-cultures/cells/propagate.lisp:1.1 Sat Jun 26 11:38:36 2004
+++ cell-cultures/cells/propagate.lisp Sun Jul 4 11:59:41 2004
@@ -56,15 +56,14 @@
(c-output-slot c (c-slot-name c) (c-model c)
(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 (list* c *causation*))) ;; in case deferred
+ (let ((causation (cons c *causation*))) ;; in case deferred
(with-integrity (:user-notify :user-notify c)
(let ((*causation* causation))
(trc nil "c-propagate-to-users > notifying users of" c)
(dolist (user (c-users c))
- (trc nil "c-propagate-to-users> cause, user, c:" *causation* user c)
+ (trc user "c-propagate-to-users> *data-pulse-id*, user, c:" *data-pulse-id* user c)
(when (c-user-cares user)
(c-value-ensure-current user)))))))
@@ -89,7 +88,7 @@
(c-output-slot nil slot-name self (bd-slot-value self slot-name) nil nil)))
(defun c-output-slot (c slot-name self new-value prior-value prior-value-supplied)
- (let ((causation (list* c *causation*))) ;; in case deferred
+ (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)
Index: cell-cultures/cells/synapse.lisp
diff -u cell-cultures/cells/synapse.lisp:1.1 cell-cultures/cells/synapse.lisp:1.2
--- cell-cultures/cells/synapse.lisp:1.1 Sat Jun 26 11:38:36 2004
+++ cell-cultures/cells/synapse.lisp Sun Jul 4 11:59:41 2004
@@ -28,13 +28,13 @@
(defmacro with-synapse (((&rest closure-vars) &key trcp fire-p fire-value) &body body)
(declare (ignorable trcp))
(let ((lex-loc-key (gensym "synapse-id")))
- `(let ((synapse (or (cdr (assoc ',lex-loc-key (cr-synapses
+ `(let ((synapse (or (cdr (assoc ',lex-loc-key (cd-synapses
(car *c-calculators*))))
(cdar (push (cons ',lex-loc-key
(let (, at closure-vars)
(make-synaptic-ruled slot-c (,fire-p ,fire-value)
, at body)))
- (cr-synapses
+ (cd-synapses
(car *c-calculators*)))))))
(progn ;;let ((*c-calculators* (cons synapse *c-calculators*)))
(c-value-ensure-current synapse)))))
More information about the Cells-cvs
mailing list