From 6c0f09b09ce3deaf4691929643850abd11547b31 Mon Sep 17 00:00:00 2001
From: AJ Rossini <blindglobe@gmail.com>
Date: Sun, 13 Jan 2008 11:28:46 +0100
Subject: [PATCH] more CLOS issues.

---
 lsobjects.lsp | 35 ++++++++++++++++++-----------------
 1 file changed, 18 insertions(+), 17 deletions(-)

diff --git a/lsobjects.lsp b/lsobjects.lsp
index 842d546..8325e54 100644
--- a/lsobjects.lsp
+++ b/lsobjects.lsp
@@ -100,10 +100,10 @@
   ((contents)  ;; list of data slots
    (name)
    (documentation)))
-;; (defclass preclist (proto-object-list))
-;; (defclass parents (proto-object-list))
+(defclass preclist (proto-object-list) ())
+(defclass parent-list (proto-object-list) ())
 
-(defgeneric add-object (proto-struct slot &key init location)
+(defgeneric add-object (proto-struct slot &optional init) ;; location)
   (:documentation "proto-struct is the prototype structure that we are
   working with, while slot means either slot or method, and value is
   the data or the method that we want to add with the name given in
@@ -133,12 +133,12 @@
       :type proto-methods
       :accessor proto-object-methods )
      (parents
-      :initform (list)
-      :type proto-object-list
+      :initform (make-instance 'parent-list)
+      :type parent-list
       :accessor proto-object-parents )
      (preclist ;; precedence list
-      :initform (list)
-      :type proto-object-list
+      :initform (make-instance 'preclist)
+      :type preclist
       :accessor proto-object-preclist
       :documentation "precedence list." )
      (serial 
@@ -148,6 +148,7 @@
       :documentation "Similar idea to serial number." )
      (self2
       :initform nil
+      :type integer
       :accessor proto-self
       :documentation "can we embed the global within the class structure?" )))
 
@@ -229,7 +230,7 @@ Returns T if X and Y are objects and X inherits from Y, NIL otherwise."
     (do ((next list (rest next)))
         ((not (consp next)) list)
       (setf (first  next) (cons po (first next)))
-      (setf object (rest (first next))))))
+      (setf po (rest (first next))))))
 
 
 (defgeneric find-R (S)
@@ -414,21 +415,21 @@ Returns a new object with parents PARENTS. If PARENTS is NIL,
   "Remove when completely replaced by add-object methods."
   (add-object x slot value))
 
-(defmethod add-object ((x proto-object)
+(defmethod add-object ((x (type proto-object)
 		       (slot symbol)
-		       (value )
-		       &key (location ))
+		       &optional
+		       init)) ;; location))
   ;; (check-object x)
   ;; (non-nil-symbol-p slot)
-  #+nil(if (nilp slot)
-      ;; This is wrong but has the right flavor of what should be
-      ;; happening. 
-      (setf slot (gensym)))
+;  #+nil(if (nilp slot)
+;      ;; This is wrong but has the right flavor of what should be
+;      ;; happening. 
+;      (setf slot (gensym)))
   (let ((slot-entry (find-own-slot x slot)))
     (if slot-entry 
-      (setf (slot-entry-value slot-entry) value)
+      (setf (slot-entry-value slot-entry) init)
       (setf (proto-object-slots x)
-            (cons (make-slot-entry slot value) (proto-object-slots x)))))
+            (cons (make-slot-entry slot init) (proto-object-slots x)))))
   nil) ;; I think we want to return something, but what?   
 
 ;; This might be more appropriate as a "setter" dispatching on a
-- 
2.11.4.GIT