From 2b03b3bd171decdd6aab2846a275f5a63424d689 Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Thu, 15 May 2003 06:05:46 +0000
Subject: [PATCH] r4943: 2.8.2

---
 debian/changelog |  6 ++++++
 mop.lisp         | 38 +++++++++++++++++++++++++++++++++++---
 2 files changed, 41 insertions(+), 3 deletions(-)

diff --git a/debian/changelog b/debian/changelog
index 6c5fd5f..b2f5f80 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+cl-hyperobject (2.8.2-1) unstable; urgency=low
+
+  * Use hash-table based ensure-lazy-reader for Allegro/SCL
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Thu, 15 May 2003 00:05:06 -0600
+
 cl-hyperobject (2.8.1-1) unstable; urgency=low
 
   * New upstream
diff --git a/mop.lisp b/mop.lisp
index b24c4b4..c9fb4f2 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.71 2003/05/14 05:36:22 kevin Exp $
+;;;; $Id: mop.lisp,v 1.72 2003/05/15 06:05:46 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2003 by Kevin M. Rosenberg
 ;;;; *************************************************************************
@@ -371,6 +371,38 @@
 		   ':function (compile nil method-lambda)
 		   init-args-values)))))
 
+#+(or allegro scl)
+(progn
+  ;; One entry for each class with lazy readers defined.  The value is a plist mapping
+  ;; 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 (mop: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)
+		(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 reader &rest reader-keys)
+    (setf (getf (gethash (find-class class-name) *lazy-readers*) slot-name)
+	  (list* reader (copy-list reader-keys))))
+
+  (defun remove-lazy-reader (class-name slot-name)
+    (setf (getf (gethash (find-class class-name) *lazy-readers*) slot-name)
+	  nil))
+  
+  ) ;; #+(or allegro scl)
+
+
 (defun finalize-subobjects (cl)
   "Process class subobjects slot"
   (setf (subobjects cl)
@@ -389,12 +421,12 @@
 						    nil
 						    (cdr subobj-def)))))
 	       (unless (eq (lookup subobject) t)
-		 #-(or sbcl cmu lispworks)
+		 #+ignore ;; #-(or sbcl cmu lispworks)
 		 (eval
 		  `(hyperobject::def-lazy-reader ,(name-class subobject)
 		    ,(name-slot subobject) ,(lookup subobject)
 		    ,@(lookup-keys subobject)))
-		 #+(or sbcl cmu lispworks)
+		 #+(or sbcl cmu lispworks allegro scl)
 		 (apply #'ensure-lazy-reader 
 			(name-class subobject) (name-slot subobject)
 			(lookup subobject) (lookup-keys subobject)))
-- 
2.34.1