1.0.8.41: doc spelling fixes.

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

diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp
index b4a4a26..56317d7 100644 (file)
--- a/src/pcl/boot.lisp
+++ b/src/pcl/boot.lisp
@@ -513,9 +513,6 @@ bootstrapping.
     (sb-c:source-location)))
 
 (defmacro make-method-function (method-lambda &environment env)
-  (make-method-function-internal method-lambda env))
-
-(defun make-method-function-internal (method-lambda &optional env)
   (multiple-value-bind (proto-gf proto-method)
       (prototypes-for-make-method-lambda nil)
     (multiple-value-bind (method-function-lambda initargs)
@@ -578,7 +575,21 @@ bootstrapping.
   (setf (gdefinition 'make-method-initargs-form)
         (symbol-function 'real-make-method-initargs-form)))
 
+;;; When bootstrapping PCL MAKE-METHOD-LAMBDA starts out as a regular
+;;; functions: REAL-MAKE-METHOD-LAMBDA set to the fdefinition of
+;;; MAKE-METHOD-LAMBDA. Once generic functions are born, the
+;;; REAL-MAKE-METHOD lambda is used as the body of the default method.
+;;; MAKE-METHOD-LAMBDA-INTERNAL is split out into a separate function
+;;; so that changing it in a live image is easy, and changes actually
+;;; take effect.
 (defun real-make-method-lambda (proto-gf proto-method method-lambda env)
+  (make-method-lambda-internal proto-gf proto-method method-lambda env))
+
+(unless (fboundp 'make-method-lambda)
+  (setf (gdefinition 'make-method-lambda)
+        (symbol-function 'real-make-method-lambda)))
+
+(defun make-method-lambda-internal (proto-gf proto-method method-lambda env)
   (declare (ignore proto-gf proto-method))
   (unless (and (consp method-lambda) (eq (car method-lambda) 'lambda))
     (error "The METHOD-LAMBDA argument to MAKE-METHOD-LAMBDA, ~S, ~
@@ -734,10 +745,6 @@ bootstrapping.
                           ,@(when plist `(plist ,plist))
                           ,@(when documentation `(:documentation ,documentation)))))))))))
 
-(unless (fboundp 'make-method-lambda)
-  (setf (gdefinition 'make-method-lambda)
-        (symbol-function 'real-make-method-lambda)))
-
 (defun real-make-method-specializers-form
     (proto-gf proto-method specializer-names env)
   (declare (ignore env proto-gf proto-method))
@@ -1509,15 +1516,12 @@ bootstrapping.
                                (t nil))))
                    ((and (memq (car form)
                                '(slot-value set-slot-value slot-boundp))
-                         (constantp (caddr form)))
-                    (let ((parameter (can-optimize-access form
-                                                          required-parameters
-                                                          env)))
-                      (let ((fun (ecase (car form)
-                                   (slot-value #'optimize-slot-value)
-                                   (set-slot-value #'optimize-set-slot-value)
-                                   (slot-boundp #'optimize-slot-boundp))))
-                        (funcall fun slots parameter form))))
+                         (constantp (caddr form) env))
+                    (let ((fun (ecase (car form)
+                                 (slot-value #'optimize-slot-value)
+                                 (set-slot-value #'optimize-set-slot-value)
+                                 (slot-boundp #'optimize-slot-boundp))))
+                        (funcall fun form slots required-parameters env)))
                    (t form))))
 
       (let ((walked-lambda (walk-form method-lambda env #'walk-function)))
@@ -2671,13 +2675,18 @@ bootstrapping.
 ;;; walker stuff was only used for implementing stuff like that; maybe
 ;;; it's not needed any more? Hunt down what it was used for and see.
 
+(defun extract-the (form)
+  (cond ((and (consp form) (eq (car form) 'the))
+         (aver (proper-list-of-length-p 3))
+         (third form))
+        (t
+         form)))
+
 (defmacro with-slots (slots instance &body body)
   (let ((in (gensym)))
     `(let ((,in ,instance))
        (declare (ignorable ,in))
-       ,@(let ((instance (if (and (consp instance) (eq (car instance) 'the))
-                             (third instance)
-                             instance)))
+       ,@(let ((instance (extract-the instance)))
            (and (symbolp instance)
                 `((declare (%variable-rebinding ,in ,instance)))))
        ,in
@@ -2699,9 +2708,7 @@ bootstrapping.
   (let ((in (gensym)))
     `(let ((,in ,instance))
        (declare (ignorable ,in))
-       ,@(let ((instance (if (and (consp instance) (eq (car instance) 'the))
-                             (third instance)
-                             instance)))
+       ,@(let ((instance (extract-the instance)))
            (and (symbolp instance)
                 `((declare (%variable-rebinding ,in ,instance)))))
        ,in