[cells-cvs] CVS cells
ktilton
ktilton at common-lisp.net
Sat Nov 4 20:52:01 UTC 2006
Update of /project/cells/cvsroot/cells
In directory clnet:/tmp/cvs-serv30831
Modified Files:
cells.lpr defpackage.lisp family-values.lisp family.lisp
fm-utilities.lisp integrity.lisp test.lisp
Log Message:
md-value -> value
--- /project/cells/cvsroot/cells/cells.lpr 2006/10/17 21:28:39 1.22
+++ /project/cells/cvsroot/cells/cells.lpr 2006/11/04 20:52:01 1.23
@@ -23,11 +23,7 @@
(make-instance 'module :name "md-utilities.lisp")
(make-instance 'module :name "family.lisp")
(make-instance 'module :name "fm-utilities.lisp")
- (make-instance 'module :name "family-values.lisp")
- (make-instance 'module :name
- "doc\\01-Cell-basics.lisp")
- (make-instance 'module :name
- "doc\\motor-control.lisp"))
+ (make-instance 'module :name "family-values.lisp"))
:projects (list (make-instance 'project-module :name
"utils-kt\\utils-kt"))
:libraries nil
--- /project/cells/cvsroot/cells/defpackage.lisp 2006/10/17 21:28:39 1.8
+++ /project/cells/cvsroot/cells/defpackage.lisp 2006/11/04 20:52:01 1.9
@@ -52,7 +52,7 @@
#:defmodel #:defmd #:defobserver #:slot-value-observe #:def-c-unchanged-test
#:new-value #:old-value #:old-value-boundp #:c...
#:md-awaken
- #:mkpart #:make-kid #:the-kids #:nsib #:md-value #:^md-value #:.md-value #:kids #:^kids #:.kids
+ #:mkpart #:make-kid #:the-kids #:nsib #:value #:^value #:.value #:kids #:^kids #:.kids
#:cells-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
--- /project/cells/cvsroot/cells/family-values.lisp 2006/05/20 06:32:19 1.4
+++ /project/cells/cvsroot/cells/family-values.lisp 2006/11/04 20:52:01 1.5
@@ -30,7 +30,7 @@
:reader kv-collector)
(kid-values :initform (c? (when (kv-collector self)
- (funcall (kv-collector self) (^md-value))))
+ (funcall (kv-collector self) (^value))))
:accessor kid-values
:initarg :kid-values)
--- /project/cells/cvsroot/cells/family.lisp 2006/11/03 13:37:10 1.15
+++ /project/cells/cvsroot/cells/family.lisp 2006/11/04 20:52:01 1.16
@@ -19,12 +19,12 @@
(in-package :cells)
(eval-when (:compile-toplevel :execute :load-toplevel)
- (export '(model md-value family kids kid1 ^k1 kid2 ^k2 last-kid ^k-last perishable)))
+ (export '(model value family kids kid1 ^k1 kid2 ^k2 last-kid ^k-last perishable)))
(defmodel model ()
((.md-name :cell nil :initform nil :initarg :md-name :accessor md-name)
(.fm-parent :cell nil :initform nil :initarg :fm-parent :accessor fm-parent)
- (.md-value :initform nil :accessor md-value :initarg :md-value)))
+ (.value :initform nil :accessor value :initarg :value)))
(defmethod fm-parent (other)
@@ -90,6 +90,11 @@
(if (typep ,self ',type) ,self (upper ,self ,type)))))
(defun kid1 (self) (car (kids self)))
+
+(export! first-born-p)
+(defun first-born-p (self)
+ (eq self (kid1 .parent)))
+
(defun kid2 (self) (cadr (kids self)))
(defmacro ^k1 () `(kid1 self))
(defmacro ^k2 () `(kid2 self))
--- /project/cells/cvsroot/cells/fm-utilities.lisp 2006/11/03 13:37:10 1.13
+++ /project/cells/cvsroot/cells/fm-utilities.lisp 2006/11/04 20:52:01 1.14
@@ -403,7 +403,7 @@
(export! fmv)
(defmacro fmv (name)
- `(md-value (fm-other ,name)))
+ `(value (fm-other ,name)))
(defmacro fm-otherx (md-name &key (starting 'self) skip-tree)
(if (eql starting 'self)
@@ -448,7 +448,7 @@
:global-search t)))
(defmacro fm^v (id)
- `(md-value (fm^ ,id)))
+ `(value (fm^ ,id)))
(defmacro fm? (md-name &optional (starting 'self) (global-search t))
`(fm-find-one ,starting ,(if (consp md-name)
@@ -466,7 +466,7 @@
:global-search nil)))
(defmacro fm!v (id)
- `(md-value (fm! ,id)))
+ `(value (fm! ,id)))
(defmacro fm-other?! (md-name &optional (starting 'self))
`(fm-find-one ,starting ,(if (consp md-name)
--- /project/cells/cvsroot/cells/integrity.lisp 2006/10/17 21:28:39 1.14
+++ /project/cells/cvsroot/cells/integrity.lisp 2006/11/04 20:52:01 1.15
@@ -30,12 +30,18 @@
"Invalid second value to with-integrity: ~a" opcode))
`(call-with-integrity ,opcode ,defer-info (lambda () , at body)))
-(export! with-c-change)
+(export! with-c-change with-c-changes)
(defmacro with-c-change (id &body body)
`(with-integrity (:change ,id)
, at body))
+(defmacro with-c-changes (id &rest change-forms)
+ `(with-c-change ,id
+ ,(car change-forms)
+ ,(when (cdr change-forms)
+ `(with-c-changes ,id ,@(cdr change-forms)))))
+
(defun integrity-managed-p ()
*within-integrity*)
@@ -68,6 +74,8 @@
(or (ufb-queue opcode)
(cdr (car (push (cons opcode (make-fifo-queue)) *unfinished-business*)))))
+(defparameter *no-tell* nil)
+
(defun ufb-add (opcode continuation)
(assert (find opcode *ufb-opcodes*))
(when (and *no-tell* (eq opcode :tell-dependents))
@@ -83,7 +91,7 @@
while task
do (trc nil "unfin task is" opcode task)
(funcall task)))
-(defparameter *no-tell* nil)
+
(defun finish-business ()
(when *stop* (return-from finish-business))
(tagbody
--- /project/cells/cvsroot/cells/test.lisp 2006/06/23 01:04:56 1.8
+++ /project/cells/cvsroot/cells/test.lisp 2006/11/04 20:52:01 1.9
@@ -97,16 +97,16 @@
(defmodel m-index (family)
()
(:default-initargs
- :md-value (c? (bwhen (ks (^kids))
- (apply '+ (mapcar 'md-value ks))))))
+ :value (c? (bwhen (ks (^kids))
+ (apply '+ (mapcar '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))
+ :value (c-in n))
(kids i)))
- (trc "index total" (md-value i))))
+ (trc "index total" (value i))))
(defmodel m-null ()
((aa :initform nil :cell nil :initarg :aa :accessor aa)))
More information about the Cells-cvs
mailing list