Lots more has happened.

[sod] / class-finalize.lisp

diff --git a/class-finalize.lisp b/class-finalize.lisp
index cf1ff73..fa8cc7d 100644 (file)
--- a/class-finalize.lisp
+++ b/class-finalize.lisp
@@ -169,7 +169,7 @@
          (error "Invalid message name `~A' on class `~A'"
                 (sod-message-name message) class))))
 
-      ;; Check that the slots and messages have distinct names.
+    ;; Check that the slots and messages have distinct names.
     (with-slots (slots messages class-precedence-list) class
       (flet ((check-list (list what namefunc)
               (let ((table (make-hash-table :test #'equal)))
@@ -191,6 +191,19 @@
        (error "In `~A~, chain-to class `~A' is not a proper superclass"
               class chain-link)))
 
+    ;; Check for circularity in the superclass graph.  Since the superclasses
+    ;; should already be acyclic, it suffices to check that our class is not
+    ;; a superclass of any of its own direct superclasses.
+    (let ((circle (find-if (lambda (super)
+                            (sod-subclass-p super class))
+                          (sod-class-direct-superclasses class))))
+      (when circle
+       (error "Circularity: ~A is already a superclass of ~A"
+              class circle)))
+
+    ;; Check that the class has a unique root superclass.
+    (find-root-superclass class)
+
     ;; Check that the metaclass is a subclass of each direct superclass's
     ;; metaclass.
     (with-slots (metaclass direct-superclasses) class
@@ -226,6 +239,10 @@
                     (eq class metaclass))
           (finalize-sod-class metaclass)))
 
+       ;; Stash the class's type.
+       (setf (sod-class-type class)
+            (make-class-type (sod-class-name class)))
+
        ;; Clobber the lists of items if they've not been set.
        (dolist (slot '(slots instance-initializers class-initializers
                       messages methods))