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