X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=mop.lisp;h=2a5d34c566381d8064b5c7dcde06f2c3903b578e;hb=2cbed6bd021bbecfe70496c8e4addb0f8a3f13cb;hp=e42ee8bfbc991b33ceca85ea3eccd4015a405c54;hpb=7e2d980b24a9fb31501fe3911582a6d85c374494;p=hyperobject.git

diff --git a/mop.lisp b/mop.lisp
index e42ee8b..2a5d34c 100644
--- a/mop.lisp
+++ b/mop.lisp
@@ -11,7 +11,7 @@
 ;;;; in Text, HTML, and XML formats. This includes hyperlinking
 ;;;; capability and sub-objects.
 ;;;;
-;;;; $Id: mop.lisp,v 1.84 2003/07/14 04:10:02 kevin Exp $
+;;;; $Id: mop.lisp,v 1.86 2003/07/29 21:21:52 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2003 by Kevin M. Rosenberg
 ;;;; *************************************************************************
@@ -110,6 +110,11 @@
   t)
 
 (defmethod finalize-inheritance :after ((cl hyperobject-class))
+  ;; Work-around needed for OpenMCL
+  #+ignore
+  (unless (find-class (class-name cl))
+    (setf (find-class (class-name cl)) cl))
+  
   (init-hyperobject-class cl)
   )
 
@@ -350,26 +355,27 @@ SQL name"
 ;; slot-name to a lazy reader, each of which is a list of a function and slot-names.
 (defvar *lazy-readers* (make-hash-table))
 
-(defmethod slot-unbound :around ((class hyperobject-class) instance slot-name)
-  (let ((lazy-reader (loop for super in (class-precedence-list class)
-			 as lazy-reader = (getf (gethash super *lazy-readers*) slot-name)
-			 when lazy-reader return it)))
+(defmethod slot-unbound ((class hyperobject-class) instance slot-name)
+  (let ((lazy-reader
+	 (loop for super in (class-precedence-list class)
+	       as lazy-reader = (getf (gethash super *lazy-readers*) slot-name)
+	       when lazy-reader return it)))
     (if lazy-reader
 	(setf (slot-value instance slot-name)
-	  (if (atom lazy-reader)
-	      (make-instance lazy-reader)
-	    (apply (car lazy-reader)
-		   (loop for arg-slot-name in (cdr lazy-reader)
-		       collect (slot-value instance arg-slot-name)))))
-      ;; No lazy reader -- defer to regular slot-unbound handling.
-      (call-next-method))))
+	      (if (atom lazy-reader)
+		  (make-instance lazy-reader)
+		  (apply (car lazy-reader)
+			 (loop for arg-slot-name in (cdr lazy-reader)
+			       collect (slot-value instance arg-slot-name)))))
+	;; No lazy reader -- defer to regular slot-unbound handling.
+	(call-next-method))))
 
 ;; The reader is a function and the reader-keys are slot names.  The slot is lazily set to
 ;; the result of applying the function to the slot-values of those slots, and that value
 ;; is also returned.
-(defun ensure-lazy-reader (class-name slot-name subobj-class reader 
+(defun ensure-lazy-reader (cl class-name slot-name subobj-class reader 
 			   &rest reader-keys)
-  (setf (getf (gethash (find-class class-name) *lazy-readers*) slot-name)
+  (setf (getf (gethash cl *lazy-readers*) slot-name)
     (aif subobj-class
 	 it
 	 (list* reader (copy-list reader-keys)))))
@@ -397,7 +403,8 @@ SQL name"
 				   :lookup-keys (when (listp subobj-def)
 						  (cdr subobj-def)))))
 	       (unless (eq (lookup subobject) t)
-		 (apply #'ensure-lazy-reader 
+		 (apply #'ensure-lazy-reader
+			cl
 			(name-class subobject) (name-slot subobject)
 			(subobj-class subobject)
 			(lookup subobject) (lookup-keys subobject))