[armedbear-cvs] r13978 - trunk/abcl/src/org/armedbear/lisp

[rschlatte at common-lisp.net]

Author: rschlatte
Date: Mon Jun 18 09:32:48 2012
New Revision: 13978

Log:
Don't defer compute-discriminating-function

Modified:
   trunk/abcl/src/org/armedbear/lisp/clos.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/clos.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/clos.lisp	Sun Jun 17 11:20:32 2012	(r13977)
+++ trunk/abcl/src/org/armedbear/lisp/clos.lisp	Mon Jun 18 09:32:48 2012	(r13978)
@@ -1574,15 +1574,6 @@
                           all-keys))
           gf))))
 
-(defun initial-discriminating-function (gf args)
-  (set-funcallable-instance-function
-   gf
-   (funcall (if (eq (class-of gf) +the-standard-generic-function-class+)
-                #'std-compute-discriminating-function
-                #'compute-discriminating-function)
-            gf))
-  (apply gf args))
-
 (defun collect-eql-specializer-objects (generic-function)
   (let ((result nil))
     (dolist (method (generic-function-methods generic-function))
@@ -1600,8 +1591,10 @@
   (clrhash (generic-function-classes-to-emf-table gf))
   (%init-eql-specializations gf (collect-eql-specializer-objects gf))
   (set-funcallable-instance-function
-   gf #'(lambda (&rest args)
-          (initial-discriminating-function gf args)))
+   gf
+   (if (eq (class-of gf) +the-standard-generic-function-class+)
+       (std-compute-discriminating-function gf)
+       (compute-discriminating-function gf)))
   ;; FIXME Do we need to warn on redefinition somewhere else?
   (let ((*warn-on-redefinition* nil))
     (setf (fdefinition (%generic-function-name gf)) gf))