Changeset 13214

Timestamp:

02/12/11 18:10:07 (12 years ago)

Author:

ehuelsmann

Message:

Finalize subclasses as soon as a forward-referenced class gets defined
(and itself can be finalized).

File:

• trunk/abcl/src/org/armedbear/lisp/clos.lisp (modified) (4 diffs)

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

@@ -785 +785 @@
                             (substitute new-class old-class
                                         (class-direct-superclasses subclass))))
+                    (finalize-class-subtree new-class)
                     new-class))
                  (t
@@ -804 +805 @@
              (%set-find-class name class)
              class)))))
+
+
+(defun finalize-class-subtree (class)
+  (when (every #'class-finalized-p (class-direct-superclasses class))
+    (finalize-inheritance class)
+    (dolist (subclass (class-direct-subclasses class))
+       (finalize-class-subtree subclass))))
 
 (defmacro defclass (&whole form name direct-superclasses direct-slots &rest options)
@@ -2578 +2586 @@
                         (compute-applicable-methods gf args))
                     gf-list)))
-          (slots (class-slots (class-of instance))))
+    (slots (class-slots (class-of instance))))
       (do* ((tail initargs (cddr tail))
             (initarg (car tail) (car tail)))
            ((null tail))
         (unless (or (valid-initarg-p initarg slots)
-                    (valid-methodarg-p initarg methods)
+        (valid-methodarg-p initarg methods)
                     (eq initarg :allow-other-keys))
           (error 'program-error
@@ -2662 +2670 @@
   ;; checking initarg validity
   (do* ((tail all-keys (cddr tail))
-        (initarg (car tail) (car tail)))
+  (initarg (car tail) (car tail)))
       ((null tail))
     (unless (symbolp initarg)
       (error 'program-error
-             :format-control "Invalid initarg ~S."
-             :format-arguments (list initarg))))
+       :format-control "Invalid initarg ~S."
+       :format-arguments (list initarg))))
   (dolist (slot (class-slots (class-of instance)))
     (let ((slot-name (slot-definition-name slot)))