0.9.14.21:

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

diff --git a/src/pcl/dfun.lisp b/src/pcl/dfun.lisp
index 1db2f02..d6f2d08 100644 (file)
--- a/src/pcl/dfun.lisp
+++ b/src/pcl/dfun.lisp
@@ -633,9 +633,9 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
       (let ((cdc  (caching-dfun-cost gf))) ; fast
         (> cdc (dispatch-dfun-cost gf cdc))))))
 
-(defparameter *non-built-in-typep-cost* 1)
-(defparameter *structure-typep-cost* 1)
-(defparameter *built-in-typep-cost* 0)
+(defparameter *non-built-in-typep-cost* 100)
+(defparameter *structure-typep-cost*  15)
+(defparameter *built-in-typep-cost* 5)
 
 ;;; According to comments in the original CMU CL version of PCL,
 ;;; the cost LIMIT is important to cut off exponential growth for
@@ -666,9 +666,9 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
        max-cost-so-far))
    #'identity))
 
-(defparameter *cache-lookup-cost* 1)
-(defparameter *wrapper-of-cost* 0)
-(defparameter *secondary-dfun-call-cost* 1)
+(defparameter *cache-lookup-cost*  30)
+(defparameter *wrapper-of-cost* 15)
+(defparameter *secondary-dfun-call-cost* 30)
 
 (defun caching-dfun-cost (gf)
   (let ((nreq (get-generic-fun-info gf)))
@@ -679,13 +679,6 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
            *secondary-dfun-call-cost*
            0))))
 
-(setq *non-built-in-typep-cost* 100)
-(setq *structure-typep-cost* 15)
-(setq *built-in-typep-cost* 5)
-(setq *cache-lookup-cost* 30)
-(setq *wrapper-of-cost* 15)
-(setq *secondary-dfun-call-cost* 30)
-
 (declaim (inline make-callable))
 (defun make-callable (gf methods generator method-alist wrappers)
   (let* ((*applicable-methods* methods)
@@ -1516,21 +1509,30 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
 
 (defun cpl-or-nil (class)
   (if (eq *boot-state* 'complete)
-      ;; KLUDGE: why not use (slot-boundp class
-      ;; 'class-precedence-list)?  Well, unfortunately, CPL-OR-NIL is
-      ;; used within COMPUTE-APPLICABLE-METHODS, including for
-      ;; SLOT-BOUNDP-USING-CLASS... and the available mechanism for
-      ;; breaking such nasty cycles in effective method computation
-      ;; only works for readers and writers, not boundps.  It might
-      ;; not be too hard to make it work for BOUNDP accessors, but in
-      ;; the meantime we use an extra slot for exactly the result of
-      ;; the SLOT-BOUNDP that we want.  (We cannot use
-      ;; CLASS-FINALIZED-P, because in the process of class
-      ;; finalization we need to use the CPL which has been computed
-      ;; to cache effective methods for slot accessors.) -- CSR,
-      ;; 2004-09-19.
-      (when (cpl-available-p class)
-        (class-precedence-list class))
+      (progn
+        ;; KLUDGE: why not use (slot-boundp class
+        ;; 'class-precedence-list)?  Well, unfortunately, CPL-OR-NIL is
+        ;; used within COMPUTE-APPLICABLE-METHODS, including for
+        ;; SLOT-BOUNDP-USING-CLASS... and the available mechanism for
+        ;; breaking such nasty cycles in effective method computation
+        ;; only works for readers and writers, not boundps.  It might
+        ;; not be too hard to make it work for BOUNDP accessors, but in
+        ;; the meantime we use an extra slot for exactly the result of
+        ;; the SLOT-BOUNDP that we want.  (We cannot use
+        ;; CLASS-FINALIZED-P, because in the process of class
+        ;; finalization we need to use the CPL which has been computed
+        ;; to cache effective methods for slot accessors.) -- CSR,
+        ;; 2004-09-19.
+
+        (when (cpl-available-p class)
+          (return-from cpl-or-nil (class-precedence-list class)))
+
+        ;; if we can finalize an unfinalized class, then do so
+        (when (and (not (class-finalized-p class))
+                   (not (class-has-a-forward-referenced-superclass-p class)))
+          (finalize-inheritance class)
+          (class-precedence-list class)))
+
       (early-class-precedence-list class)))
 
 (defun saut-and (specl type)