0.8.3.39:

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

diff --git a/src/pcl/vector.lisp b/src/pcl/vector.lisp
index 26cc570..e6bfa4b 100644 (file)
--- a/src/pcl/vector.lisp
+++ b/src/pcl/vector.lisp
@@ -232,8 +232,7 @@
               (pv-cell (cons pv calls))
               (new-cache (fill-cache cache pv-wrappers pv-cell)))
          (unless (eq new-cache cache)
-           (setf (pv-table-cache pv-table) new-cache)
-           (free-cache cache))
+           (setf (pv-table-cache pv-table) new-cache))
          pv-cell))))
 
 (defun make-pv-type-declaration (var)
@@ -1014,8 +1013,8 @@
 ;;; body given, or return NIL if no %METHOD-NAME declaration is found.
 (defun body-method-name (body)
   (multiple-value-bind (real-body declarations documentation)
-      (parse-body body nil)
-    (declare (ignore documentation real-body))
+      (parse-body body)
+    (declare (ignore real-body documentation))
     (let ((name-decl (get-declaration '%method-name declarations)))
       (and name-decl
           (destructuring-bind (name) name-decl
@@ -1076,8 +1075,9 @@
                              req-args)))
       `(list*
        :fast-function
-       (named-lambda
-        ,(or (body-method-name body) '.method.) ; function name
+       (,(if (body-method-name body) 'named-lambda 'lambda)
+        ,@(when (body-method-name body)
+            (list (body-method-name body))) ; function name
         (.pv-cell. .next-method-call. ,@args+rest-arg) ; function args
         ;; body of the function
         (declare (ignorable .pv-cell. .next-method-call.))