From 530dc89fa33c268a9cb0b922a936a298d3436850 Mon Sep 17 00:00:00 2001
From: AJ Rossini <blindglobe@gmail.com>
Date: Sun, 13 Jan 2008 04:50:06 +0100
Subject: [PATCH] more generic functions:

debugging, doc strings, proto-object-serial def.
---
 lsobjects.lsp | 54 +++++++++++++++++++++++++++++++++++++-----------------
 1 file changed, 37 insertions(+), 17 deletions(-)

diff --git a/lsobjects.lsp b/lsobjects.lsp
index ba07e95..842d546 100644
--- a/lsobjects.lsp
+++ b/lsobjects.lsp
@@ -88,20 +88,38 @@
 ;;   preclist precedence list
 ;;   (serial (incf *proto-object-serial*)))
 
-(defclass proto-slots ()) ;; list of data slots
-(defclass proto-methods ()) ;; list of functions that can be called
-(defclass proto-object-list ())
+(defclass proto-slots ()
+  ((contents)  ;; list of data slots
+   (name)
+   (documentation)))
+(defclass proto-methods () ;; list of functions that can be called
+  ((contents)  ;; list of data slots
+   (name)
+   (documentation)))
+(defclass proto-object-list ()
+  ((contents)  ;; list of data slots
+   (name)
+   (documentation)))
 ;; (defclass preclist (proto-object-list))
 ;; (defclass parents (proto-object-list))
 
-(defgeneric add-object (proto-struct slot value &key location)
-  "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 slot.") 
-(defgeneric delete-object (obj proto-struct))
-(defgeneric objects (proto-struct))
-(defgeneric get-object (objSym proto-struct))
+(defgeneric add-object (proto-struct slot &key 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
+  slot.  What the heck was implied by the location arg?"))
 
+(defgeneric delete-object (obj proto-struct)
+  (:documentation "remove the symbol from the proto object slot or
+  method list."))
+
+(defgeneric objects (proto-struct)
+  (:documentation "return list of object symbols, perhaps slots,
+  methods, parents, objects in precedence, as suggested by the arg."))
+
+(defgeneric get-object (objSym proto-struct)
+  (:documentation "accessor for the value of the symbol in the
+  particular instance of the prototyping object."))
 
 
 
@@ -126,6 +144,7 @@ method that we want to add with the name given in slot.")
      (serial 
       :initform (incf *proto-object-serial*)
       :type integer
+      :accessor proto-object-serial
       :documentation "Similar idea to serial number." )
      (self2
       :initform nil
@@ -168,7 +187,7 @@ Currently working to embed within the object structure rather than a global.")
 
 (defun check-object (po)
   "Returns self if true, throws an error otherwise."
-  (if (proto-object-p po) po (error "bad object - ~s" x)))
+  (if (proto-object-p po) po (error "bad object - ~s" po)))
 
 (defun kind-of-p (pox poy)
 "Args: (x y)
@@ -184,14 +203,15 @@ Returns T if X and Y are objects and X inherits from Y, NIL otherwise."
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defgeneric find-SC (po)
-  "Return a copy of the complete precedence list for po.")
+  (:documentation "Return a copy of the complete precedence list for po."))
 
 (defmethod find-SC ((po proto-object))
   (copy-list (proto-object-preclist po)))
 
 
 (defgeneric find-S (po)
-  "return a reverse-sorted, duplicate-free list of parent objects.")
+  (:documentation "return a reverse-sorted, duplicate-free list of
+  parent objects.")) 
 
 (defmethod find-S ((po proto-object))
   (do ((result nil)
@@ -202,9 +222,9 @@ Returns T if X and Y are objects and X inherits from Y, NIL otherwise."
 
 
 (defgeneric find-RC (po)
-  "find local precedence ordering.")
+  (:documentation "find local precedence ordering."))
 
-(defmethod find-RC (object)
+(defmethod find-RC (po)
   (let ((list (copy-list (proto-object-parents po))))
     (do ((next list (rest next)))
         ((not (consp next)) list)
@@ -213,7 +233,7 @@ Returns T if X and Y are objects and X inherits from Y, NIL otherwise."
 
 
 (defgeneric find-R (S)
-  "find partial precedence ordering.")
+  (:documentation "find partial precedence ordering."))
 
 (defmethod find-R ((S proto-object))
   (do ((result nil)
@@ -400,7 +420,7 @@ Returns a new object with parents PARENTS. If PARENTS is NIL,
 		       &key (location ))
   ;; (check-object x)
   ;; (non-nil-symbol-p slot)
-  (if (= slot nil)
+  #+nil(if (nilp slot)
       ;; This is wrong but has the right flavor of what should be
       ;; happening. 
       (setf slot (gensym)))
-- 
2.11.4.GIT