Update of /project/cells/cvsroot/cells In directory clnet:/tmp/cvs-serv1678

Modified Files: family.lisp Log Message: Mostly dropping special handling for CLisp in re slot-definition-name

--- /project/cells/cvsroot/cells/family.lisp 2006/03/16 05:28:28 1.4 +++ /project/cells/cvsroot/cells/family.lisp 2006/04/01 21:47:00 1.5 @@ -23,7 +23,7 @@ (in-package :cells)

(eval-when (:compile-toplevel :execute :load-toplevel) - (export '(model md-value family kids kid1 perishable))) + (export '(model md-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) @@ -86,7 +86,12 @@ (if (typep ,self ',type) ,self (upper ,self ,type)))))

(defun kid1 (self) (car (kids self))) +(defun kid2 (self) (cadr (kids self))) +(defmacro ^k1 () `(kid1 self)) +(defmacro ^k2 () `(kid2 self)) + (defun last-kid (self) (last1 (kids self))) +(defmacro ^k-last () `(last-kid self))

;; /// redundancy in following

@@ -142,9 +147,9 @@ (c-assert (listp old-kids)) (c-assert (not (member nil old-kids))) (c-assert (not (member nil new-kids))) - (c-assert (every 'fm-parent new-kids) () - "New for Cells3: parent must be supplied to make-instance of kid ~a" - (find-if-not 'fm-parent new-kids)) + (bwhen (sample (find-if-not 'fm-parent new-kids)) + (c-break "New as of Cells3: parent must be supplied to make-instance of ~a kid ~a" + (type-of sample) sample)) (trc nil ".kids output > entry" new-kids (mapcar 'fm-parent new-kids))

(dolist (k (set-difference old-kids new-kids))