[armedbear-cvs] r12462 - branches/metaclass/abcl/src/org/armedbear/lisp
Erik Huelsmann
ehuelsmann at common-lisp.net
Sat Feb 13 22:16:57 UTC 2010
Author: ehuelsmann
Date: Sat Feb 13 17:16:55 2010
New Revision: 12462
Log:
In order to make StandardClass use its NAME slot
instead of LispClass's 'symbol' field:
- Rename 'symbol' to 'name', making it private
- Rename the 'symbol' java property accessors everywhere
- Add getName() / setName() overrides in StandardClass
which write to the slot instead of the field
Modified:
branches/metaclass/abcl/src/org/armedbear/lisp/BuiltInClass.java
branches/metaclass/abcl/src/org/armedbear/lisp/Condition.java
branches/metaclass/abcl/src/org/armedbear/lisp/ForwardReferencedClass.java
branches/metaclass/abcl/src/org/armedbear/lisp/LispClass.java
branches/metaclass/abcl/src/org/armedbear/lisp/Primitives.java
branches/metaclass/abcl/src/org/armedbear/lisp/SlotClass.java
branches/metaclass/abcl/src/org/armedbear/lisp/StandardClass.java
branches/metaclass/abcl/src/org/armedbear/lisp/StandardGenericFunction.java
branches/metaclass/abcl/src/org/armedbear/lisp/StandardMethod.java
branches/metaclass/abcl/src/org/armedbear/lisp/StandardObject.java
branches/metaclass/abcl/src/org/armedbear/lisp/StructureClass.java
branches/metaclass/abcl/src/org/armedbear/lisp/StructureObject.java
branches/metaclass/abcl/src/org/armedbear/lisp/make_condition.java
Modified: branches/metaclass/abcl/src/org/armedbear/lisp/BuiltInClass.java
==============================================================================
--- branches/metaclass/abcl/src/org/armedbear/lisp/BuiltInClass.java (original)
+++ branches/metaclass/abcl/src/org/armedbear/lisp/BuiltInClass.java Sat Feb 13 17:16:55 2010
@@ -74,7 +74,7 @@
public String writeToString()
{
StringBuilder sb = new StringBuilder("#<BUILT-IN-CLASS ");
- sb.append(symbol.writeToString());
+ sb.append(getName().writeToString());
sb.append('>');
return sb.toString();
}
Modified: branches/metaclass/abcl/src/org/armedbear/lisp/Condition.java
==============================================================================
--- branches/metaclass/abcl/src/org/armedbear/lisp/Condition.java (original)
+++ branches/metaclass/abcl/src/org/armedbear/lisp/Condition.java Sat Feb 13 17:16:55 2010
@@ -139,7 +139,7 @@
{
LispClass c = getLispClass();
if (c != null)
- return c.getSymbol();
+ return c.getName();
return Symbol.CONDITION;
}
Modified: branches/metaclass/abcl/src/org/armedbear/lisp/ForwardReferencedClass.java
==============================================================================
--- branches/metaclass/abcl/src/org/armedbear/lisp/ForwardReferencedClass.java (original)
+++ branches/metaclass/abcl/src/org/armedbear/lisp/ForwardReferencedClass.java Sat Feb 13 17:16:55 2010
@@ -69,9 +69,9 @@
{
StringBuffer sb =
new StringBuffer(Symbol.FORWARD_REFERENCED_CLASS.writeToString());
- if (symbol != null) {
+ if (getName() != null) {
sb.append(' ');
- sb.append(symbol.writeToString());
+ sb.append(getName().writeToString());
}
return unreadableString(sb.toString());
}
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 Sat Feb 13 17:16:55 2010
@@ -88,7 +88,7 @@
private final int sxhash;
- protected Symbol symbol;
+ private LispObject name;
private LispObject propertyList;
private Layout classLayout;
private LispObject directSuperclasses = NIL;
@@ -104,12 +104,16 @@
sxhash = hashCode() & 0x7fffffff;
}
+ 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;
- this.symbol = symbol;
- this.directSuperclasses = NIL;
}
protected LispClass(Layout layout,
@@ -117,7 +121,7 @@
{
super(layout, layout == null ? 0 : layout.getLength());
sxhash = hashCode() & 0x7fffffff;
- this.symbol = symbol;
+ setName(symbol);
this.directSuperclasses = directSuperclasses;
}
@@ -125,7 +129,7 @@
public LispObject getParts()
{
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("DIRECT-SUPERCLASSES", directSuperclasses));
result = result.push(new Cons("DIRECT-SUBCLASSES", directSubclasses));
@@ -141,9 +145,14 @@
return sxhash;
}
- public final Symbol getSymbol()
+ public LispObject getName()
{
- return symbol;
+ return name;
+ }
+
+ public void setName(LispObject name)
+ {
+ this.name = name;
}
@Override
@@ -290,11 +299,6 @@
list(obj1, obj2, obj3, obj4, obj5, obj6, obj7, obj8, obj9);
}
- public String getName()
- {
- return symbol.getName();
- }
-
@Override
public LispObject typeOf()
{
Modified: branches/metaclass/abcl/src/org/armedbear/lisp/Primitives.java
==============================================================================
--- branches/metaclass/abcl/src/org/armedbear/lisp/Primitives.java (original)
+++ branches/metaclass/abcl/src/org/armedbear/lisp/Primitives.java Sat Feb 13 17:16:55 2010
@@ -5132,7 +5132,7 @@
@Override
public LispObject execute(LispObject arg)
{
- return checkClass(arg).symbol;
+ return checkClass(arg).getName();
}
};
@@ -5144,7 +5144,7 @@
public LispObject execute(LispObject first, LispObject second)
{
- checkClass(first).symbol = checkSymbol(second);
+ checkClass(first).setName(checkSymbol(second));
return second;
}
};
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 Sat Feb 13 17:16:55 2010
@@ -47,6 +47,13 @@
super(layout);
}
+ public SlotClass(Symbol symbol, LispObject directSuperclasses)
+
+
+ {
+ this(null, symbol, directSuperclasses);
+ }
+
public SlotClass(Layout layout,
Symbol symbol, LispObject directSuperclasses)
{
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 Sat Feb 13 17:16:55 2010
@@ -38,9 +38,11 @@
public class StandardClass extends SlotClass
{
+ private static Symbol name = PACKAGE_MOP.intern("NAME");
+
static Layout layoutStandardClass =
new Layout(null,
- list(PACKAGE_MOP.intern("NAME"),
+ list(name,
PACKAGE_MOP.intern("LAYOUT"),
PACKAGE_MOP.intern("DIRECT-SUPERCLASSES"),
PACKAGE_MOP.intern("DIRECT-SUBCLASSES"),
@@ -68,7 +70,19 @@
public StandardClass(Symbol symbol, LispObject directSuperclasses)
{
super(layoutStandardClass,
- symbol, directSuperclasses);
+ symbol, directSuperclasses);
+ }
+
+ @Override
+ public LispObject getName()
+ {
+ return getInstanceSlotValue(name);
+ }
+
+ @Override
+ public void setName(LispObject newName)
+ {
+ setInstanceSlotValue(name, newName);
}
@Override
@@ -106,10 +120,10 @@
{
StringBuilder sb =
new StringBuilder(Symbol.STANDARD_CLASS.writeToString());
- if (symbol != null)
+ if (getName() != null)
{
sb.append(' ');
- sb.append(symbol.writeToString());
+ sb.append(getName().writeToString());
}
return unreadableString(sb.toString());
}
@@ -295,6 +309,7 @@
STANDARD_OBJECT.setDirectSuperclass(BuiltInClass.CLASS_T);
GENERIC_FUNCTION.setDirectSuperclasses(list(BuiltInClass.FUNCTION,
STANDARD_OBJECT));
+ // GENERIC_FUNCTION.setSlots();
ARITHMETIC_ERROR.setCPL(ARITHMETIC_ERROR, ERROR, SERIOUS_CONDITION,
CONDITION, STANDARD_OBJECT, BuiltInClass.CLASS_T);
@@ -305,8 +320,10 @@
list(PACKAGE_CL.intern("ARITHMETIC-ERROR-OPERANDS")))));
BUILT_IN_CLASS.setCPL(BUILT_IN_CLASS, CLASS, STANDARD_OBJECT,
BuiltInClass.CLASS_T);
+ // BUILT_IN_CLASS.setSlots();
JAVA_CLASS.setCPL(JAVA_CLASS, CLASS, STANDARD_OBJECT,
BuiltInClass.CLASS_T);
+ // JAVA_CLASS.setSlots();
CELL_ERROR.setCPL(CELL_ERROR, ERROR, SERIOUS_CONDITION, CONDITION,
STANDARD_OBJECT, BuiltInClass.CLASS_T);
CELL_ERROR.setDirectSlotDefinitions(
@@ -315,9 +332,11 @@
CLASS.setCPL(CLASS, STANDARD_OBJECT, BuiltInClass.CLASS_T);
COMPILER_ERROR.setCPL(COMPILER_ERROR, CONDITION, STANDARD_OBJECT,
BuiltInClass.CLASS_T);
+// COMPILER_ERROR.setSlots();
COMPILER_UNSUPPORTED_FEATURE_ERROR.setCPL(COMPILER_UNSUPPORTED_FEATURE_ERROR,
CONDITION, STANDARD_OBJECT,
BuiltInClass.CLASS_T);
+// COMPILER_UNSUPPORTED_FEATURE_ERROR.setSlots();
CONDITION.setCPL(CONDITION, STANDARD_OBJECT, BuiltInClass.CLASS_T);
CONDITION.setDirectSlotDefinitions(
list(new SlotDefinition(Symbol.FORMAT_CONTROL,
@@ -331,9 +350,11 @@
new Environment())));
CONTROL_ERROR.setCPL(CONTROL_ERROR, ERROR, SERIOUS_CONDITION, CONDITION,
STANDARD_OBJECT, BuiltInClass.CLASS_T);
+// CONTROL_ERROR.setSlots();
DIVISION_BY_ZERO.setCPL(DIVISION_BY_ZERO, ARITHMETIC_ERROR, ERROR,
SERIOUS_CONDITION, CONDITION, STANDARD_OBJECT,
BuiltInClass.CLASS_T);
+// DIVISION_BY_ZERO.setSlots();
END_OF_FILE.setCPL(END_OF_FILE, STREAM_ERROR, ERROR, SERIOUS_CONDITION,
CONDITION, STANDARD_OBJECT, BuiltInClass.CLASS_T);
ERROR.setCPL(ERROR, SERIOUS_CONDITION, CONDITION, STANDARD_OBJECT,
Modified: branches/metaclass/abcl/src/org/armedbear/lisp/StandardGenericFunction.java
==============================================================================
--- branches/metaclass/abcl/src/org/armedbear/lisp/StandardGenericFunction.java (original)
+++ branches/metaclass/abcl/src/org/armedbear/lisp/StandardGenericFunction.java Sat Feb 13 17:16:55 2010
@@ -209,7 +209,7 @@
if (name != null)
{
StringBuilder sb = new StringBuilder();
- sb.append(getLispClass().getSymbol().writeToString());
+ sb.append(getLispClass().getName().writeToString());
sb.append(' ');
sb.append(name.writeToString());
return unreadableString(sb.toString());
Modified: branches/metaclass/abcl/src/org/armedbear/lisp/StandardMethod.java
==============================================================================
--- branches/metaclass/abcl/src/org/armedbear/lisp/StandardMethod.java (original)
+++ branches/metaclass/abcl/src/org/armedbear/lisp/StandardMethod.java Sat Feb 13 17:16:55 2010
@@ -156,7 +156,7 @@
if (name != null)
{
StringBuilder sb = new StringBuilder();
- sb.append(getLispClass().getSymbol().writeToString());
+ sb.append(getLispClass().getName().writeToString());
sb.append(' ');
sb.append(name.writeToString());
LispObject specializers =
@@ -169,7 +169,7 @@
{
LispObject spec = specs.car();
if (spec instanceof LispClass)
- names = names.push(((LispClass)spec).getSymbol());
+ names = names.push(((LispClass)spec).getName());
else
names = names.push(spec);
specs = specs.cdr();
Modified: branches/metaclass/abcl/src/org/armedbear/lisp/StandardObject.java
==============================================================================
--- branches/metaclass/abcl/src/org/armedbear/lisp/StandardObject.java (original)
+++ branches/metaclass/abcl/src/org/armedbear/lisp/StandardObject.java Sat Feb 13 17:16:55 2010
@@ -113,13 +113,13 @@
final LispClass c1 = layout.getLispClass();
// The proper name of a class is "a symbol that names the class whose
// name is that symbol".
- final Symbol symbol = c1.getSymbol();
- if (symbol != NIL)
+ final LispObject name = c1.getName();
+ if (name != NIL && name != UNBOUND_VALUE)
{
// TYPE-OF.9
- final LispObject c2 = LispClass.findClass(symbol);
+ final LispObject c2 = LispClass.findClass(checkSymbol(name));
if (c2 == c1)
- return symbol;
+ return name;
}
return c1;
}
@@ -142,14 +142,14 @@
{
if (type == cls)
return T;
- if (type == cls.getSymbol())
+ if (type == cls.getName())
return T;
LispObject cpl = cls.getCPL();
while (cpl != NIL)
{
if (type == cpl.car())
return T;
- if (type == ((LispClass)cpl.car()).getSymbol())
+ if (type == ((LispClass)cpl.car()).getName())
return T;
cpl = cpl.cdr();
}
Modified: branches/metaclass/abcl/src/org/armedbear/lisp/StructureClass.java
==============================================================================
--- branches/metaclass/abcl/src/org/armedbear/lisp/StructureClass.java (original)
+++ branches/metaclass/abcl/src/org/armedbear/lisp/StructureClass.java Sat Feb 13 17:16:55 2010
@@ -79,7 +79,7 @@
public String writeToString()
{
StringBuffer sb = new StringBuffer("#<STRUCTURE-CLASS ");
- sb.append(symbol.writeToString());
+ sb.append(getName().writeToString());
sb.append('>');
return sb.toString();
}
Modified: branches/metaclass/abcl/src/org/armedbear/lisp/StructureObject.java
==============================================================================
--- branches/metaclass/abcl/src/org/armedbear/lisp/StructureObject.java (original)
+++ branches/metaclass/abcl/src/org/armedbear/lisp/StructureObject.java Sat Feb 13 17:16:55 2010
@@ -144,7 +144,7 @@
@Override
public LispObject typeOf()
{
- return structureClass.getSymbol();
+ return structureClass.getName();
}
@Override
@@ -175,7 +175,7 @@
{
if (type instanceof StructureClass)
return memq(type, structureClass.getCPL()) ? T : NIL;
- if (type == structureClass.getSymbol())
+ if (type == structureClass.getName())
return T;
if (type == Symbol.STRUCTURE_OBJECT)
return T;
@@ -421,7 +421,7 @@
return stream.getString().getStringValue();
}
if (_PRINT_STRUCTURE_.symbolValue(thread) == NIL)
- return unreadableString(structureClass.getSymbol().writeToString());
+ return unreadableString(structureClass.getName().writeToString());
int maxLevel = Integer.MAX_VALUE;
LispObject printLevel = Symbol.PRINT_LEVEL.symbolValue(thread);
if (printLevel instanceof Fixnum)
@@ -432,7 +432,7 @@
if (currentLevel >= maxLevel && slots.length > 0)
return "#";
StringBuilder sb = new StringBuilder("#S(");
- sb.append(structureClass.getSymbol().writeToString());
+ sb.append(structureClass.getName().writeToString());
if (currentLevel < maxLevel)
{
LispObject effectiveSlots = structureClass.getSlotDefinitions();
Modified: branches/metaclass/abcl/src/org/armedbear/lisp/make_condition.java
==============================================================================
--- branches/metaclass/abcl/src/org/armedbear/lisp/make_condition.java (original)
+++ branches/metaclass/abcl/src/org/armedbear/lisp/make_condition.java Sat Feb 13 17:16:55 2010
@@ -52,7 +52,7 @@
if (type instanceof Symbol)
symbol = (Symbol) type;
else if (type instanceof LispClass)
- symbol = ((LispClass)type).getSymbol();
+ symbol = checkSymbol(((LispClass)type).getName());
else {
// This function only works on symbols and classes.
return NIL;
More information about the armedbear-cvs
mailing list