Changeset 9390 for branches

Timestamp:

May 7, 2008, 4:38:23 PM (17 years ago)

Author:

gz

Message:

make class-has-a-forward-referenced-superclass-p be true for compile-time classes, and make class-finalized-p be false. Fixes spurious warnings as per test ccl.40055-2.

Location:

branches/working-0711/ccl

Files:

• compiler/optimizers.lisp (modified) (1 diff)
• level-1/l1-clos.lisp (modified) (4 diffs)

branches/working-0711/ccl/compiler/optimizers.lisp

@@ -643 +643 @@
     (parse-unknown-type (c) (values nil (parse-unknown-type-specifier c)))
     (error () nil)))
+
+#+debugging-version
+(defun specifier-type-if-known (typespec &optional env)
+  (handler-bind ((parse-unknown-type (lambda (c)
+                                       (break "caught unknown-type ~s" c)
+                                       (return-from specifier-type-if-known
+                                         (values nil (parse-unknown-type-specifier c)))))
+                 (error (lambda (c)
+                          (break "caught error ~s" c)
+                          (return-from specifier-type-if-known nil))))
+    (specifier-type typespec env)))
 
 

branches/working-0711/ccl/level-1/l1-clos.lisp

@@ -154 +154 @@
 (defmethod class-default-initargs ((class class)))
 (defmethod class-direct-default-initargs ((class class)))
+
+(defmethod compile-time-class-p ((class class)) nil)
 
 (defmethod direct-slot-definition-class ((class std-class) &key (allocation :instance) &allow-other-keys)
@@ -572 +574 @@
                        (let* ((fwdref (scan-forward-refs s seen)))
                          (when fwdref (return fwdref)))))))))
-    (scan-forward-refs original ())))
+    (or (compile-time-class-p original)
+        (scan-forward-refs original ()))))
 
 (defun class-forward-referenced-superclasses (original)
@@ -625 +628 @@
     (finalize-inheritance class)
     (return-from update-class))
-  (when (or finalizep
-            (class-finalized-p class)
-            (not (class-has-a-forward-referenced-superclass-p class)))
+  (when (or finalizep (class-finalized-p class))
     (let* ((cpl (update-cpl class (compute-class-precedence-list  class))))
       ;; This -should- be made to work for structure classes
@@ -1201 +1202 @@
 ;;; For %compile-time-defclass
 (defclass compile-time-class (class) ())
+
+(defmethod compile-time-class-p ((class compile-time-class))
+  t)
+
+(defmethod class-finalized-p ((class compile-time-class))
+  nil)