chiark / gitweb /
doc/concepts.tex: Typeset method rĂ´le names as identifiers.
[sod] / src / class-utilities.lisp
index 38cb75ef073f422c82fb26ecb2d89e5433da9e02..a26afd29b9695fbac1fd96293bbd2dfef7f7b2b1 100644 (file)
@@ -173,11 +173,12 @@ (defun valid-name-p (name)
      * all of whose characters are alphanumeric or underscores
      * and which doesn't contain two consecutive underscores."
 
-  (and (stringp name)
-       (plusp (length name))
-       (alpha-char-p (char name 0))
-       (every (lambda (ch) (or (alphanumericp ch) (char= ch #\_))) name)
-       (not (search "__" name))))
+  (or (typep name 'temporary-variable)
+      (and (stringp name)
+          (plusp (length name))
+          (alpha-char-p (char name 0))
+          (every (lambda (ch) (or (alphanumericp ch) (char= ch #\_))) name)
+          (not (search "__" name)))))
 
 (export 'find-root-superclass)
 (defun find-root-superclass (class)
@@ -212,10 +213,15 @@ (defun find-root-superclass (class)
                                                   (sod-class-chains super)))
                                         supers)))
                    (list class))))
-    (cond ((null roots) (error "Class ~A has no root class!" class))
-         ((cdr roots) (error "Class ~A has multiple root classes ~
-                              ~{~A~#[~; and ~;, ~]~}"
-                             class roots))
+    (cond ((null roots)
+          (error "Class ~A has no root class!" class))
+         ((cdr roots)
+          (cerror* "Class ~A has multiple root classes ~
+                    ~{~#[~;~A~;~A and ~A~:; ~@{~A, ~#[~;and ~A~]~}~]~}"
+                   class roots)
+          (let ((state (make-inheritance-path-reporter-state class)))
+            (dolist (root roots)
+              (report-inheritance-path state root))))
          (t (car roots)))))
 
 (export 'find-root-metaclass)