From ktilton at common-lisp.net  Sat Apr  1 21:47:00 2006
From: ktilton at common-lisp.net (ktilton)
Date: Sat,  1 Apr 2006 16:47:00 -0500 (EST)
Subject: [cells-cvs] CVS cells
Message-ID: <20060401214700.58AB94F008@common-lisp.net>

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



From ktilton at common-lisp.net  Sat Apr  1 21:47:00 2006
From: ktilton at common-lisp.net (ktilton)
Date: Sat,  1 Apr 2006 16:47:00 -0500 (EST)
Subject: [cells-cvs] CVS cells/utils-kt
Message-ID: <20060401214700.9F29E4F008@common-lisp.net>

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

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

--- /project/cells/cvsroot/cells/utils-kt/defpackage.lisp	2006/03/16 05:26:47	1.2
+++ /project/cells/cvsroot/cells/utils-kt/defpackage.lisp	2006/04/01 21:47:00	1.3
@@ -43,6 +43,5 @@
     #:fifo-map #:fifo-peek #:fifo-data #:with-fifo-map #:fifo-length
 
     #-(or lispworks mcl) #:true
-    #+clisp #:slot-definition-name
     #+(and mcl (not openmcl-partial-mop)) #:class-slots
     ))
--- /project/cells/cvsroot/cells/utils-kt/detritus.lisp	2006/03/16 05:26:47	1.3
+++ /project/cells/cvsroot/cells/utils-kt/detritus.lisp	2006/04/01 21:47:00	1.4
@@ -26,10 +26,6 @@
   `(let ((*dbg* t))
      , at body))
 
-#+clisp
-(defun slot-definition-name (slot)
-  (clos::slotdef-name slot))
-
 ;;;(defmethod class-slot-named ((classname symbol) slotname)
 ;;;  (class-slot-named (find-class classname) slotname))
 ;;;