From 8ab7a7d49976b82abb8bc2469338e517e67c5ee7 Mon Sep 17 00:00:00 2001
From: AJ Rossini <blindglobe@gmail.com>
Date: Sun, 6 Jan 2008 23:26:44 +0100
Subject: [PATCH] moving towards CLOS approach

---
 lsobjects.lsp | 50 +++++++++++++++++++++++++++++++++++---------------
 1 file changed, 35 insertions(+), 15 deletions(-)

diff --git a/lsobjects.lsp b/lsobjects.lsp
index 1f55adc..a50072c 100644
--- a/lsobjects.lsp
+++ b/lsobjects.lsp
@@ -88,6 +88,13 @@
 ;;   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-object-list ())
+(defclass preclist (proto-object-list))
+(defclass parents (proto-object-list))
+
+
 (defclass proto-object ()
     ((slots
       :initform (list)
@@ -161,39 +168,51 @@ Returns T if X and Y are objects and X inherits from Y, NIL otherwise."
       nil))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;
-;;;;                     Precedence List Functions
-;;;;
+;;;
+;;;                     Precedence List Functions
+;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defun find-SC (po)
-  "Return a copy of the complete precedence list for po."
-  (copy-list (proto-object-preclist (check-object po))))
+(defgeneric find-SC (po)
+  "Return a copy of the complete precedence list for po.")
+
+(defmethod find-SC ((po proto-object))
+  (copy-list (proto-object-preclist po)))
 
-(defun find-S (po)
-  "return a reverse-sorted, duplicate-free list of parent objects."
+
+(defgeneric find-S (po)
+  "return a reverse-sorted, duplicate-free list of parent objects.")
+
+(defmethod find-S ((po proto-object))
   (do ((result nil)
-       (parents (proto-object-parents (check-object po)) (cdr parents)))
+       (parents (proto-object-parents po) (cdr parents)))
       ((not (consp parents)) 
        (delete-duplicates (cons po result)))
     (setf result (nconc (find-SC (first parents)) result))))
 
-(defun find-RC (object)
-  "find local precedence ordering."
-  (let ((list (copy-list (proto-object-parents (check-object object)))))
+
+(defgeneric find-RC (po)
+  "find local precedence ordering.")
+
+(defmethod find-RC (object)
+  (let ((list (copy-list (proto-object-parents po))))
     (do ((next list (rest next)))
         ((not (consp next)) list)
-      (setf (first  next) (cons object (first next)))
+      (setf (first  next) (cons po (first next)))
       (setf object (rest (first next))))))
 
-(defun find-R (S)
-  "find partial precedence ordering."
+
+(defgeneric find-R (S)
+  "find partial precedence ordering.")
+
+(defmethod find-R ((S proto-object))
   (do ((result nil)
        (S S (rest S)))
       ((not (consp S)) 
        (delete-duplicates result))
     (setf result (nconc result (find-RC (first S))))))
 
+
 (defun has-predecessor (x R)
   "check if x has a predecessor according to R."
   (dolist (cell R nil)
@@ -342,6 +361,7 @@ Returns a new object with parents PARENTS. If PARENTS is NIL,
 ;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+;;; AJR: should specialize appropriately, the following:
 (defun make-slot-entry (x y) (cons x y))
 (defun slot-entry-p (x) (consp x))
 (defun slot-entry-key (x) (first x))
-- 
2.11.4.GIT