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

[Erik Huelsmann]

Author: ehuelsmann
Date: Wed Feb 10 17:56:56 2010
New Revision: 12443

Log:
Revert r12425: it broke trunk in a way not quickly fixed.
  Work to reinstate 12425 continues on branches/metaclass/.

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	(original)
+++ trunk/abcl/src/org/armedbear/lisp/clos.lisp	Wed Feb 10 17:56:56 2010
@@ -537,14 +537,7 @@
 (defun canonical-slot-name (canonical-slot)
   (getf canonical-slot :name))
 
-(defun ensure-class (name &rest all-keys
-                     &key (metaclass 'standard-class) &allow-other-keys)
-
-  ;; Don't pass METACLASS on to the initialization routines
-  ;; This only works because we *know* ABCL conses up new &rest lists
-  ;; every time; otherwise, modifying the argument list is discouraged by the spec
-  (remf all-keys :metaclass)
-
+(defun ensure-class (name &rest all-keys &allow-other-keys)
   ;; Check for duplicate slots.
   (let ((slots (getf all-keys :direct-slots)))
     (dolist (s1 slots)
@@ -589,12 +582,8 @@
                   (apply #'std-after-initialization-for-classes old-class all-keys)
                   old-class)))
           (t
-           (let ((class (apply (if (eq metaclass 'standard-class)
-                                   #'make-instance-standard-class
-                                   #'make-instance)
-                               (or (when (symbolp metaclass)
-                                     (find-class metaclass))
-                                   metaclass)
+           (let ((class (apply #'make-instance-standard-class
+                               (find-class 'standard-class)
                                :name name all-keys)))
              (%set-find-class name class)
              class)))))