0.9.18.65:

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

diff --git a/src/pcl/dfun.lisp b/src/pcl/dfun.lisp
index d6f2d08..a83e037 100644 (file)
--- a/src/pcl/dfun.lisp
+++ b/src/pcl/dfun.lisp
@@ -489,11 +489,7 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
     (every (lambda (mt) (eq mt t)) metatypes)))
 
 (defun use-caching-dfun-p (generic-function)
-  (some (lambda (method)
-          (let ((fmf (if (listp method)
-                         (third method)
-                         (safe-method-fast-function method))))
-            (method-function-get fmf :slot-name-lists)))
+  (some (lambda (method) (method-plist-value method :slot-name-lists))
         ;; KLUDGE: As of sbcl-0.6.4, it's very important for
         ;; efficiency to know the type of the sequence argument to
         ;; quantifiers (SOME/NOTANY/etc.) at compile time, but
@@ -584,12 +580,7 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
                                (safe-method-specializers method))
                          (safe-method-qualifiers method))
                  (return nil)))
-             (let ((value (method-function-get
-                           (if early-p
-                               (or (third method) (second method))
-                               (or (safe-method-fast-function method)
-                                   (safe-method-function method)))
-                           :constant-value default)))
+             (let ((value (method-plist-value method :constant-value default)))
                (when (or (eq value default)
                          (and boolean-values-p
                               (not (member value '(t nil)))))
@@ -885,23 +876,33 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
                      (generic-function-methods gf))))
     (cond ((every (lambda (method)
                     (if (consp method)
-                        (eq *the-class-standard-reader-method*
-                            (early-method-class method))
-                        (standard-reader-method-p method)))
+                        (let ((class (early-method-class method)))
+                          (or (eq class *the-class-standard-reader-method*)
+                              (eq class *the-class-global-reader-method*)))
+                        (or (standard-reader-method-p method)
+                            (global-reader-method-p method))))
                   methods)
            'reader)
           ((every (lambda (method)
                     (if (consp method)
-                        (eq *the-class-standard-boundp-method*
-                            (early-method-class method))
-                        (standard-boundp-method-p method)))
+                        (let ((class (early-method-class method)))
+                          (or (eq class *the-class-standard-boundp-method*)
+                              (eq class *the-class-global-boundp-method*)))
+                        (or (standard-boundp-method-p method)
+                            (global-boundp-method-p method))))
                   methods)
            'boundp)
           ((every (lambda (method)
                     (if (consp method)
-                        (eq *the-class-standard-writer-method*
-                            (early-method-class method))
-                        (standard-writer-method-p method)))
+                        (let ((class (early-method-class method)))
+                          (or (eq class *the-class-standard-writer-method*)
+                              (eq class *the-class-global-writer-method*)))
+                        (and
+                         (or (standard-writer-method-p method)
+                             (global-writer-method-p method))
+                         (not (safe-p
+                               (slot-definition-class
+                                (accessor-method-slot-definition method)))))))
                   methods)
            'writer))))
 
@@ -1071,14 +1072,13 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
   (let ((ocache (dfun-info-cache dfun-info)))
     (dfun-miss (generic-function args wrappers invalidp emf nil nil t)
       (unless invalidp
-        (let* ((function
+        (let* ((value
                 (typecase emf
-                  (fast-method-call (fast-method-call-function emf))
-                  (method-call (method-call-function emf))))
-               (value (let ((val (method-function-get
-                                  function :constant-value '.not-found.)))
-                        (aver (not (eq val '.not-found.)))
-                        val))
+                  (constant-fast-method-call
+                   (constant-fast-method-call-value emf))
+                  (constant-method-call (constant-method-call-value emf))
+                  (t (bug "~S with non-constant EMF ~S"
+                          'constant-value-miss emf))))
                (ncache (fill-cache ocache wrappers value)))
           (unless (eq ncache ocache)
             (dfun-update generic-function
@@ -1223,7 +1223,7 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
         (found-method nil))
     (dolist (method (standard-slot-value/gf gf 'methods) found-method)
       (let ((specializers (standard-slot-value/method method 'specializers))
-            (qualifiers (plist-value method 'qualifiers)))
+            (qualifiers (standard-slot-value/method method 'qualifiers)))
         (when (and (null qualifiers)
                    (let ((subcpl (member (ecase type
                                            (reader (car specializers))
@@ -1255,7 +1255,7 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
   (dolist (meth methods)
     (when (if (consp meth)
               (early-method-qualifiers meth)
-              (method-qualifiers meth))
+              (safe-method-qualifiers meth))
       (return-from accessor-values-internal (values nil nil))))
   (let* ((meth (car methods))
          (early-p (not (eq *boot-state* 'complete)))
@@ -1272,7 +1272,7 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
                                (if early-p
                                    (not (eq *the-class-standard-method*
                                             (early-method-class meth)))
-                                   (standard-accessor-method-p meth))
+                                   (accessor-method-p meth))
                                (if early-p
                                    (early-accessor-method-slot-name meth)
                                    (accessor-method-slot-name meth))))))
@@ -1285,7 +1285,9 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
                          (find-slot-definition accessor-class slot-name)))))
     (when (and slotd
                (or early-p
-                   (slot-accessor-std-p slotd accessor-type)))
+                   (slot-accessor-std-p slotd accessor-type))
+               (or early-p
+                   (not (safe-p accessor-class))))
       (values (if early-p
                   (early-slot-definition-location slotd)
                   (slot-definition-location slotd))