From fbffb9a0bd12691bae8b06f345927a6647bc694b Mon Sep 17 00:00:00 2001
From: gerd <gerd>
Date: Thu, 17 Jul 2003 12:40:35 +0000
Subject: [PATCH] 	Method definition takes something like O(n^3) time. 
 Reported by Eric Daniel.

	* src/pcl/dfun.lisp (*max-emf-precomputation-methods*):
	New variable.
	(finalize-specializers): Use it.
---
 pcl/dfun.lisp | 25 +++++++++++++++----------
 1 file changed, 15 insertions(+), 10 deletions(-)

diff --git a/pcl/dfun.lisp b/pcl/dfun.lisp
index 383c6c70e..795274d3b 100644
--- a/pcl/dfun.lisp
+++ b/pcl/dfun.lisp
@@ -25,7 +25,7 @@
 ;;; *************************************************************************
 
 (file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dfun.lisp,v 1.30 2003/06/05 12:35:22 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dfun.lisp,v 1.31 2003/07/17 12:40:35 gerd Exp $")
 
 (in-package :pcl)
 
@@ -769,20 +769,25 @@ And so, we are saved.
 ;;; 
 (defvar *early-p* nil)
 
+(defvar *max-emf-precomputation-methods* 100
+  "Precompute effective methods only if the generic function
+   has less than this number of methods.")
+
 ;;;
 ;;; Try to finalize all unfinalized class specializers of all methods
 ;;; of generic function GF.  Value is true if successful.
 ;;;
 (defun finalize-specializers (gf)
-  (let ((all-finalized t))
-    (dolist (method (generic-function-methods gf))
-      (dolist (specializer (method-specializers method))
-	(when (and (classp specializer)
-		   (not (class-finalized-p specializer)))
-	  (if (class-has-a-forward-referenced-superclass-p specializer)
-	      (setq all-finalized nil)
-	      (finalize-inheritance specializer)))))
-    all-finalized))
+  (let ((methods (generic-function-methods gf)))
+    (when (< (length methods) *max-emf-precomputation-methods*)
+      (let ((all-finalized t))
+	(dolist (method (generic-function-methods gf) all-finalized)
+	  (dolist (specializer (method-specializers method))
+	    (when (and (classp specializer)
+		       (not (class-finalized-p specializer)))
+	      (if (class-has-a-forward-referenced-superclass-p specializer)
+		  (setq all-finalized nil)
+		  (finalize-inheritance specializer)))))))))
       
 (defun make-initial-dfun (gf)
   (let ((initial-dfun 
-- 
GitLab