1.0.46.11: faster slot-accesses in the presence of SLOT-VALUE-USING-CLASS &co

[sbcl.git] / src / pcl / defclass.lisp

diff --git a/src/pcl/defclass.lisp b/src/pcl/defclass.lisp
index 5d79f0e..cd9bd18 100644 (file)
--- a/src/pcl/defclass.lisp
+++ b/src/pcl/defclass.lisp
@@ -53,7 +53,7 @@
           ;; DEFSTRUCT-P should be true if the class is defined
           ;; with a metaclass STRUCTURE-CLASS, so that a DEFSTRUCT
           ;; is compiled for the class.
-          (defstruct-p (and (eq *boot-state* 'complete)
+          (defstruct-p (and (eq **boot-state** 'complete)
                             (let ((mclass (find-class metaclass nil)))
                               (and mclass
                                    (*subtypep
@@ -163,6 +163,8 @@
            (push `(:documentation ,(second option)) canonized-options))
           (otherwise
            (push `(',(car option) ',(cdr option)) canonized-options))))
+      (unless default-initargs
+        (push '(:direct-default-initargs nil) canonized-options))
       (values (or metaclass 'standard-class) (nreverse canonized-options))))
 
 (defun canonize-defclass-slots (class-name slots env)
@@ -229,17 +231,8 @@
             ((null head))
           (unless (cdr (second head))
             (setf (second head) (car (second head)))))
-        (let* ((type-check-function
-                (if (eq type t)
-                    nil
-                    `('type-check-function (lambda (value)
-                                             (declare (type ,type value)
-                                                      (optimize (sb-c:store-coverage-data 0)))
-                                             value))))
-               (canon `(:name ',name :readers ',readers :writers ',writers
-                              :initargs ',initargs
-                              ,@type-check-function
-                              ',others)))
+        (let ((canon `(:name ',name :readers ',readers :writers ',writers
+                             :initargs ',initargs ',others)))
           (push (if (eq initform unsupplied)
                     `(list* ,@canon)
                     `(list* :initfunction ,(make-initfunction initform)
@@ -468,6 +461,9 @@
 (defun early-slot-definition-location (slotd)
   (!bootstrap-get-slot 'standard-effective-slot-definition slotd 'location))
 
+(defun early-slot-definition-info (slotd)
+  (!bootstrap-get-slot 'standard-effective-slot-definition slotd 'info))
+
 (defun early-accessor-method-slot-name (method)
   (!bootstrap-get-slot 'standard-accessor-method method 'slot-name))