0.9.0.12:

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

diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp
index 083dfc4..b277f87 100644 (file)
--- a/src/pcl/boot.lisp
+++ b/src/pcl/boot.lisp
@@ -435,7 +435,7 @@ bootstrapping.
                                   specl))
                               specializers))
               (mname `(,(if (eq (cadr initargs-form) :function)
-                            'method 'fast-method)
+                            'slow-method 'fast-method)
                        ,name ,@qualifiers ,specls)))
          `(progn
             (defun ,mname ,(cadr fn-lambda)
@@ -612,25 +612,39 @@ bootstrapping.
         '(ignorable))
        (t
         ;; Otherwise, we can usually make Python very happy.
-        (let ((type (info :type :kind specializer)))
-          (ecase type
-            ((:primitive :defined :instance :forthcoming-defclass-type)
-             `(type ,specializer ,parameter))
-            ((nil)
+        (let ((kind (info :type :kind specializer)))
+          (ecase kind
+            ((:primitive) `(type ,specializer ,parameter))
+            ((:defined) 
              (let ((class (find-class specializer nil)))
-               (if class
-                   `(type ,(class-name class) ,parameter)
-                   (progn
-                     ;; we can get here, and still not have a failure
-                     ;; case, by doing MOP programming like (PROGN
-                     ;; (ENSURE-CLASS 'FOO) (DEFMETHOD BAR ((X FOO))
-                     ;; ...)).  Best to let the user know we haven't
-                     ;; been able to extract enough information:
-                     (style-warn
-                      "~@<can't find type for presumed class ~S in ~S.~@:>"
-                      specializer
-                      'parameter-specializer-declaration-in-defmethod)
-                     '(ignorable))))))))))
+                ;; CLASS can be null here if the user has erroneously
+                ;; tried to use a defined type as a specializer; it
+                ;; can be a non-BUILT-IN-CLASS if the user defines a
+                ;; type and calls (SETF FIND-CLASS) in a consistent
+                ;; way.
+                (when (and class (typep class 'built-in-class))
+                  `(type ,specializer ,parameter))))
+            ((:instance nil)
+             (let ((class (find-class specializer nil)))
+               (cond
+                 (class
+                  (if (typep class '(or built-in-class structure-class))
+                      `(type ,specializer ,parameter)
+                      ;; don't declare CLOS classes as parameters;
+                      ;; it's too expensive.
+                      '(ignorable)))
+                 (t
+                  ;; we can get here, and still not have a failure
+                  ;; case, by doing MOP programming like (PROGN
+                  ;; (ENSURE-CLASS 'FOO) (DEFMETHOD BAR ((X FOO))
+                  ;; ...)).  Best to let the user know we haven't
+                  ;; been able to extract enough information:
+                  (style-warn
+                   "~@<can't find type for presumed class ~S in ~S.~@:>"
+                   specializer
+                   'parameter-specializer-declaration-in-defmethod)
+                  '(ignorable)))))
+            ((:forthcoming-defclass-type) '(ignorable)))))))
 
 (defun make-method-lambda-internal (method-lambda &optional env)
   (unless (and (consp method-lambda) (eq (car method-lambda) 'lambda))
@@ -1254,7 +1268,7 @@ bootstrapping.
                   ((eq (car form) 'next-method-p)
                    (setq next-method-p-p t)
                    form)
-                  ((eq (car form) 'setq)
+                  ((memq (car form) '(setq multiple-value-setq))
                    ;; FIXME: this is possibly a little strong as
                    ;; conditions go.  Ideally we would want to detect
                    ;; which, if any, of the method parameters are
@@ -1411,7 +1425,7 @@ bootstrapping.
     method))
 
 (defun make-method-spec (gf-spec qualifiers unparsed-specializers)
-  `(method ,gf-spec ,@qualifiers ,unparsed-specializers))
+  `(slow-method ,gf-spec ,@qualifiers ,unparsed-specializers))
 
 (defun initialize-method-function (initargs &optional return-function-p method)
   (let* ((mf (getf initargs :function))