From 942deac236b89f38eebec5abfd8a273419a48959 Mon Sep 17 00:00:00 2001
From: AJ Rossini <blindglobe@gmail.com>
Date: Thu, 10 Jan 2008 09:24:45 +0100
Subject: [PATCH] start to objectify proto-object internals, predicates as
 predicates.

Need to claim error-throwing preds as "special preds".
---
 lsobjects.lsp | 29 +++++++++++++++++------------
 1 file changed, 17 insertions(+), 12 deletions(-)

diff --git a/lsobjects.lsp b/lsobjects.lsp
index a50072c..f3a11b3 100644
--- a/lsobjects.lsp
+++ b/lsobjects.lsp
@@ -88,29 +88,34 @@
 ;;   preclist precedence list
 ;;   (serial (incf *proto-object-serial*)))
 
-(defclass slots ()) ;; list of data slots
-(defclass methods ()) ;; list of functions that can be called
+(defclass proto-slots ()) ;; list of data slots
+(defclass proto-methods ()) ;; list of functions that can be called
 (defclass proto-object-list ())
-(defclass preclist (proto-object-list))
-(defclass parents (proto-object-list))
+;; (defclass preclist (proto-object-list))
+;; (defclass parents (proto-object-list))
+
+(defgeneric add-object (obj proto-struct))
+(defgeneric remove-object (obj proto-struct))
+(defgeneric objects (proto-struct))
+
 
 
 (defclass proto-object ()
     ((slots
       :initform (list)
-      :type list
+      :type proto-slots
       :accessor proto-object-slots )
      (methods
       :initform (list)
-      :type list
+      :type proto-methods
       :accessor proto-object-methods )
      (parents
       :initform (list)
-      :type list
+      :type proto-object-list
       :accessor proto-object-parents )
      (preclist ;; precedence list
       :initform (list)
-      :type list
+      :type proto-object-list
       :accessor proto-object-preclist
       :documentation "precedence list." )
      (serial 
@@ -153,7 +158,7 @@ Currently working to embed within the object structure rather than a global.")
 ;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defun check-non-nil-symbol (x)
+(defun non-nil-symbol-p (x)
   (unless (and x (symbolp x)) (error "bad symbol - ~s" x)))
 
 (defun check-object (po)
@@ -381,7 +386,7 @@ Returns a new object with parents PARENTS. If PARENTS is NIL,
 
 (defun add-slot (x slot value)
   (check-object x)
-  (check-non-nil-symbol slot)
+  (non-nil-symbol-p slot)
   (let ((slot-entry (find-own-slot x slot)))
     (if slot-entry 
       (setf (slot-entry-value slot-entry) value)
@@ -456,7 +461,7 @@ named SLOT."
 (defun add-lsos-method (x selector value)
   "x = object; selector = name of method; value = form computing the method."
   (check-object x)
-  (check-non-nil-symbol selector)
+  (non-nil-symbol-p selector)
   (let ((method-entry (find-own-method x selector)))
     (if method-entry 
       (setf (method-entry-method method-entry) value)
@@ -542,7 +547,7 @@ Call method belonging to another object on current object."
 
 (defun add-documentation (x sym value)
   (check-object x)
-  (check-non-nil-symbol sym)
+  (non-nil-symbol-p sym)
   (let ((doc-entry (find-documentation x sym t)))
     (cond
      ((not (null doc-entry))
-- 
2.11.4.GIT