Permalink
Browse files

md-value -> value

  • Loading branch information...
1 parent afa428a commit 5db89605a2fb43bc476774091bc1248ba3d51ffd ktilton committed Nov 4, 2006
Showing with 65 additions and 40 deletions.
  1. +6 −6 cells-test/test-family.lisp
  2. +6 −6 cells-test/test.lisp
  3. +1 −5 cells.lpr
  4. +1 −1 defpackage.lisp
  5. +9 −9 doc/01-Cell-basics.lisp
  6. +1 −1 family-values.lisp
  7. +7 −2 family.lisp
  8. +3 −3 fm-utilities.lisp
  9. +10 −2 integrity.lisp
  10. +4 −4 test.lisp
  11. +17 −1 utils-kt/flow-control.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))
View
@@ -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)
View
@@ -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
View
@@ -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
View
@@ -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)
View
@@ -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)
View
@@ -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))
View
@@ -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)
View
@@ -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
View
@@ -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)))
View
@@ -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)))

0 comments on commit 5db8960

Please sign in to comment.