md-value -> value

cells-test/test-family.lisp

@@ -129,26 +129,26 @@
                                        (eko ("kidnos")(when (numberp mdv)
                                          (loop for kn from 1 to (floor mdv)
                                               collecting kn))))
-                        :md-value (c-in 5)
-                        :kv-key #'md-value
+                        :value (c-in 5)
+                        :kv-key #'value
                         :kid-factory (lambda (f kv)
                                       (incf kf-calls)
                                       (trc "making kid" kv)
                                       (make-instance 'bottle
                                         :fm-parent f
-                                        :md-value kv
+                                        :value kv
                                         :label (c? (format nil "bottle ~d out of ~d on the wall"
-                                                       (^md-value)
+                                                       (^value)
                                                        (length (kids f)))))))))
     (ct-assert (eql 5 kf-calls))
 
     (setq kf-calls 0)
-    (decf (md-value wall))
+    (decf (value wall))
     (ct-assert (eql 4 (length (kids wall))))
     (ct-assert (zerop kf-calls))
 
     (setq kf-calls 0)
-    (incf (md-value wall))
+    (incf (value wall))
     (ct-assert (eql 5 (length (kids wall))))
     (ct-assert (eql 1 kf-calls))
 

cells-test/test.lisp

@@ -99,19 +99,19 @@ subclass for them?)
 ;; test huge number of useds by one rule
 
 (defmd m-index (family)
-  :md-value (c? (bwhen (ks (^kids))
-                  ;(trc "chya" (mapcar 'md-value ks))
-                  (apply '+ (mapcar 'md-value ks)))))
+  :value (c? (bwhen (ks (^kids))
+                  ;(trc "chya" (mapcar 'value ks))
+                  (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
                      :fm-parent i
-                     :md-value (c-in n))
+                     :value (c-in n))
                (kids i)))
-      (trc "index total" (md-value i))
-      (ct-assert (= 4950 (md-value i)))))
+      (trc "index total" (value i))
+      (ct-assert (= 4950 (value i)))))
 
 #+test
 (many-useds)

cells.lpr

@@ -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

defpackage.lisp

@@ -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

doc/01-Cell-basics.lisp

@@ -309,10 +309,10 @@ the family class and its slot kids. every model-object has a
 parent slot, which gets used along with a family's kids slot to
 form simple trees navigable up and down.
 
-model-objects also have slots for md-name and md-value (don't
+model-objects also have slots for md-name and value (don't
 worry camelcase-haters, that is a declining feature of my code).
 md-name lets the family trees we build be treated as namespaces.
-md-value just turns out to be very handy for a lot of things. for
+value just turns out to be very handy for a lot of things. for
 example, a check-box instance needs some place to indicate its 
 boolean state. 
 
@@ -323,7 +323,7 @@ it happens transparently, following the dataflow implicit in the
 rules we write, and the side-effects we specify via observer functions.
 
 the silly example below just shows the summer (that which sums) getting
-a new md-value as the kids change, along with some observer output. in real-world 
+a new value as the kids change, along with some observer output. in real-world 
 applications, where kids represent gui elements often dependent on
 each other, vastly more can transpire before a simple push into a kids
 slot has run its course.
@@ -335,15 +335,15 @@ evaluate:
   ()
   (:default-initargs
       :kids (c-in nil) ;; or we cannot add any addend kids later
-    :md-value (c? (reduce #'+ (kids self)
+    :value (c? (reduce #'+ (kids self)
                    :initial-value 0
-                   :key #'md-value))))
+                   :key #'value))))
 
-(defobserver md-value ((self summer))
+(defobserver value ((self summer))
   (trc "the sum of the values of the kids is" new-value))
 
 (defobserver .kids ((self summer))
-  (trc "the values of the kids are" (mapcar #'md-value new-value)))
+  (trc "the values of the kids are" (mapcar #'value new-value)))
 
 ;-----------------------------------------------------------
 ; now just evaluate each of the following forms one by one,
@@ -364,7 +364,7 @@ observe:
 
 (push (make-instance 'model
         :fm-parent *f1*
-        :md-value 1) (kids *f1*))
+        :value 1) (kids *f1*))
 
 #| observe:
 0> the values of the kids are (1)
@@ -376,7 +376,7 @@ observe:
 
 (push (make-instance 'model
         :fm-parent *f1*
-        :md-value 2) (kids *f1*))
+        :value 2) (kids *f1*))
 
 #| observe:
 0> the values of the kids are (2 1)

family-values.lisp

@@ -30,7 +30,7 @@ See the Lisp Lesser GNU Public License for more details.
      :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)
 

family.lisp

@@ -19,12 +19,12 @@ See the Lisp Lesser GNU Public License for more details.
 (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 @@ See the Lisp Lesser GNU Public License for more details.
        (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))

fm-utilities.lisp

@@ -403,7 +403,7 @@ See the Lisp Lesser GNU Public License for more details.
 (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 @@ See the Lisp Lesser GNU Public License for more details.
       :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 @@ See the Lisp Lesser GNU Public License for more details.
         :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)

integrity.lisp

@@ -30,12 +30,18 @@ See the Lisp Lesser GNU Public License for more details.
             "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 @@ See the Lisp Lesser GNU Public License for more details.
   (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 @@ See the Lisp Lesser GNU Public License for more details.
         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

test.lisp

@@ -97,16 +97,16 @@ subclass for them?)
 (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)))

utils-kt/flow-control.lisp

@@ -31,7 +31,7 @@ See the Lisp Lesser GNU Public License for more details.
 (defun min-if (v1 v2)
      (if v1 (if v2 (min v1 v2) v1) v2))
 
-(export! list-flatten! tree-flatten)
+(export! list-flatten! tree-flatten list-insertf subseq-contiguous-p)
 
 (defun list-flatten! (&rest list)
   (if (consp list)
@@ -67,6 +67,22 @@ See the Lisp Lesser GNU Public License for more details.
      (declare (dynamic-extent ,fn-name))
      ,@body))
 
+(defmacro list-insertf (place item &key after)
+  (let ((list (gensym))
+        (afterv (gensym))
+        (afters (gensym)))
+    `(let* ((,list ,place)
+            (,afterv ,after)
+            (,afters (when ,afterv (member ,after ,list))))
+       (assert (or (null ,afterv) ,afters) () "list-insertf after ~a not in list ~a" ,afterv ,list)
+       (setf ,place
+         (if ,afterv
+             (append (ldiff ,list ,afters)
+               (list ,afterv)
+               (list ,item)
+               (cdr ,afters))
+           (append ,list (list ,item)))))))
+
 (defun intern$ (&rest strings)
   (intern  (apply #'concatenate 'string strings)))