Merge 'metaclass' branch, making STANDARD-CLASS have slots to

  be inherited by deriving metaclasses.

Note: this does definitely *not* complete the metaclass work.
parent b8072234
...@@ -74,7 +74,7 @@ public class BuiltInClass extends LispClass ...@@ -74,7 +74,7 @@ public class BuiltInClass extends LispClass
public String writeToString() public String writeToString()
{ {
StringBuilder sb = new StringBuilder("#<BUILT-IN-CLASS "); StringBuilder sb = new StringBuilder("#<BUILT-IN-CLASS ");
sb.append(symbol.writeToString()); sb.append(getName().writeToString());
sb.append('>'); sb.append('>');
return sb.toString(); return sb.toString();
} }
......
...@@ -139,7 +139,7 @@ public class Condition extends StandardObject ...@@ -139,7 +139,7 @@ public class Condition extends StandardObject
{ {
LispClass c = getLispClass(); LispClass c = getLispClass();
if (c != null) if (c != null)
return c.getSymbol(); return c.getName();
return Symbol.CONDITION; return Symbol.CONDITION;
} }
......
...@@ -69,9 +69,9 @@ public class ForwardReferencedClass extends LispClass ...@@ -69,9 +69,9 @@ public class ForwardReferencedClass extends LispClass
{ {
StringBuffer sb = StringBuffer sb =
new StringBuffer(Symbol.FORWARD_REFERENCED_CLASS.writeToString()); new StringBuffer(Symbol.FORWARD_REFERENCED_CLASS.writeToString());
if (symbol != null) { if (getName() != null) {
sb.append(' '); sb.append(' ');
sb.append(symbol.writeToString()); sb.append(getName().writeToString());
} }
return unreadableString(sb.toString()); return unreadableString(sb.toString());
} }
......
...@@ -35,9 +35,9 @@ package org.armedbear.lisp; ...@@ -35,9 +35,9 @@ package org.armedbear.lisp;
import static org.armedbear.lisp.Lisp.*; import static org.armedbear.lisp.Lisp.*;
public final class Layout extends LispObject public class Layout extends LispObject
{ {
public final LispClass lispClass; private final LispClass lispClass;
public final EqHashTable slotTable; public final EqHashTable slotTable;
private final LispObject[] slotNames; private final LispObject[] slotNames;
...@@ -76,7 +76,7 @@ public final class Layout extends LispObject ...@@ -76,7 +76,7 @@ public final class Layout extends LispObject
// Copy constructor. // Copy constructor.
private Layout(Layout oldLayout) private Layout(Layout oldLayout)
{ {
lispClass = oldLayout.lispClass; lispClass = oldLayout.getLispClass();
slotNames = oldLayout.slotNames; slotNames = oldLayout.slotNames;
sharedSlots = oldLayout.sharedSlots; sharedSlots = oldLayout.sharedSlots;
slotTable = initializeSlotTable(slotNames); slotTable = initializeSlotTable(slotNames);
...@@ -94,7 +94,7 @@ public final class Layout extends LispObject ...@@ -94,7 +94,7 @@ public final class Layout extends LispObject
public LispObject getParts() public LispObject getParts()
{ {
LispObject result = NIL; LispObject result = NIL;
result = result.push(new Cons("class", lispClass)); result = result.push(new Cons("class", getLispClass()));
for (int i = 0; i < slotNames.length; i++) for (int i = 0; i < slotNames.length; i++)
{ {
result = result.push(new Cons("slot " + i, slotNames[i])); result = result.push(new Cons("slot " + i, slotNames[i]));
...@@ -103,6 +103,11 @@ public final class Layout extends LispObject ...@@ -103,6 +103,11 @@ public final class Layout extends LispObject
return result.nreverse(); return result.nreverse();
} }
public LispClass getLispClass()
{
return lispClass;
}
public boolean isInvalid() public boolean isInvalid()
{ {
return invalid; return invalid;
...@@ -167,7 +172,7 @@ public final class Layout extends LispObject ...@@ -167,7 +172,7 @@ public final class Layout extends LispObject
@Override @Override
public LispObject execute(LispObject arg) public LispObject execute(LispObject arg)
{ {
return checkLayout(arg).lispClass; return checkLayout(arg).getLispClass();
} }
}; };
......
...@@ -88,46 +88,57 @@ public abstract class LispClass extends StandardObject ...@@ -88,46 +88,57 @@ public abstract class LispClass extends StandardObject
private final int sxhash; private final int sxhash;
protected Symbol symbol; private LispObject name;
private LispObject propertyList; private LispObject propertyList;
private Layout classLayout; private Layout classLayout;
private LispObject directSuperclasses = NIL; private LispObject directSuperclasses = NIL;
private LispObject directSubclasses = NIL; private LispObject directSubclasses = NIL;
public LispObject classPrecedenceList = NIL; // FIXME! Should be private! private LispObject classPrecedenceList = NIL;
public LispObject directMethods = NIL; // FIXME! Should be private! private LispObject directMethods = NIL;
public LispObject documentation = NIL; // FIXME! Should be private! private LispObject documentation = NIL;
private boolean finalized; private boolean finalized;
protected LispClass() protected LispClass(Layout layout)
{ {
super(layout, layout == null ? 0 : layout.getLength());
sxhash = hashCode() & 0x7fffffff; sxhash = hashCode() & 0x7fffffff;
} }
protected LispClass(Symbol symbol) protected LispClass(Symbol symbol)
{ {
this(null, symbol);
}
protected LispClass(Layout layout, Symbol symbol)
{
super(layout, layout == null ? 0 : layout.getLength());
setName(symbol);
sxhash = hashCode() & 0x7fffffff; 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; sxhash = hashCode() & 0x7fffffff;
this.symbol = symbol; setName(symbol);
this.directSuperclasses = directSuperclasses; setDirectSuperclasses(directSuperclasses);
} }
@Override @Override
public LispObject getParts() public LispObject getParts()
{ {
LispObject result = NIL; LispObject result = NIL;
result = result.push(new Cons("NAME", symbol != null ? symbol : NIL)); result = result.push(new Cons("NAME", name != null ? name : NIL));
result = result.push(new Cons("LAYOUT", classLayout != null ? classLayout : NIL)); result = result.push(new Cons("LAYOUT",
result = result.push(new Cons("DIRECT-SUPERCLASSES", directSuperclasses)); getClassLayout() != null
result = result.push(new Cons("DIRECT-SUBCLASSES", directSubclasses)); ? getClassLayout() : NIL));
result = result.push(new Cons("CLASS-PRECEDENCE-LIST", classPrecedenceList)); result = result.push(new Cons("DIRECT-SUPERCLASSES",
result = result.push(new Cons("DIRECT-METHODS", directMethods)); getDirectSuperclasses()));
result = result.push(new Cons("DOCUMENTATION", documentation)); result = result.push(new Cons("DIRECT-SUBCLASSES", getDirectSubclasses()));
result = result.push(new Cons("CLASS-PRECEDENCE-LIST", getCPL()));
result = result.push(new Cons("DIRECT-METHODS", getDirectMethods()));
result = result.push(new Cons("DOCUMENTATION", getDocumentation()));
return result.nreverse(); return result.nreverse();
} }
...@@ -137,9 +148,14 @@ public abstract class LispClass extends StandardObject ...@@ -137,9 +148,14 @@ public abstract class LispClass extends StandardObject
return sxhash; return sxhash;
} }
public final Symbol getSymbol() public LispObject getName()
{ {
return symbol; return name;
}
public void setName(LispObject name)
{
this.name = name;
} }
@Override @Override
...@@ -158,12 +174,12 @@ public abstract class LispClass extends StandardObject ...@@ -158,12 +174,12 @@ public abstract class LispClass extends StandardObject
propertyList = obj; propertyList = obj;
} }
public final Layout getClassLayout() public Layout getClassLayout()
{ {
return classLayout; return classLayout;
} }
public final void setClassLayout(Layout layout) public void setClassLayout(Layout layout)
{ {
classLayout = layout; classLayout = layout;
} }
...@@ -175,12 +191,12 @@ public abstract class LispClass extends StandardObject ...@@ -175,12 +191,12 @@ public abstract class LispClass extends StandardObject
return layout.getLength(); return layout.getLength();
} }
public final LispObject getDirectSuperclasses() public LispObject getDirectSuperclasses()
{ {
return directSuperclasses; return directSuperclasses;
} }
public final void setDirectSuperclasses(LispObject directSuperclasses) public void setDirectSuperclasses(LispObject directSuperclasses)
{ {
this.directSuperclasses = directSuperclasses; this.directSuperclasses = directSuperclasses;
} }
...@@ -198,97 +214,57 @@ public abstract class LispClass extends StandardObject ...@@ -198,97 +214,57 @@ public abstract class LispClass extends StandardObject
// When there's only one direct superclass... // When there's only one direct superclass...
public final void setDirectSuperclass(LispObject superclass) public final void setDirectSuperclass(LispObject superclass)
{ {
directSuperclasses = new Cons(superclass); setDirectSuperclasses(new Cons(superclass));
} }
public final LispObject getDirectSubclasses() public LispObject getDirectSubclasses()
{ {
return directSubclasses; return directSubclasses;
} }
public final void setDirectSubclasses(LispObject directSubclasses) public void setDirectSubclasses(LispObject directSubclasses)
{ {
this.directSubclasses = directSubclasses; this.directSubclasses = directSubclasses;
} }
public final LispObject getCPL() public LispObject getCPL()
{ {
return classPrecedenceList; return classPrecedenceList;
} }
public final void setCPL(LispObject obj1) public void setCPL(LispObject... cpl)
{ {
if (obj1 instanceof Cons) LispObject obj1 = cpl[0];
if (obj1 instanceof Cons && cpl.length == 1)
classPrecedenceList = obj1; classPrecedenceList = obj1;
else else
{ {
Debug.assertTrue(obj1 == this); Debug.assertTrue(obj1 == this);
classPrecedenceList = new Cons(obj1); LispObject l = NIL;
for (int i = cpl.length; i-- > 0;)
l = new Cons(cpl[i], l);
classPrecedenceList = l;
} }
} }
public final void setCPL(LispObject obj1, LispObject obj2) public LispObject getDirectMethods()
{
Debug.assertTrue(obj1 == this);
classPrecedenceList = list(obj1, obj2);
}
public final void setCPL(LispObject obj1, LispObject obj2, LispObject obj3)
{
Debug.assertTrue(obj1 == this);
classPrecedenceList = list(obj1, obj2, obj3);
}
public final void setCPL(LispObject obj1, LispObject obj2, LispObject obj3,
LispObject obj4)
{
Debug.assertTrue(obj1 == this);
classPrecedenceList = list(obj1, obj2, obj3, obj4);
}
public final void setCPL(LispObject obj1, LispObject obj2, LispObject obj3,
LispObject obj4, LispObject obj5)
{
Debug.assertTrue(obj1 == this);
classPrecedenceList = list(obj1, obj2, obj3, obj4, obj5);
}
public final void setCPL(LispObject obj1, LispObject obj2, LispObject obj3,
LispObject obj4, LispObject obj5, LispObject obj6)
{
Debug.assertTrue(obj1 == this);
classPrecedenceList = list(obj1, obj2, obj3, obj4, obj5, obj6);
}
public final void setCPL(LispObject obj1, LispObject obj2, LispObject obj3,
LispObject obj4, LispObject obj5, LispObject obj6,
LispObject obj7)
{ {
Debug.assertTrue(obj1 == this); return directMethods;
classPrecedenceList = list(obj1, obj2, obj3, obj4, obj5, obj6, obj7);
} }
public final void setCPL(LispObject obj1, LispObject obj2, LispObject obj3, public void setDirectMethods(LispObject methods)
LispObject obj4, LispObject obj5, LispObject obj6,
LispObject obj7, LispObject obj8)
{ {
Debug.assertTrue(obj1 == this); directMethods = methods;
classPrecedenceList =
list(obj1, obj2, obj3, obj4, obj5, obj6, obj7, obj8);
} }
public final void setCPL(LispObject obj1, LispObject obj2, LispObject obj3, public LispObject getDocumentation()
LispObject obj4, LispObject obj5, LispObject obj6,
LispObject obj7, LispObject obj8, LispObject obj9)
{ {
Debug.assertTrue(obj1 == this); return documentation;
classPrecedenceList =
list(obj1, obj2, obj3, obj4, obj5, obj6, obj7, obj8, obj9);
} }
public String getName() public void setDocumentation(LispObject doc)
{ {
return symbol.getName(); documentation = doc;
} }
@Override @Override
...@@ -315,7 +291,7 @@ public abstract class LispClass extends StandardObject ...@@ -315,7 +291,7 @@ public abstract class LispClass extends StandardObject
public boolean subclassp(LispObject obj) public boolean subclassp(LispObject obj)
{ {
LispObject cpl = classPrecedenceList; LispObject cpl = getCPL();
while (cpl != NIL) while (cpl != NIL)
{ {
if (cpl.car() == obj) if (cpl.car() == obj)
......
...@@ -5316,7 +5316,7 @@ for (LispObject a : args) ...@@ -5316,7 +5316,7 @@ for (LispObject a : args)
@Override @Override
public LispObject execute(LispObject arg) { public LispObject execute(LispObject arg) {
return checkClass(arg).symbol; return checkClass(arg).getName();
} }
}; };
...@@ -5331,7 +5331,7 @@ for (LispObject a : args) ...@@ -5331,7 +5331,7 @@ for (LispObject a : args)
public LispObject execute(LispObject first, LispObject second) public LispObject execute(LispObject first, LispObject second)
{ {
checkClass(first).symbol = checkSymbol(second); checkClass(first).setName(checkSymbol(second));
return second; return second;
} }
}; };
...@@ -5452,7 +5452,7 @@ for (LispObject a : args) ...@@ -5452,7 +5452,7 @@ for (LispObject a : args)
public LispObject execute(LispObject first, LispObject second) public LispObject execute(LispObject first, LispObject second)
{ {
checkClass(first).classPrecedenceList = second; checkClass(first).setCPL(second);
return second; return second;
} }
}; };
...@@ -5468,7 +5468,7 @@ for (LispObject a : args) ...@@ -5468,7 +5468,7 @@ for (LispObject a : args)
public LispObject execute(LispObject arg) public LispObject execute(LispObject arg)
{ {
return checkClass(arg).directMethods; return checkClass(arg).getDirectMethods();
} }
}; };
...@@ -5483,13 +5483,14 @@ for (LispObject a : args) ...@@ -5483,13 +5483,14 @@ for (LispObject a : args)
public LispObject execute(LispObject first, LispObject second) public LispObject execute(LispObject first, LispObject second)
{ {
checkClass(first).directMethods = second; checkClass(first).setDirectMethods(second);
return second; return second;
} }
}; };
// ### class-documentation // ### class-documentation
private static final Primitive CLASS_DOCUMENTATION = new pf_class_documentation(); private static final Primitive CLASS_DOCUMENTATION
= new pf_class_documentation();
private static final class pf_class_documentation extends Primitive { private static final class pf_class_documentation extends Primitive {
pf_class_documentation() { pf_class_documentation() {
super("class-documentation", PACKAGE_SYS, true); super("class-documentation", PACKAGE_SYS, true);
...@@ -5499,12 +5500,13 @@ for (LispObject a : args) ...@@ -5499,12 +5500,13 @@ for (LispObject a : args)
public LispObject execute(LispObject arg) public LispObject execute(LispObject arg)
{ {
return checkClass(arg).documentation; return checkClass(arg).getDocumentation();
} }
}; };
// ### %set-class-documentation // ### %set-class-documentation
private static final Primitive _SET_CLASS_DOCUMENTATION = new pf__set_class_documentation(); private static final Primitive _SET_CLASS_DOCUMENTATION
= new pf__set_class_documentation();
private static final class pf__set_class_documentation extends Primitive { private static final class pf__set_class_documentation extends Primitive {
pf__set_class_documentation() { pf__set_class_documentation() {
super("%set-class-documentation", PACKAGE_SYS, true); super("%set-class-documentation", PACKAGE_SYS, true);
...@@ -5514,7 +5516,7 @@ for (LispObject a : args) ...@@ -5514,7 +5516,7 @@ for (LispObject a : args)
public LispObject execute(LispObject first, LispObject second) public LispObject execute(LispObject first, LispObject second)
{ {
checkClass(first).documentation = second; checkClass(first).setDocumentation(second);
return second; return second;
} }
}; };
......
...@@ -42,23 +42,35 @@ public class SlotClass extends LispClass ...@@ -42,23 +42,35 @@ public class SlotClass extends LispClass
private LispObject directDefaultInitargs = NIL; private LispObject directDefaultInitargs = NIL;
private LispObject defaultInitargs = NIL; private LispObject defaultInitargs = NIL;
public SlotClass() public SlotClass(Layout layout)
{ {
super(layout);
} }
public SlotClass(Symbol symbol, LispObject directSuperclasses) public SlotClass(Symbol symbol, LispObject directSuperclasses)
{
this(null, symbol, directSuperclasses);
}
public SlotClass(Layout layout,
Symbol symbol, LispObject directSuperclasses)
{ {
super(symbol, directSuperclasses); super(layout, symbol, directSuperclasses);
} }
@Override @Override
public LispObject getParts() public LispObject getParts()
{ {
LispObject result = super.getParts().nreverse(); LispObject result = super.getParts().nreverse();
result = result.push(new Cons("DIRECT-SLOTS", directSlotDefinitions)); result = result.push(new Cons("DIRECT-SLOTS",
result = result.push(new Cons("SLOTS", slotDefinitions)); getDirectSlotDefinitions()));
result = result.push(new Cons("DIRECT-DEFAULT-INITARGS", directDefaultInitargs)); result = result.push(new Cons("SLOTS", getSlotDefinitions()));
result = result.push(new Cons("DEFAULT-INITARGS", defaultInitargs)); result = result.push(new Cons("DIRECT-DEFAULT-INITARGS",
getDirectDefaultInitargs()));
result = result.push(new Cons("DEFAULT-INITARGS",
getDefaultInitargs()));
return result.nreverse(); return result.nreverse();
} }
...@@ -78,7 +90,7 @@ public class SlotClass extends LispClass ...@@ -78,7 +90,7 @@ public class SlotClass extends LispClass
this.directSlotDefinitions = directSlotDefinitions; this.directSlotDefinitions = directSlotDefinitions;
} }
public final LispObject getSlotDefinitions() public LispObject getSlotDefinitions()
{ {
return slotDefinitions; return slotDefinitions;
} }
...@@ -98,6 +110,11 @@ public class SlotClass extends LispClass ...@@ -98,6 +110,11 @@ public class SlotClass extends LispClass
this.directDefaultInitargs = directDefaultInitargs;