[armedbear-cvs] r12455 - branches/metaclass/abcl/src/org/armedbear/lisp

[Erik Huelsmann]

Author: ehuelsmann
Date: Fri Feb 12 18:54:42 2010
New Revision: 12455

Log:
Make STANDARD-CLASS a normal STANDARD-OBJECT with
 a normal Layout and normal slots. Of course, that
 requires some support from its superclasses (SlotClass
 and LispClass).

Modified:
   branches/metaclass/abcl/src/org/armedbear/lisp/LispClass.java
   branches/metaclass/abcl/src/org/armedbear/lisp/SlotClass.java
   branches/metaclass/abcl/src/org/armedbear/lisp/StandardClass.java

Modified: branches/metaclass/abcl/src/org/armedbear/lisp/LispClass.java
==============================================================================
--- branches/metaclass/abcl/src/org/armedbear/lisp/LispClass.java	(original)
+++ branches/metaclass/abcl/src/org/armedbear/lisp/LispClass.java	Fri Feb 12 18:54:42 2010
@@ -98,20 +98,24 @@
   public LispObject documentation = NIL; // FIXME! Should be private!
   private boolean finalized;
 
-  protected LispClass()
+  protected LispClass(Layout layout)
   {
+    super(layout, layout == null ? 0 : layout.getLength());
     sxhash = hashCode() & 0x7fffffff;
   }
 
-  protected LispClass(Symbol symbol)
+  protected LispClass(Layout layout, Symbol symbol)
   {
+    super(layout, layout == null ? 0 : layout.getLength());
     sxhash = hashCode() & 0x7fffffff;
     this.symbol = symbol;
     this.directSuperclasses = NIL;
   }
 
-  protected LispClass(Symbol symbol, LispObject directSuperclasses)
+  protected LispClass(Layout layout,
+                      Symbol symbol, LispObject directSuperclasses)
   {
+    super(layout, layout == null ? 0 : layout.getLength());
     sxhash = hashCode() & 0x7fffffff;
     this.symbol = symbol;
     this.directSuperclasses = directSuperclasses;

Modified: branches/metaclass/abcl/src/org/armedbear/lisp/SlotClass.java
==============================================================================
--- branches/metaclass/abcl/src/org/armedbear/lisp/SlotClass.java	(original)
+++ branches/metaclass/abcl/src/org/armedbear/lisp/SlotClass.java	Fri Feb 12 18:54:42 2010
@@ -42,13 +42,15 @@
     private LispObject directDefaultInitargs = NIL;
     private LispObject defaultInitargs = NIL;
 
-    public SlotClass()
+    public SlotClass(Layout layout)
     {
+      super(layout);
     }
 
-    public SlotClass(Symbol symbol, LispObject directSuperclasses)
+    public SlotClass(Layout layout,
+                     Symbol symbol, LispObject directSuperclasses)
     {
-        super(symbol, directSuperclasses);
+        super(layout, symbol, directSuperclasses);
     }
 
     @Override

Modified: branches/metaclass/abcl/src/org/armedbear/lisp/StandardClass.java
==============================================================================
--- branches/metaclass/abcl/src/org/armedbear/lisp/StandardClass.java	(original)
+++ branches/metaclass/abcl/src/org/armedbear/lisp/StandardClass.java	Fri Feb 12 18:54:42 2010
@@ -37,21 +37,38 @@
 
 public class StandardClass extends SlotClass
 {
+
+  static Layout layoutStandardClass =
+      new Layout(null,
+                 list(PACKAGE_MOP.intern("NAME"),
+                      PACKAGE_MOP.intern("LAYOUT"),
+                      PACKAGE_MOP.intern("DIRECT-SUPERCLASSES"),
+                      PACKAGE_MOP.intern("DIRECT-SUBCLASSES"),
+                      PACKAGE_MOP.intern("CLASS-PRECEDENCE-LIST"),
+                      PACKAGE_MOP.intern("DIRECT-METHODS"),
+                      PACKAGE_MOP.intern("DOCUMENTATION"),
+                      PACKAGE_MOP.intern("DIRECT-SLOTS"),
+                      PACKAGE_MOP.intern("SLOTS"),
+                      PACKAGE_MOP.intern("DIRECT-DEFAULT-INITARGS"),
+                      PACKAGE_MOP.intern("DEFAULT-INITARGS")),
+                 NIL)
+      {
+        @Override
+        public LispClass getLispClass()
+        {
+          return STANDARD_CLASS;
+        }
+      };
+
   public StandardClass()
   {
-    setClassLayout(new Layout(this, NIL, NIL));
+      super(layoutStandardClass);
   }
 
   public StandardClass(Symbol symbol, LispObject directSuperclasses)
   {
-    super(symbol, directSuperclasses);
-    setClassLayout(new Layout(this, NIL, NIL));
-  }
-
-  @Override
-  public LispObject typeOf()
-  {
-    return Symbol.STANDARD_CLASS;
+      super(layoutStandardClass,
+          symbol, directSuperclasses);
   }
 
   @Override
@@ -114,6 +131,16 @@
   public static final StandardClass STANDARD_OBJECT =
     addStandardClass(Symbol.STANDARD_OBJECT, list(BuiltInClass.CLASS_T));
 
+  public static final StandardClass SLOT_DEFINITION =
+    new SlotDefinitionClass();
+  static
+  {
+    addClass(Symbol.SLOT_DEFINITION, SLOT_DEFINITION);
+
+    STANDARD_CLASS.setClassLayout(layoutStandardClass);
+    STANDARD_CLASS.setDirectSlotDefinitions(STANDARD_CLASS.getClassLayout().generateSlotDefinitions());
+  }
+
   // BuiltInClass.FUNCTION is also null here (see previous comment).
   public static final StandardClass GENERIC_FUNCTION =
     addStandardClass(Symbol.GENERIC_FUNCTION, list(BuiltInClass.FUNCTION,
@@ -259,13 +286,6 @@
     addClass(Symbol.STANDARD_GENERIC_FUNCTION, STANDARD_GENERIC_FUNCTION);
   }
 
-  public static final StandardClass SLOT_DEFINITION =
-    new SlotDefinitionClass();
-  static
-  {
-    addClass(Symbol.SLOT_DEFINITION, SLOT_DEFINITION);
-  }
-
   public static void initializeStandardClasses()
   {
     // We need to call setDirectSuperclass() here for classes that have a