Changeset 616 for trunk/ccl/level-1/l1-clos.lisp

Timestamp:

Mar 3, 2004, 11:27:12 PM (17 years ago)

Author:

gb

Message:

Define and use COMPUTE-CLASS-PRECEDENCE-LIST. Flush initargs caches whenever
class is finalized.

File:

• trunk/ccl/level-1/l1-clos.lisp (modified) (5 diffs)

trunk/ccl/level-1/l1-clos.lisp

@@ -422 +422 @@
   (update-class class t))
 
+
+(defmethod finalize-inheritance ((class forward-referenced-class))
+  (error "Class ~s can't be finalized." class))
+
 (defmethod class-primary-p ((class std-class))
   (%class-primary-p class))
@@ -482 +486 @@
         (sort-list slotds '< #'slotd-position)))))
 
-(defun class-has-a-forward-referenced-superclass-p (class)
-  (or (forward-referenced-class-p class)
-      (some #'class-has-a-forward-referenced-superclass-p
-            (%class-direct-superclasses class))))
+
+
 
 (defun update-cpl (class cpl)
@@ -495 +497 @@
 
 
+(defun class-has-a-forward-referenced-superclass-p (class)
+  (or (if (forward-referenced-class-p class) class)
+      (dolist (s (%class-direct-superclasses class))
+        (let* ((fwdref (class-has-a-forward-referenced-superclass-p s)))
+          (when fwdref (return fwdref))))))
+
+
+(defmethod compute-class-precedence-list ((class class))
+  (let* ((fwdref (class-has-a-forward-referenced-superclass-p class)))
+    (when fwdref
+      (error "~&Class ~s can't be finalized because at least one of its superclasses (~s) is a FORWARD-REFERENCED-CLASS." class fwdref)))
+  (compute-cpl class))
+
+;;; Classes that can't be instantiated via MAKE-INSTANCE have no
+;;; initargs caches.
+(defmethod %flush-initargs-caches ((class class))
+  )
+
+;;; Classes that have initargs caches should flush them when the
+;;; class is finalized.
+(defmethod %flush-initargs-caches ((class std-class))
+  (setf (%class.make-instance-initargs class) nil
+        (%class.reinit-initargs class) nil
+        (%class.redefined-initargs class) nil
+        (%class.changed-initargs class) nil))
 
 (defun update-class (class finalizep)
@@ -512 +539 @@
             (class-finalized-p class)
             (not (class-has-a-forward-referenced-superclass-p class)))
-    (update-cpl class (compute-cpl  class))
+    (update-cpl class (compute-class-precedence-list  class))
     ;;; This -should- be made to work for structure classes
     (update-slots class (compute-slots class))
     (setf (%class-default-initargs class) (compute-default-initargs class))
+    (%flush-initargs-caches class)
     )
   (unless finalizep
@@ -1421 +1449 @@
                             (apply #'update-dependent class d initargs))))
 
-(defmethod finalize-inheritance ((fwc forward-referenced-class))
-  (error "~s can't be finalized." fwc))
 
 (defun %allocate-gf-instance (class)