1.0.43.46: Simplify some type tests to EQL comparisons

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

diff --git a/src/pcl/defclass.lisp b/src/pcl/defclass.lisp
index 5d79f0e..de39bc3 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)
@@ -232,10 +234,11 @@
         (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))))
+                    `('type-check-function
+                      (named-lambda (slot-typecheck ,class-name ,name) (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