Update of /project/cells/cvsroot/cells/cells-test In directory clnet:/tmp/cvs-serv24993/cells-test
Modified Files: hello-world.lisp test-kid-slotting.lisp test.lisp Log Message:
--- /project/cells/cvsroot/cells/cells-test/hello-world.lisp 2006/03/16 05:22:08 1.3 +++ /project/cells/cvsroot/cells/cells-test/hello-world.lisp 2006/06/20 14:16:45 1.4 @@ -24,15 +24,13 @@
(in-package :cells)
-(defmodel computer () - ((happen :cell :ephemeral :initform (c-in nil) :accessor happen) - (location :cell t - :initform (c? (case (^happen) - (:leave :away) - (:arrive :at-home) - (t .cache))) ;; ie, unchanged - :accessor location) - (response :cell :ephemeral :initform nil :initarg :response :accessor response))) +(defmd computer () + (happen (c-in nil) :ephemeral) + (location (c? (case (^happen) + (:leave :away) + (:arrive :at-home) + (t .cache)))) ;; ie, unchanged + (response nil :ephemeral))
(defobserver response(self new-response old-response) (when new-response --- /project/cells/cvsroot/cells/cells-test/test-kid-slotting.lisp 2006/03/16 05:22:08 1.2 +++ /project/cells/cvsroot/cells/cells-test/test-kid-slotting.lisp 2006/06/20 14:16:45 1.3 @@ -24,33 +24,28 @@
(in-package :cells)
-(defmodel image (family) - ((left :initform nil :initarg :left :accessor left) - (top :initform nil :initarg :top :accessor top) - (width :initform nil :initarg :width :accessor width) - (height :initform nil :initarg :height :accessor height) - )) +(defmd image (family) left top width height)
(defun right (x) (+ (left x) (width x))) (defun bottom (x) (+ (top x) (height x)))
-(defmodel stack (image) - ((justify :initform :left :initarg :justify :accessor justify) - (.kid-slots :initform (lambda (self) - (declare (ignore self)) - (list - (mk-kid-slot (left :if-missing t) - (c? (+ (left .parent) - (ecase (justify .parent) - (:left 0) - (:center (floor (- (width .parent) (^width)) 2)) - (:right (- (width .parent) (^width))))))) - (mk-kid-slot (top) - (c? (bif (psib (psib)) - (bottom psib) - (top .parent)))))) - :accessor kid-slots - :initarg :kid-slots))) +(defmd stack (image) + justify + (.kid-slots :initform (lambda (self) + (declare (ignore self)) + (list + (mk-kid-slot (left :if-missing t) + (c? (+ (left .parent) + (ecase (justify .parent) + (:left 0) + (:center (floor (- (width .parent) (^width)) 2)) + (:right (- (width .parent) (^width))))))) + (mk-kid-slot (top) + (c? (bif (psib (psib)) + (bottom psib) + (top .parent)))))) + :accessor kid-slots + :initarg :kid-slots)) ;; ;; kid-slotting exists largely so graphical containers can be defined which arrange their ;; component parts without those parts' cooperation. so a stack class can be defined as shown --- /project/cells/cvsroot/cells/cells-test/test.lisp 2006/06/13 05:05:14 1.6 +++ /project/cells/cvsroot/cells/cells-test/test.lisp 2006/06/20 14:16:45 1.7 @@ -65,7 +65,6 @@
(defvar *cell-tests* nil)
- #+go (test-cells)
@@ -99,12 +98,10 @@
;; test huge number of useds by one rule
-(defmodel m-index (family) - () - (:default-initargs - :md-value (c? (bwhen (ks (^kids)) - ;(trc "chya" (mapcar 'md-value ks)) - (apply '+ (mapcar 'md-value ks)))))) +(defmd m-index (family) + :md-value (c? (bwhen (ks (^kids)) + ;(trc "chya" (mapcar 'md-value ks)) + (apply '+ (mapcar 'md-value ks)))))
(def-cell-test many-useds (let ((i (make-instance 'm-index))) @@ -119,18 +116,18 @@ #+test (many-useds)
-(defmodel m-null () - ((aa :initform nil :cell nil :initarg :aa :accessor aa))) +(defmd m-null () + (aa :cell nil :initform nil :initarg :aa :accessor aa)) +
(def-cell-test m-null (let ((m (make-instance 'm-null :aa 42))) (ct-assert (= 42 (aa m))) - (ct-assert (= 21 (decf (aa m) 21))) + (ct-assert (= 21 (let ((slot 'aa)) + (funcall (fdefinition `(setf ,slot)) (- (aa m) 21) m)))) :okay-m-null))
-(defmodel m-solo () - ((m-solo-a :initform nil :initarg :m-solo-a :accessor m-solo-a) - (m-solo-b :initform nil :initarg :m-solo-b :accessor m-solo-b))) +(defmd m-solo () m-solo-a m-solo-b)
(def-cell-test m-solo (let ((m (make-instance 'm-solo @@ -143,9 +140,7 @@ (ct-assert (= 82 (m-solo-b m))) :okay-m-null))
-(defmodel m-var () - ((m-var-a :initform nil :initarg :m-var-a :accessor m-var-a) - (m-var-b :initform nil :initarg :m-var-b :accessor m-var-b))) +(defmd m-var () m-var-a m-var-b)
(defobserver m-var-b () (print `(output m-var-b ,self ,new-value ,old-value))) @@ -157,9 +152,9 @@ (ct-assert (= 21 (m-var-a m))) :okay-m-var))
-(defmodel m-var-output () - ((cbb :initform nil :initarg :cbb :accessor cbb) - (aa :cell nil :initform nil :initarg :aa :accessor aa))) +(defmd m-var-output () + cbb + (aa :cell nil :initform nil :initarg :aa :accessor aa))
(defobserver cbb () (trc "output cbb" self) @@ -175,9 +170,7 @@ (ct-assert (eql -15 (aa m))) (list :okay-m-var (aa m))))
-(defmodel m-var-linearize-setf () - ((ccc :initform nil :initarg :ccc :accessor ccc) - (ddd :initform nil :initarg :ddd :accessor ddd))) +(defmd m-var-linearize-setf () ccc ddd)
(defobserver ccc () (with-integrity (:change) @@ -198,9 +191,9 @@
;;; -------------------------------------------------------
-(defmodel m-ruled () - ((eee :initform nil :initarg :eee :accessor eee) - (fff :initform (c? (floor (^ccc) 2)) :initarg :fff :accessor fff))) +(defmd m-ruled () + eee + (fff (c? (floor (^ccc) 2))))
(defobserver eee () (print `(output> eee ,new-value old ,old-value))) @@ -222,15 +215,15 @@ (ct-assert (= 18 (fff m)) m) :okay-m-ruled))
-(defmodel m-worst-case () - ((wc-x :accessor wc-x :initform (c-input () 2)) - (wc-a :accessor wc-a :initform (c? (prog2 - (trc "Start A") - (when (oddp (wc-x self)) - (wc-c self)) - (trc "Stop A")))) - (wc-c :accessor wc-c :initform (c? (evenp (wc-x self)))) - (wc-h :accessor wc-h :initform (c? (or (wc-c self)(wc-a self)))))) +(defmd m-worst-case () + (wc-x (c-input () 2)) + (wc-a (c? (prog2 + (trc "Start A") + (when (oddp (wc-x self)) + (wc-c self)) + (trc "Stop A")))) + (wc-c (c? (evenp (wc-x self)))) + (wc-h (c? (or (wc-c self)(wc-a self)))))
(defun dependency-dump (self) (let ((slot-cells (loop for esd in (class-slots (class-of self)) @@ -252,10 +245,9 @@ (dependency-dump m) (ct-assert (eql 3 (incf (wc-x m))))))
-(defmodel c?n-class () - ((aaa :initarg :aaa :accessor aaa) - (bbb :initarg :bbb :accessor bbb) - (sum :initarg :sum :accessor sum :initform (c? (+ (^aaa) (^bbb)))))) +(defmd c?n-class () + aaa bbb + (sum (c? (+ (^aaa) (^bbb)))))
(def-cell-test test-c?n () (let ((self (make-instance 'c?n-class