X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fdefclass.lisp;h=33bfd0b1a3024063326c7942436f413e21d406b9;hb=b7d22ded1428e8d3e87c37164aa6742dd28aa6ce;hp=5d79f0e2a049e949eba4da98d05115553a52c177;hpb=4ff2057326cb82db04380aae96493bd5fcb3c203;p=sbcl.git

diff --git a/src/pcl/defclass.lisp b/src/pcl/defclass.lisp
index 5d79f0e..33bfd0b 100644
--- 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)
@@ -305,6 +298,7 @@
   ;; actual type as a compile-time side-effect would probably be a bad
   ;; idea and (2) anyway we don't need to modify it in order to make
   ;; NAME be recognized as a valid type name)
+  (with-single-package-locked-error (:symbol name "proclaiming ~S as a class"))
   (unless (info :type :kind name)
     ;; Tell the compiler to expect a class with the given NAME, by
     ;; writing a kind of minimal placeholder type information. This
@@ -468,6 +462,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))