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 () ,@body)))

-(export! with-c-change) +(export! with-c-change with-c-changes)

(defmacro with-c-change (id &body body) `(with-integrity (:change ,id) ,@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)))