From 2849e8e79fad3f8e9325b5b3029e9a593b5afc0a Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Thu, 29 Nov 1990 14:23:00 +0000
Subject: [PATCH] Changed DEFCLASS to declare the automatically defined slot
 accessor functions.

---
 pcl/defclass.lisp | 33 ++++++++++++++++++++++-----------
 1 file changed, 22 insertions(+), 11 deletions(-)

diff --git a/pcl/defclass.lisp b/pcl/defclass.lisp
index 299c4bc80..59c470e16 100644
--- a/pcl/defclass.lisp
+++ b/pcl/defclass.lisp
@@ -114,9 +114,10 @@
 	    (return t))))
 
     (let ((*initfunctions* ())
-	  (*accessors* ()))			;Truly a crock, but we got
-						;to have it to live nicely.
-      (declare (special *initfunctions* *accessors*))
+	  (*accessors* ())			   ;Truly a crock, but we got
+	  (*readers* ())			   ;to have it to live nicely.
+	  (*writers* ()))
+      (declare (special *initfunctions* *accessors* *readers* *writers*))
       (let ((canonical-slots
 	      (mapcar #'(lambda (spec)
 			  (canonicalize-slot-specification name spec))
@@ -128,13 +129,21 @@
 	(do-standard-defsetfs-for-defclass *accessors*)
 	(make-top-level-form `(defclass ,name)
 			     *defclass-times*
-	  `(let ,(mapcar #'cdr *initfunctions*)
-	     (load-defclass ',name
-			    ',metaclass
-			    ',supers
-			    (list ,@canonical-slots)
-			    (list ,@(apply #'append other-initargs))
-			    ',*accessors*)))))))
+	  `(progn
+	     ,@(mapcar #'(lambda (x)
+			   `(declaim (ftype (function (t) t) ,x)))
+		       *readers*)
+	     ,@(mapcar #'(lambda (x)
+			   `(declaim (ftype (function (t t) t) ,x)))
+		       *writers*)
+	     ,@(declare-accessor-methods canonical-slots)
+	     (let ,(mapcar #'cdr *initfunctions*)
+	       (load-defclass ',name
+			      ',metaclass
+			      ',supers
+			      (list ,@canonical-slots)
+			      (list ,@(apply #'append other-initargs))
+			      ',*accessors*))))))))
 
 (defun make-initfunction (initform)
   (declare (special *initfunctions*))
@@ -157,7 +166,7 @@
 	   (cadr entry)))))
 
 (defun canonicalize-slot-specification (class-name spec)
-  (declare (special *accessors*))
+  (declare (special *accessors* *readers* *writers*))
   (cond ((and (symbolp spec)
 	      (not (keywordp spec))
 	      (not (memq spec '(t nil))))		   
@@ -189,6 +198,8 @@
 	   (loop (unless (remf spec :reader)   (return)))
 	   (loop (unless (remf spec :writer)   (return)))
 	   (loop (unless (remf spec :initarg)  (return)))
+	   (setq *writers* (append writers *writers*))
+	   (setq *readers* (append readers *readers*))
 	   (setq spec `(:name     ',name
 			:readers  ',readers
 			:writers  ',writers
-- 
GitLab