X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fdefclass.lisp;h=87b2c1e3146d006b1a9351be10e209af8b4a398f;hb=3a618201c9f2370bb8784217a866d000371769e5;hp=4226df53b8e52ca55b2917748c83a779a6c36269;hpb=2ef330d818799fe54587bdcb4c626b397ca15266;p=sbcl.git

diff --git a/src/pcl/defclass.lisp b/src/pcl/defclass.lisp
index 4226df5..87b2c1e 100644
--- a/src/pcl/defclass.lisp
+++ b/src/pcl/defclass.lisp
@@ -99,20 +99,11 @@
                                         *the-class-structure-class*))))))
           (let ((defclass-form
 		  `(progn
-		     ,@(mapcar (lambda (x)
-				 `(declaim (ftype (function (t) t) ,x)))
-			       *readers-for-this-defclass*)
-		     ,@(mapcar (lambda (x)
-				 `(declaim (ftype (function (t t) t) ,x)))
-			       *writers-for-this-defclass*)
-                     ,@(mapcar (lambda (x)
-                                 `(declaim (ftype (function (t) t)
-                                                  ,(slot-reader-name x)
-                                                  ,(slot-boundp-name x))
-                                           (ftype (function (t t) t)
-                                                  ,(slot-writer-name x))))
-                               *slot-names-for-this-defclass*)
 		     (let ,(mapcar #'cdr *initfunctions-for-this-defclass*)
+		       (%compiler-defclass ',name
+					   ',*readers-for-this-defclass*
+					   ',*writers-for-this-defclass*
+					   ',*slot-names-for-this-defclass*)
 		       (load-defclass ',name
 				      ',metaclass
 				      ',supers
@@ -158,8 +149,21 @@
 		   ;; full-blown class, so the "a class of this name is
 		   ;; coming" note we write here would be irrelevant.
 		   (eval-when (:compile-toplevel)
-		     (preinform-compiler-about-class-type ',name))
-		   ,defclass-form))))))))
+		     (%compiler-defclass ',name
+					 ',*readers-for-this-defclass*
+					 ',*writers-for-this-defclass*
+					 ',*slot-names-for-this-defclass*))
+		   (eval-when (:load-toplevel :execute)
+		     ,defclass-form)))))))))
+
+(defun %compiler-defclass (name readers writers slot-names)
+  (preinform-compiler-about-class-type name)
+  (proclaim `(ftype (function (t) t)
+	      ,@readers
+	      ,@(mapcar #'slot-reader-name slot-names)
+	      ,@(mapcar #'slot-boundp-name slot-names)))
+  (proclaim `(ftype (function (t t) t)
+	      ,@writers ,@(mapcar #'slot-writer-name slot-names))))
 
 (defun make-initfunction (initform)
   (cond ((or (eq initform t)
@@ -209,7 +213,7 @@
 		  :format-control
 		  "~@<in DEFCLASS ~S, the slot specification ~S is invalid; ~
                    the probable intended meaning may be achieved by ~
-                   specifiying ~S instead."
+                   specifiying ~S instead.~>"
 		  :format-arguments
 		  (list class-name spec
 			`(,(car spec) :initform ,(cadr spec)))))