X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Finit.lisp;h=a73f35326cd4027de5b8134971bed38175dabc3c;hb=2dfaffe8bdce30dac9b5baa4d2645d074a176b4f;hp=7e59506bfebea71273148c8e68a22391825d5f08;hpb=1ca4f69009204caee2484161e6eb89fa6c5fd3f6;p=sbcl.git

diff --git a/src/pcl/init.lisp b/src/pcl/init.lisp
index 7e59506..a73f353 100644
--- a/src/pcl/init.lisp
+++ b/src/pcl/init.lisp
@@ -29,22 +29,16 @@
   (apply #'make-instance (find-class class) initargs))
 
 (defmethod make-instance ((class class) &rest initargs)
+  (let ((instance-or-nil (maybe-call-ctor class initargs)))
+    (when instance-or-nil
+      (return-from make-instance instance-or-nil)))
   (unless (class-finalized-p class) (finalize-inheritance class))
   (let ((class-default-initargs (class-default-initargs class)))
     (when class-default-initargs
       (setf initargs (default-initargs initargs class-default-initargs)))
     (when initargs
-      (when (and (eq **boot-state** 'complete)
-                 (not (getf initargs :allow-other-keys)))
-        (let ((class-proto (class-prototype class)))
-          (check-initargs-1
-           class initargs
-           (append (compute-applicable-methods
-                    #'allocate-instance (list class))
-                   (compute-applicable-methods
-                    #'initialize-instance (list class-proto))
-                   (compute-applicable-methods
-                    #'shared-initialize (list class-proto t)))))))
+      (when (eq **boot-state** 'complete)
+        (check-mi-initargs class initargs)))
     (let ((instance (apply #'allocate-instance class initargs)))
       (apply #'initialize-instance instance initargs)
       instance)))