0.8alpha.0.32:

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

diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp
index b1ef3f3..e10af04 100644 (file)
--- a/src/pcl/boot.lisp
+++ b/src/pcl/boot.lisp
@@ -587,8 +587,26 @@ bootstrapping.
         ;; weirdness when bootstrapping.. -- WHN 20000610
         '(ignorable))
        (t
-        ;; Otherwise, we can make Python very happy.
-        `(type ,specializer ,parameter))))
+        ;; 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 ((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))))))))))
 
 (defun make-method-lambda-internal (method-lambda &optional env)
   (unless (and (consp method-lambda) (eq (car method-lambda) 'lambda))
@@ -1566,7 +1584,7 @@ bootstrapping.
 
 ;;; Keep pages clean by not setting if the value is already the same.
 (defmacro esetf (pos val)
-  (let ((valsym (gensym "value")))
+  (with-unique-names (valsym)
     `(let ((,valsym ,val))
        (unless (equal ,pos ,valsym)
         (setf ,pos ,valsym)))))
@@ -1773,7 +1791,7 @@ bootstrapping.
 (defun make-early-gf (spec &optional lambda-list lambda-list-p
                      function argument-precedence-order)
   (let ((fin (allocate-funcallable-instance *sgf-wrapper* *sgf-slots-init*)))
-    (set-funcallable-instance-fun
+    (set-funcallable-instance-function
      fin
      (or function
         (if (eq spec 'print-object)