X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fboot.lisp;h=e10af044b0de9139311c73ef7aebab6cbb4863f5;hb=df679ed627975948b1cee190f4d79c397588c43e;hp=b1ef3f3ac6ac613e6ae5d3c9ce3cbe40507cf902;hpb=a736ac10b709b2d40305f0a6e3764afd246a8ef5;p=sbcl.git

diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp
index b1ef3f3..e10af04 100644
--- 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)