[Sbcl-commits] CVS: sbcl/src/pcl defclass.lisp,1.27,1.28

[Christophe R. <cr...@us...>]

Update of /cvsroot/sbcl/sbcl/src/pcl
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5905/src/pcl

Modified Files:
	defclass.lisp 
Log Message:
0.8.10.11:
	Merge fixed version of "slightly faster compile/load" (CSR 
	sbcl-devel 2004-04-22)
	... fasls c. 10% smaller;
	... make.sh build time c. 5% faster.


Index: defclass.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/pcl/defclass.lisp,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -d -r1.27 -r1.28
--- defclass.lisp	27 May 2003 13:32:13 -0000	1.27
+++ defclass.lisp	4 May 2004 17:25:58 -0000	1.28
@@ -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)