0.7.10.32:

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

diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp
index 559b3ea..9bb5b50 100644 (file)
--- a/src/pcl/boot.lisp
+++ b/src/pcl/boot.lisp
@@ -189,7 +189,7 @@ bootstrapping.
                        :format-control "The declaration specifier ~S ~
                                          is not allowed inside DEFGENERIC."
                        :format-arguments (list (cadr option))))
-              (push (cdr option) (initarg :declarations)))
+              (push (cadr option) (initarg :declarations)))
              ((:argument-precedence-order :method-combination)
               (if (initarg car-option)
                   (duplicate-option car-option)
@@ -347,10 +347,8 @@ bootstrapping.
                         lambda-list
                         body
                         env)
-  (let ((*make-instance-function-keys* nil)
-       (*optimize-asv-funcall-p* t)
+  (let ((*optimize-asv-funcall-p* t)
        (*asv-readers* nil) (*asv-writers* nil) (*asv-boundps* nil))
-    (declare (special *make-instance-function-keys*))
     (multiple-value-bind (method-lambda unspecialized-lambda-list specializers)
        (add-method-declarations name qualifiers lambda-list body env)
       (multiple-value-bind (method-function-lambda initargs)
@@ -380,9 +378,6 @@ bootstrapping.
             ;; intended. I hate that kind of bug (code which silently
             ;; gives the wrong answer), so we don't do a DECLAIM
             ;; here. -- WHN 20000229
-            ,@(when *make-instance-function-keys*
-                `((get-make-instance-functions
-                   ',*make-instance-function-keys*)))
             ,@(when (or *asv-readers* *asv-writers* *asv-boundps*)
                 `((initialize-internal-slot-gfs*
                    ',*asv-readers* ',*asv-writers* ',*asv-boundps*)))
@@ -1068,15 +1063,19 @@ bootstrapping.
                                        ,cnm-args)
                             ,call)
                            ,call))))
-                ,(if (and (null ',rest-arg)
-                          (consp cnm-args)
-                          (eq (car cnm-args) 'list))
-                     `(call-no-next-method ',method-name-declaration
-                                           ,@(cdr cnm-args))
-                     `(call-no-next-method ',method-name-declaration
-                                           ,@',args
-                                           ,@',(when rest-arg
-                                                     `(,rest-arg))))))
+                ,(locally
+                  ;; As above, this declaration supresses code
+                  ;; deletion notes.
+                  (declare (optimize (inhibit-warnings 3)))
+                  (if (and (null ',rest-arg)
+                           (consp cnm-args)
+                           (eq (car cnm-args) 'list))
+                      `(call-no-next-method ',method-name-declaration
+                                            ,@(cdr cnm-args))
+                      `(call-no-next-method ',method-name-declaration
+                                            ,@',args
+                                            ,@',(when rest-arg
+                                                      `(,rest-arg)))))))
              (next-method-p-body ()
                `(not (null ,',next-method-call))))
     ,@body))
@@ -1089,18 +1088,6 @@ bootstrapping.
              (null closurep)
              (null applyp))
         `(let () ,@body))
-       ((and (null closurep)
-             (null applyp))
-        ;; OK to use MACROLET, and all args are mandatory
-        ;; (else APPLYP would be true).
-        `(call-next-method-bind
-           (macrolet ((call-next-method (&rest cnm-args)
-                        `(call-next-method-body ,',method-name-declaration
-                                                ,(when cnm-args
-                                                   `(list ,@cnm-args))))
-                      (next-method-p ()
-                        `(next-method-p-body)))
-              ,@body)))
        (t
         `(call-next-method-bind
            (flet (,@(and call-next-method-p
@@ -1654,11 +1641,10 @@ bootstrapping.
                               (method-lambda-list method)))
     (flet ((lose (string &rest args)
             (error 'simple-program-error
-                   :format-control "attempt to add the method ~S ~
-                                     to the generic function ~S.~%~
-                                     But ~A"
-                   :format-arguments (list method gf
-                                           (apply #'format nil string args))))
+                   :format-control "~@<attempt to add the method~2I~_~S~I~_~
+                                     to the generic function~2I~_~S;~I~_~
+                                     but ~?~:>"
+                   :format-arguments (list method gf string args)))
           (comparison-description (x y)
             (if (> x y) "more" "fewer")))
       (let ((gf-nreq (arg-info-number-required arg-info))
@@ -1675,13 +1661,13 @@ bootstrapping.
           (comparison-description nopt gf-nopt)))
        (unless (eq (or keysp restp) gf-key/rest-p)
          (lose
-          "the method and generic function differ in whether they accept~%~
+          "the method and generic function differ in whether they accept~_~
            &REST or &KEY arguments."))
        (when (consp gf-keywords)
          (unless (or (and restp (not keysp))
                      allow-other-keys-p
                      (every (lambda (k) (memq k keywords)) gf-keywords))
-           (lose "the method does not accept each of the &KEY arguments~%~
+           (lose "the method does not accept each of the &KEY arguments~2I~_~
                   ~S."
                  gf-keywords)))))))