[armedbear-cvs] r13541 - trunk/abcl/src/org/armedbear/lisp
mevenson at common-lisp.net
mevenson at common-lisp.net
Sat Aug 27 23:23:25 UTC 2011
Author: mevenson
Date: Sat Aug 27 16:23:24 2011
New Revision: 13541
Log:
Convert docstrings and primitives to standard conventions.
Modified:
trunk/abcl/src/org/armedbear/lisp/SlotClass.java
trunk/abcl/src/org/armedbear/lisp/SlotDefinition.java
trunk/abcl/src/org/armedbear/lisp/StandardGenericFunction.java
trunk/abcl/src/org/armedbear/lisp/StandardMethod.java
trunk/abcl/src/org/armedbear/lisp/StandardObject.java
trunk/abcl/src/org/armedbear/lisp/StandardObjectFunctions.java
trunk/abcl/src/org/armedbear/lisp/StandardReaderMethod.java
trunk/abcl/src/org/armedbear/lisp/StructureObject.java
trunk/abcl/src/org/armedbear/lisp/mop.lisp
Modified: trunk/abcl/src/org/armedbear/lisp/SlotClass.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/SlotClass.java Sat Aug 27 16:23:05 2011 (r13540)
+++ trunk/abcl/src/org/armedbear/lisp/SlotClass.java Sat Aug 27 16:23:24 2011 (r13541)
@@ -176,10 +176,15 @@
setFinalized(true);
}
- // ### class-direct-slots
- private static final Primitive CLASS_DIRECT_SLOTS =
- new Primitive("%class-direct-slots", PACKAGE_SYS, true)
+ @DocString(name="%class-direct-slots")
+ private static final Primitive CLASS_DIRECT_SLOTS
+ = new pf__class_direct_slots();
+ private static final class pf__class_direct_slots extends Primitive
{
+ pf__class_direct_slots()
+ {
+ super("%class-direct-slots", PACKAGE_SYS, true);
+ }
@Override
public LispObject execute(LispObject arg)
@@ -192,31 +197,41 @@
}
};
- // ### %set-class-direct-slots
- private static final Primitive _SET_CLASS_DIRECT_SLOTS =
- new Primitive("%set-class-direct-slots", PACKAGE_SYS, true)
+ @DocString(name="%set-class-direct-slots")
+ private static final Primitive _SET_CLASS_DIRECT_SLOT
+ = new pf__set_class_direct_slots();
+ private static final class pf__set_class_direct_slots extends Primitive
{
+ pf__set_class_direct_slots()
+ {
+ super("%set-class-direct-slots", PACKAGE_SYS, true);
+ }
+
@Override
public LispObject execute(LispObject first, LispObject second)
-
{
- if (second instanceof SlotClass) {
+ if (second instanceof SlotClass) {
((SlotClass)second).setDirectSlotDefinitions(first);
return first;
- }
- else {
+ } else {
return type_error(second, Symbol.STANDARD_CLASS);
}
}
};
- // ### %class-slots
- private static final Primitive _CLASS_SLOTS =
- new Primitive(Symbol._CLASS_SLOTS, "class")
+ @DocString(name="%class-slots",
+ args="class")
+ private static final Primitive _CLASS_SLOTS
+ = new pf__class_slots();
+ private static final class pf__class_slots extends Primitive
{
+ pf__class_slots()
+ {
+ super(Symbol._CLASS_SLOTS, "class");
+ }
+
@Override
public LispObject execute(LispObject arg)
-
{
if (arg instanceof SlotClass)
return ((SlotClass)arg).getSlotDefinitions();
@@ -226,31 +241,39 @@
}
};
- // ### set-class-slots
- private static final Primitive _SET_CLASS_SLOTS =
- new Primitive(Symbol._SET_CLASS_SLOTS, "class slot-definitions")
+ @DocString(name="%set-class-slots",
+ args="class slot-definitions")
+ private static final Primitive _SET_CLASS_SLOTS
+ = new pf__set_class_slots();
+ private static final class pf__set_class_slots extends Primitive
{
+ pf__set_class_slots()
+ {
+ super(Symbol._SET_CLASS_SLOTS, "class slot-definitions");
+ }
@Override
public LispObject execute(LispObject first, LispObject second)
-
{
if (second instanceof SlotClass) {
((SlotClass)second).setSlotDefinitions(first);
return first;
- }
- else {
+ } else {
return type_error(second, Symbol.STANDARD_CLASS);
}
}
};
- // ### class-direct-default-initargs
- private static final Primitive CLASS_DIRECT_DEFAULT_INITARGS =
- new Primitive("%class-direct-default-initargs", PACKAGE_SYS, true)
+ @DocString(name="%class-direct-default-initargs")
+ private static final Primitive CLASS_DIRECT_DEFAULT_INITARGS
+ = new pf__class_direct_default_initargs();
+ private static final class pf__class_direct_default_initargs extends Primitive
{
+ pf__class_direct_default_initargs()
+ {
+ super("%class-direct-default-initargs", PACKAGE_SYS, true);
+ }
@Override
public LispObject execute(LispObject arg)
-
{
if (arg instanceof SlotClass)
return ((SlotClass)arg).getDirectDefaultInitargs();
@@ -260,29 +283,37 @@
}
};
- // ### %set-class-direct-default-initargs
- private static final Primitive _SET_CLASS_DIRECT_DEFAULT_INITARGS =
- new Primitive("%set-class-direct-default-initargs", PACKAGE_SYS, true)
+ @DocString(name="%set-class-direct-default-initargs")
+ private static final Primitive _SET_CLASS_DIRECT_DEFAULT_INITARGS
+ = new pf__set_class_direct_default_initargs();
+ private static final class pf__set_class_direct_default_initargs extends Primitive
{
+ pf__set_class_direct_default_initargs()
+ {
+ super("%set-class-direct-default-initargs", PACKAGE_SYS, true);
+ }
@Override
public LispObject execute(LispObject first, LispObject second)
-
{
if (second instanceof SlotClass) {
- ((SlotClass)second).setDirectDefaultInitargs(first);
- return first;
+ ((SlotClass)second).setDirectDefaultInitargs(first);
+ return first;
}
return type_error(second, Symbol.STANDARD_CLASS);
}
};
- // ### class-default-initargs
- private static final Primitive CLASS_DEFAULT_INITARGS =
- new Primitive("%class-default-initargs", PACKAGE_SYS, true)
+ @DocString(name="%class-default-initargs")
+ private static final Primitive CLASS_DEFAULT_INITARGS
+ = new pf__class_default_initargs();
+ private static final class pf__class_default_initargs extends Primitive
{
+ pf__class_default_initargs()
+ {
+ super("%class-default-initargs", PACKAGE_SYS, true);
+ }
@Override
public LispObject execute(LispObject arg)
-
{
if (arg instanceof SlotClass)
return ((SlotClass)arg).getDefaultInitargs();
@@ -292,13 +323,18 @@
}
};
- // ### %set-class-default-initargs
- private static final Primitive _SET_CLASS_DEFAULT_INITARGS =
- new Primitive("%set-class-default-initargs", PACKAGE_SYS, true)
+ @DocString(name="%set-class-default-initargs")
+ private static final Primitive _SET_CLASS_DEFAULT_INITARGS
+ = new pf__set_class_default_initargs();
+
+ private static final class pf__set_class_default_initargs extends Primitive
{
+ pf__set_class_default_initargs()
+ {
+ super("%set-class-default-initargs", PACKAGE_SYS, true);
+ }
@Override
public LispObject execute(LispObject first, LispObject second)
-
{
if (second instanceof SlotClass) {
((SlotClass)second).setDefaultInitargs(first);
@@ -307,5 +343,4 @@
return type_error(second, Symbol.STANDARD_CLASS);
}
};
-
}
Modified: trunk/abcl/src/org/armedbear/lisp/SlotDefinition.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/SlotDefinition.java Sat Aug 27 16:23:05 2011 (r13540)
+++ trunk/abcl/src/org/armedbear/lisp/SlotDefinition.java Sat Aug 27 16:23:24 2011 (r13541)
@@ -129,248 +129,349 @@
return unreadableString(sb.toString());
}
- // ### make-slot-definition &optional class
- private static final Primitive MAKE_SLOT_DEFINITION =
- new Primitive("make-slot-definition", PACKAGE_SYS, true, "&optional class")
- {
- @Override
- public LispObject execute()
- {
- return new SlotDefinition();
- }
- @Override
- public LispObject execute(LispObject slotDefinitionClass)
- {
- return new SlotDefinition((StandardClass) slotDefinitionClass);
- }
- };
-
- // ### %slot-definition-name
- private static final Primitive _SLOT_DEFINITION_NAME =
- new Primitive(Symbol._SLOT_DEFINITION_NAME, "slot-definition")
- {
- @Override
- public LispObject execute(LispObject arg)
- {
- return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_NAME];
- }
- };
-
- // ### set-slot-definition-name
- private static final Primitive SET_SLOT_DEFINITION_NAME =
- new Primitive("set-slot-definition-name", PACKAGE_SYS, true,
- "slot-definition name")
- {
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_NAME] = second;
- return second;
- }
- };
-
- // ### %slot-definition-initfunction
- private static final Primitive _SLOT_DEFINITION_INITFUNCTION =
- new Primitive(Symbol._SLOT_DEFINITION_INITFUNCTION, "slot-definition")
- {
- @Override
- public LispObject execute(LispObject arg)
- {
- return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_INITFUNCTION];
- }
- };
-
- // ### set-slot-definition-initfunction
- static final Primitive SET_SLOT_DEFINITION_INITFUNCTION =
- new Primitive("set-slot-definition-initfunction", PACKAGE_SYS, true,
- "slot-definition initfunction")
- {
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_INITFUNCTION] = second;
- return second;
- }
- };
-
- // ### %slot-definition-initform
- private static final Primitive _SLOT_DEFINITION_INITFORM =
- new Primitive("%slot-definition-initform", PACKAGE_SYS, true,
- "slot-definition")
- {
- @Override
- public LispObject execute(LispObject arg)
- {
- return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_INITFORM];
- }
- };
-
- // ### set-slot-definition-initform
- static final Primitive SET_SLOT_DEFINITION_INITFORM =
- new Primitive("set-slot-definition-initform", PACKAGE_SYS, true,
- "slot-definition initform")
- {
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_INITFORM] = second;
- return second;
- }
- };
-
- // ### %slot-definition-initargs
- private static final Primitive _SLOT_DEFINITION_INITARGS =
- new Primitive(Symbol._SLOT_DEFINITION_INITARGS, "slot-definition")
- {
- @Override
- public LispObject execute(LispObject arg)
- {
- return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_INITARGS];
- }
- };
-
- // ### set-slot-definition-initargs
- private static final Primitive SET_SLOT_DEFINITION_INITARGS =
- new Primitive("set-slot-definition-initargs", PACKAGE_SYS, true,
- "slot-definition initargs")
- {
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_INITARGS] = second;
- return second;
- }
- };
-
- // ### %slot-definition-readers
- private static final Primitive _SLOT_DEFINITION_READERS =
- new Primitive("%slot-definition-readers", PACKAGE_SYS, true,
- "slot-definition")
- {
- @Override
- public LispObject execute(LispObject arg)
- {
- return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_READERS];
- }
- };
-
- // ### set-slot-definition-readers
- private static final Primitive SET_SLOT_DEFINITION_READERS =
- new Primitive("set-slot-definition-readers", PACKAGE_SYS, true,
- "slot-definition readers")
- {
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_READERS] = second;
- return second;
- }
- };
-
- // ### %slot-definition-writers
- private static final Primitive _SLOT_DEFINITION_WRITERS =
- new Primitive("%slot-definition-writers", PACKAGE_SYS, true,
- "slot-definition")
- {
- @Override
- public LispObject execute(LispObject arg)
- {
- return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_WRITERS];
- }
- };
-
- // ### set-slot-definition-writers
- private static final Primitive SET_SLOT_DEFINITION_WRITERS =
- new Primitive("set-slot-definition-writers", PACKAGE_SYS, true,
- "slot-definition writers")
- {
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_WRITERS] = second;
- return second;
- }
- };
-
- // ### %slot-definition-allocation
- private static final Primitive _SLOT_DEFINITION_ALLOCATION =
- new Primitive("%slot-definition-allocation", PACKAGE_SYS, true,
- "slot-definition")
- {
- @Override
- public LispObject execute(LispObject arg)
- {
- return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_ALLOCATION];
- }
- };
-
- // ### set-slot-definition-allocation
- private static final Primitive SET_SLOT_DEFINITION_ALLOCATION =
- new Primitive("set-slot-definition-allocation", PACKAGE_SYS, true,
- "slot-definition allocation")
- {
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_ALLOCATION] = second;
- return second;
- }
- };
-
- // ### %slot-definition-allocation-class
- private static final Primitive _SLOT_DEFINITION_ALLOCATION_CLASS =
- new Primitive("%slot-definition-allocation-class", PACKAGE_SYS, true,
- "slot-definition")
- {
- @Override
- public LispObject execute(LispObject arg)
- {
- return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_ALLOCATION_CLASS];
- }
- };
-
- // ### set-slot-definition-allocation-class
- private static final Primitive SET_SLOT_DEFINITION_ALLOCATION_CLASS =
- new Primitive("set-slot-definition-allocation-class", PACKAGE_SYS, true,
- "slot-definition allocation-class")
- {
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_ALLOCATION_CLASS] = second;
- return second;
- }
- };
-
- // ### %slot-definition-location
- private static final Primitive _SLOT_DEFINITION_LOCATION =
- new Primitive("%slot-definition-location", PACKAGE_SYS, true, "slot-definition")
- {
- @Override
- public LispObject execute(LispObject arg)
- {
- return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_LOCATION];
- }
- };
-
- // ### set-slot-definition-location
- private static final Primitive SET_SLOT_DEFINITION_LOCATION =
- new Primitive("set-slot-definition-location", PACKAGE_SYS, true, "slot-definition location")
- {
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_LOCATION] = second;
- return second;
- }
- };
+ private static final Primitive MAKE_SLOT_DEFINITION
+ = new pf_make_slot_definition();
+ @DocString(name="make-slot-definition",
+ args="&optional class")
+ private static final class pf_make_slot_definition extends Primitive
+ {
+ pf_make_slot_definition()
+ {
+ super("make-slot-definition", PACKAGE_SYS, true, "&optional class");
+ }
+ @Override
+ public LispObject execute()
+ {
+ return new SlotDefinition();
+ }
+ @Override
+ public LispObject execute(LispObject slotDefinitionClass)
+ {
+ return new SlotDefinition((StandardClass) slotDefinitionClass);
+ }
+ };
+
+ private static final Primitive _SLOT_DEFINITION_NAME
+ = new pf__slot_definition_name();
+ @DocString(name="%slot-definition-name")
+ private static final class pf__slot_definition_name extends Primitive
+ {
+ pf__slot_definition_name()
+ {
+ super(Symbol._SLOT_DEFINITION_NAME, "slot-definition");
+ }
+ @Override
+ public LispObject execute(LispObject arg)
+ {
+ return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_NAME];
+ }
+ };
+
+ private static final Primitive SET_SLOT_DEFINITION_NAME
+ = new pf_set_slot_definition_name();
+ @DocString(name="set-slot-definition-name",
+ args="slot-definition name")
+ private static final class pf_set_slot_definition_name extends Primitive
+ {
+ pf_set_slot_definition_name()
+ {
+ super("set-slot-definition-name", PACKAGE_SYS, true,
+ "slot-definition name");
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_NAME] = second;
+ return second;
+ }
+ };
+
+ private static final Primitive _SLOT_DEFINITION_INITFUNCTION
+ = new pf__slot_definition_initfunction();
+ @DocString(name="%slot-definition-initfunction")
+ private static final class pf__slot_definition_initfunction extends Primitive
+ {
+ pf__slot_definition_initfunction()
+ {
+ super(Symbol._SLOT_DEFINITION_INITFUNCTION, "slot-definition");
+ }
+ @Override
+ public LispObject execute(LispObject arg)
+ {
+ return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_INITFUNCTION];
+ }
+ };
+
+ static final Primitive SET_SLOT_DEFINITION_INITFUNCTION
+ = new pf_set_slot_definition_initfunction();
+ @DocString(name="set-slot-definition-initfunction",
+ args="slot-definition initfunction")
+ static final class pf_set_slot_definition_initfunction extends Primitive
+ {
+ pf_set_slot_definition_initfunction()
+ {
+ super("set-slot-definition-initfunction", PACKAGE_SYS, true,
+ "slot-definition initfunction");
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_INITFUNCTION] = second;
+ return second;
+ }
+ };
+
+ private static final Primitive _SLOT_DEFINITION_INITFORM
+ = new pf__slot_definition_initform();
+ @DocString(name="%slot-definition-initform",
+ args="slot-definition")
+ private static final class pf__slot_definition_initform extends Primitive
+ {
+ pf__slot_definition_initform()
+ {
+ super("%slot-definition-initform", PACKAGE_SYS, true,
+ "slot-definition");
+ }
+ @Override
+ public LispObject execute(LispObject arg)
+ {
+ return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_INITFORM];
+ }
+ };
+
+ static final Primitive SET_SLOT_DEFINITION_INITFORM
+ = new pf_set_slot_definition_initform();
+ @DocString(name="set-slot-definition-initform",
+ args="slot-definition initform")
+ static final class pf_set_slot_definition_initform extends Primitive
+ {
+ pf_set_slot_definition_initform()
+ {
+ super("set-slot-definition-initform", PACKAGE_SYS, true,
+ "slot-definition initform");
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_INITFORM] = second;
+ return second;
+ }
+ };
+
+ private static final Primitive _SLOT_DEFINITION_INITARGS
+ = new pf__slot_definition_initargs();
+ @DocString(name="%slot-definition-initargs")
+ private static final class pf__slot_definition_initargs extends Primitive
+ {
+ pf__slot_definition_initargs()
+ {
+ super(Symbol._SLOT_DEFINITION_INITARGS, "slot-definition");
+ }
+ @Override
+ public LispObject execute(LispObject arg)
+ {
+ return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_INITARGS];
+ }
+ };
+
+ private static final Primitive SET_SLOT_DEFINITION_INITARGS
+ = new pf_set_slot_definition_initargs();
+ @DocString(name="set-slot-definition-initargs",
+ args="slot-definition initargs")
+ private static final class pf_set_slot_definition_initargs extends Primitive
+ {
+ pf_set_slot_definition_initargs()
+ {
+ super("set-slot-definition-initargs", PACKAGE_SYS, true,
+ "slot-definition initargs");
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_INITARGS] = second;
+ return second;
+ }
+ };
+
+ private static final Primitive _SLOT_DEFINITION_READERS
+ = new pf__slot_definition_readers();
+ @DocString(name="%slot-definition-readers",
+ args="slot-definition")
+ private static final class pf__slot_definition_readers extends Primitive {
+ pf__slot_definition_readers()
+ {
+ super("%slot-definition-readers", PACKAGE_SYS, true,
+ "slot-definition");
+ }
+ @Override
+ public LispObject execute(LispObject arg)
+ {
+ return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_READERS];
+ }
+ };
+
+ private static final Primitive SET_SLOT_DEFINITION_READERS
+ = new pf_set_slot_definition_readers();
+ @DocString(name="set-slot-definition-readers",
+ args="slot-definition readers")
+ private static final class pf_set_slot_definition_readers extends Primitive
+ {
+ pf_set_slot_definition_readers()
+ {
+ super("set-slot-definition-readers", PACKAGE_SYS, true,
+ "slot-definition readers");
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_READERS] = second;
+ return second;
+ }
+ };
+
+ private static final Primitive _SLOT_DEFINITION_WRITERS
+ = new pf__slot_definition_writers();
+ @DocString(name="%slot-definition-writers",
+ args="slot-definition")
+ private static final class pf__slot_definition_writers extends Primitive
+ {
+ pf__slot_definition_writers()
+ {
+ super("%slot-definition-writers", PACKAGE_SYS, true,
+ "slot-definition");
+ }
+ @Override
+ public LispObject execute(LispObject arg)
+ {
+ return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_WRITERS];
+ }
+ };
+
+ private static final Primitive SET_SLOT_DEFINITION_WRITERS
+ = new pf_set_slot_definition_writers();
+ @DocString(name="set-slot-definition-writers",
+ args="slot-definition writers")
+ private static final class pf_set_slot_definition_writers extends Primitive
+ {
+ pf_set_slot_definition_writers()
+ {
+ super("set-slot-definition-writers", PACKAGE_SYS, true,
+ "slot-definition writers");
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_WRITERS] = second;
+ return second;
+ }
+ };
+
+ private static final Primitive _SLOT_DEFINITION_ALLOCATION
+ = new pf__slot_definition_allocation();
+ @DocString(name="%slot-definition-allocation",
+ args="slot-definition")
+ private static final class pf__slot_definition_allocation extends Primitive
+ {
+ pf__slot_definition_allocation()
+ {
+ super("%slot-definition-allocation", PACKAGE_SYS, true,
+ "slot-definition");
+ }
+ @Override
+ public LispObject execute(LispObject arg)
+ {
+ return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_ALLOCATION];
+ }
+ };
+
+ private static final Primitive SET_SLOT_DEFINITION_ALLOCATION
+ = new pf_set_slot_definition_allocation();
+ @DocString(name="set-slot-definition-allocation",
+ args="slot-definition allocation")
+ private static final class pf_set_slot_definition_allocation extends Primitive
+ {
+ pf_set_slot_definition_allocation()
+ {
+ super("set-slot-definition-allocation", PACKAGE_SYS, true,
+ "slot-definition allocation");
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_ALLOCATION] = second;
+ return second;
+ }
+ };
+
+ private static final Primitive _SLOT_DEFINITION_ALLOCATION_CLASS
+ = new pf__slot_definition_allocation_class();
+ @DocString(name="%slot-definition-allocation-class",
+ args="slot-definition")
+ private static final class pf__slot_definition_allocation_class extends Primitive
+ {
+ pf__slot_definition_allocation_class()
+ {
+ super("%slot-definition-allocation-class", PACKAGE_SYS, true,
+ "slot-definition");
+ }
+ @Override
+ public LispObject execute(LispObject arg)
+ {
+ return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_ALLOCATION_CLASS];
+ }
+ };
+
+ private static final Primitive SET_SLOT_DEFINITION_ALLOCATION_CLASS
+ = new pf_set_slot_definition_allocation_class();
+ @DocString(name="set-slot-definition-allocation-class",
+ args="slot-definition allocation-class")
+ private static final class pf_set_slot_definition_allocation_class extends Primitive
+ {
+ pf_set_slot_definition_allocation_class()
+ {
+ super("set-slot-definition-allocation-class", PACKAGE_SYS, true,
+ "slot-definition allocation-class");
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_ALLOCATION_CLASS] = second;
+ return second;
+ }
+ };
+
+ private static final Primitive _SLOT_DEFINITION_LOCATION
+ = new pf__slot_definition_location();
+ @DocString(name="%slot-definition-location")
+ private static final class pf__slot_definition_location extends Primitive
+ {
+ pf__slot_definition_location()
+ {
+ super("%slot-definition-location", PACKAGE_SYS, true, "slot-definition");
+ }
+ @Override
+ public LispObject execute(LispObject arg)
+ {
+ return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_LOCATION];
+ }
+ };
+
+ private static final Primitive SET_SLOT_DEFINITION_LOCATION
+ = new pf_set_slot_definition_location();
+ @DocString(name="set-slot-definition-location",
+ args="slot-definition location")
+ private static final class pf_set_slot_definition_location extends Primitive
+ {
+ pf_set_slot_definition_location()
+ {
+ super("set-slot-definition-location", PACKAGE_SYS, true,
+ "slot-definition location");
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_LOCATION] = second;
+ return second;
+ }
+ };
}
Modified: trunk/abcl/src/org/armedbear/lisp/StandardGenericFunction.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/StandardGenericFunction.java Sat Aug 27 16:23:05 2011 (r13540)
+++ trunk/abcl/src/org/armedbear/lisp/StandardGenericFunction.java Sat Aug 27 16:23:24 2011 (r13541)
@@ -246,25 +246,25 @@
++callCount;
}
- @Override
- public final int getHotCount()
- {
- return hotCount;
- }
+ @Override
+ public final int getHotCount()
+ {
+ return hotCount;
+ }
- @Override
- public void setHotCount(int n)
- {
- hotCount = n;
- }
+ @Override
+ public void setHotCount(int n)
+ {
+ hotCount = n;
+ }
- @Override
- public final void incrementHotCount()
- {
- ++hotCount;
- }
+ @Override
+ public final void incrementHotCount()
+ {
+ ++hotCount;
+ }
- // AMOP (p. 216) specifies the following readers as generic functions:
+ // AMOP (p. 216) specifies the following readers as generic functions:
// generic-function-argument-precedence-order
// generic-function-declarations
// generic-function-lambda-list
@@ -273,346 +273,462 @@
// generic-function-methods
// generic-function-name
- // ### %generic-function-name
- private static final Primitive _GENERIC_FUNCTION_NAME =
- new Primitive("%generic-function-name", PACKAGE_SYS, true)
+ private static final Primitive _GENERIC_FUNCTION_NAME
+ = new pf__generic_function_name();
+ @DocString(name="%generic-function-name")
+ private static final class pf__generic_function_name extends Primitive
+ {
+ pf__generic_function_name()
{
- @Override
- public LispObject execute(LispObject arg)
- {
- return checkStandardGenericFunction(arg).slots[StandardGenericFunctionClass.SLOT_INDEX_NAME];
- }
- };
-
- // ### %set-generic-function-name
- private static final Primitive _SET_GENERIC_FUNCTION_NAME =
- new Primitive("%set-generic-function-name", PACKAGE_SYS, true)
+ super("%generic-function-name", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject arg)
{
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- checkStandardGenericFunction(first).slots[StandardGenericFunctionClass.SLOT_INDEX_NAME] = second;
- return second;
- }
- };
+ return checkStandardGenericFunction(arg).slots[StandardGenericFunctionClass.SLOT_INDEX_NAME];
+ }
+ };
- // ### %generic-function-lambda-list
- private static final Primitive _GENERIC_FUNCTION_LAMBDA_LIST =
- new Primitive("%generic-function-lambda-list", PACKAGE_SYS, true)
+ private static final Primitive _SET_GENERIC_FUNCTION_NAME
+ = new pf__set_generic_function_name();
+ @DocString(name="%set-generic-function-name")
+ private static final class pf__set_generic_function_name extends Primitive
+ {
+ pf__set_generic_function_name()
{
- @Override
- public LispObject execute(LispObject arg)
- {
- return checkStandardGenericFunction(arg).slots[StandardGenericFunctionClass.SLOT_INDEX_LAMBDA_LIST];
- }
- };
-
- // ### %set-generic-function-lambdaList
- private static final Primitive _SET_GENERIC_FUNCTION_LAMBDA_LIST =
- new Primitive("%set-generic-function-lambda-list", PACKAGE_SYS, true)
+ super ("%set-generic-function-name", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
{
- @Override
- public LispObject execute(LispObject first, LispObject second)
+ checkStandardGenericFunction(first).slots[StandardGenericFunctionClass.SLOT_INDEX_NAME] = second;
+ return second;
+ }
+ };
- {
- checkStandardGenericFunction(first).slots[StandardGenericFunctionClass.SLOT_INDEX_LAMBDA_LIST] = second;
- return second;
- }
- };
+ private static final Primitive _GENERIC_FUNCTION_LAMBDA_LIST
+ = new pf__generic_function_lambda_list();
+ @DocString(name ="%generic-function-lambda-list")
+ private static final class pf__generic_function_lambda_list extends Primitive {
+ pf__generic_function_lambda_list()
+ {
+ super("%generic-function-lambda-list", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject arg)
+ {
+ return checkStandardGenericFunction(arg).slots[StandardGenericFunctionClass.SLOT_INDEX_LAMBDA_LIST];
+ }
+ };
- // ### funcallable-instance-function funcallable-instance => function
- private static final Primitive FUNCALLABLE_INSTANCE_FUNCTION =
- new Primitive("funcallable-instance-function", PACKAGE_MOP, false,
- "funcallable-instance")
+ private static final Primitive _SET_GENERIC_FUNCTION_LAMBDA_LIST
+ = new pf__set_generic_function_lambda_list();
+ @DocString(name="%set-generic-function-lambdalist")
+ private static final class pf__set_generic_function_lambda_list extends Primitive
+ {
+ pf__set_generic_function_lambda_list()
{
- @Override
- public LispObject execute(LispObject arg)
+ super("%set-generic-function-lambda-list", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ checkStandardGenericFunction(first).slots[StandardGenericFunctionClass.SLOT_INDEX_LAMBDA_LIST] = second;
+ return second;
+ }
+ };
- {
- return checkStandardGenericFunction(arg).function;
- }
- };
+ private static final Primitive FUNCALLABLE_INSTANCE_FUNCTION
+ = new pf_funcallable_instance_function();
+ @DocString(name="funcallable-instance-function",
+ args="funcallable-instance",
+ returns="function")
+ private static final class pf_funcallable_instance_function extends Primitive
+ {
+ pf_funcallable_instance_function()
+ {
+ super("funcallable-instance-function", PACKAGE_MOP, false,
+ "funcallable-instance");
+ }
+ @Override
+ public LispObject execute(LispObject arg)
+ {
+ return checkStandardGenericFunction(arg).function;
+ }
+ };
- // ### set-funcallable-instance-function funcallable-instance function => unspecified
// AMOP p. 230
- private static final Primitive SET_FUNCALLABLE_INSTANCE_FUNCTION =
- new Primitive("set-funcallable-instance-function", PACKAGE_MOP, true,
- "funcallable-instance function")
+ private static final Primitive SET_FUNCALLABLE_INSTANCE_FUNCTION
+ = new pf_set_funcallable_instance_function();
+ @DocString(name="set-funcallable-instance-function",
+ args="funcallable-instance function",
+ returns="unspecified")
+ private static final class pf_set_funcallable_instance_function extends Primitive
+ {
+ pf_set_funcallable_instance_function()
{
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- checkStandardGenericFunction(first).function = second;
- return second;
- }
- };
-
- // ### gf-required-args
- private static final Primitive GF_REQUIRED_ARGS =
- new Primitive("gf-required-args", PACKAGE_SYS, true)
+ super("set-funcallable-instance-function", PACKAGE_MOP, true,
+ "funcallable-instance function");
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
{
- @Override
- public LispObject execute(LispObject arg)
- {
- return checkStandardGenericFunction(arg).slots[StandardGenericFunctionClass.SLOT_INDEX_REQUIRED_ARGS];
- }
- };
+ checkStandardGenericFunction(first).function = second;
+ return second;
+ }
+ };
- // ### %set-gf-required-args
- private static final Primitive _SET_GF_REQUIRED_ARGS =
- new Primitive("%set-gf-required-args", PACKAGE_SYS, true)
+ private static final Primitive GF_REQUIRED_ARGS
+ = new pf_gf_required_args();
+ @DocString(name="gf-required-args")
+ private static final class pf_gf_required_args extends Primitive
+ {
+ pf_gf_required_args()
{
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- final StandardGenericFunction gf = checkStandardGenericFunction(first);
- gf.slots[StandardGenericFunctionClass.SLOT_INDEX_REQUIRED_ARGS] = second;
- gf.numberOfRequiredArgs = second.length();
- return second;
- }
- };
-
- // ### generic-function-initial-methods
- private static final Primitive GENERIC_FUNCTION_INITIAL_METHODS =
- new Primitive("generic-function-initial-methods", PACKAGE_SYS, true)
+ super("gf-required-args", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject arg)
{
- @Override
- public LispObject execute(LispObject arg)
- {
- return checkStandardGenericFunction(arg).slots[StandardGenericFunctionClass.SLOT_INDEX_INITIAL_METHODS];
- }
- };
+ return checkStandardGenericFunction(arg).slots[StandardGenericFunctionClass.SLOT_INDEX_REQUIRED_ARGS];
+ }
+ };
- // ### set-generic-function-initial-methods
- private static final Primitive SET_GENERIC_FUNCTION_INITIAL_METHODS =
- new Primitive("set-generic-function-initial-methods", PACKAGE_SYS, true)
+ private static final Primitive _SET_GF_REQUIRED_ARGS
+ = new pf__set_gf_required_args();
+ @DocString(name="%set-gf-required-args")
+ private static final class pf__set_gf_required_args extends Primitive
+ {
+ pf__set_gf_required_args()
{
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- checkStandardGenericFunction(first).slots[StandardGenericFunctionClass.SLOT_INDEX_INITIAL_METHODS] = second;
- return second;
- }
- };
-
- // ### generic-function-methods
- private static final Primitive GENERIC_FUNCTION_METHODS =
- new Primitive("generic-function-methods", PACKAGE_SYS, true)
+ super("%set-gf-required-args", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
{
- @Override
- public LispObject execute(LispObject arg)
- {
- return checkStandardGenericFunction(arg).slots[StandardGenericFunctionClass.SLOT_INDEX_METHODS];
- }
- };
+ final StandardGenericFunction gf = checkStandardGenericFunction(first);
+ gf.slots[StandardGenericFunctionClass.SLOT_INDEX_REQUIRED_ARGS] = second;
+ gf.numberOfRequiredArgs = second.length();
+ return second;
+ }
+ };
- // ### set-generic-function-methods
- private static final Primitive SET_GENERIC_FUNCTION_METHODS =
- new Primitive("set-generic-function-methods", PACKAGE_SYS, true)
+ private static final Primitive GENERIC_FUNCTION_INITIAL_METHODS
+ = new pf_generic_function_initial_methods();
+ @DocString(name="generic-function-initial-methods")
+ private static final class pf_generic_function_initial_methods extends Primitive
+ {
+ pf_generic_function_initial_methods()
{
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- checkStandardGenericFunction(first).slots[StandardGenericFunctionClass.SLOT_INDEX_METHODS] = second;
- return second;
- }
- };
-
- // ### generic-function-method-class
- private static final Primitive GENERIC_FUNCTION_METHOD_CLASS =
- new Primitive("generic-function-method-class", PACKAGE_SYS, true)
+ super("generic-function-initial-methods", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject arg)
{
- @Override
- public LispObject execute(LispObject arg)
- {
- return checkStandardGenericFunction(arg).slots[StandardGenericFunctionClass.SLOT_INDEX_METHOD_CLASS];
- }
- };
+ return checkStandardGenericFunction(arg).slots[StandardGenericFunctionClass.SLOT_INDEX_INITIAL_METHODS];
+ }
+ };
- // ### set-generic-function-method-class
- private static final Primitive SET_GENERIC_FUNCTION_METHOD_CLASS =
- new Primitive("set-generic-function-method-class", PACKAGE_SYS, true)
+ private static final Primitive SET_GENERIC_FUNCTION_INITIAL_METHODS
+ = new pf_set_generic_function_initial_methods();
+ @DocString(name="set-generic-function-initial-methods")
+ private static final class pf_set_generic_function_initial_methods extends Primitive
+ {
+ pf_set_generic_function_initial_methods()
{
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- checkStandardGenericFunction(first).slots[StandardGenericFunctionClass.SLOT_INDEX_METHOD_CLASS] = second;
- return second;
- }
- };
-
- // ### generic-function-method-combination
- private static final Primitive GENERIC_FUNCTION_METHOD_COMBINATION =
- new Primitive("generic-function-method-combination", PACKAGE_SYS, true)
+ super("set-generic-function-initial-methods", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
{
- @Override
- public LispObject execute(LispObject arg)
- {
- return checkStandardGenericFunction(arg).slots[StandardGenericFunctionClass.SLOT_INDEX_METHOD_COMBINATION];
- }
- };
+ checkStandardGenericFunction(first).slots[StandardGenericFunctionClass.SLOT_INDEX_INITIAL_METHODS] = second;
+ return second;
+ }
+ };
- // ### set-generic-function-method-combination
- private static final Primitive SET_GENERIC_FUNCTION_METHOD_COMBINATION =
- new Primitive("set-generic-function-method-combination", PACKAGE_SYS, true)
+ private static final Primitive GENERIC_FUNCTION_METHODS
+ = new pf_generic_function_methods();
+ @DocString(name="generic-function-methods")
+ private static final class pf_generic_function_methods extends Primitive
+ {
+ pf_generic_function_methods()
{
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- checkStandardGenericFunction(first).slots[StandardGenericFunctionClass.SLOT_INDEX_METHOD_COMBINATION]
- = second;
- return second;
- }
- };
+ super("generic-function-methods", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject arg)
+ {
+ return checkStandardGenericFunction(arg).slots[StandardGenericFunctionClass.SLOT_INDEX_METHODS];
+ }
+ };
- // ### generic-function-argument-precedence-order
- private static final Primitive GENERIC_FUNCTION_ARGUMENT_PRECEDENCE_ORDER =
- new Primitive("generic-function-argument-precedence-order", PACKAGE_SYS, true)
+ private static final Primitive SET_GENERIC_FUNCTION_METHODS
+ = new pf_set_generic_function_methods();
+ @DocString(name="set-generic-function-methods")
+ private static final class pf_set_generic_function_methods extends Primitive
+ {
+ pf_set_generic_function_methods()
{
- @Override
- public LispObject execute(LispObject arg)
- {
- return checkStandardGenericFunction(arg).slots[StandardGenericFunctionClass
- .SLOT_INDEX_ARGUMENT_PRECEDENCE_ORDER];
- }
- };
+ super("set-generic-function-methods", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ checkStandardGenericFunction(first).slots[StandardGenericFunctionClass.SLOT_INDEX_METHODS] = second;
+ return second;
+ }
+ };
- // ### set-generic-function-argument-precedence-order
- private static final Primitive SET_GENERIC_FUNCTION_ARGUMENT_PRECEDENCE_ORDER =
- new Primitive("set-generic-function-argument-precedence-order", PACKAGE_SYS, true)
+ private static final Primitive GENERIC_FUNCTION_METHOD_CLASS
+ = new pf_generic_function_method_class();
+ @DocString(name="generic-function-method-class")
+ private static final class pf_generic_function_method_class extends Primitive
+ {
+ pf_generic_function_method_class()
{
- @Override
- public LispObject execute(LispObject first, LispObject second)
+ super("generic-function-method-class", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject arg)
+ {
+ return checkStandardGenericFunction(arg).slots[StandardGenericFunctionClass.SLOT_INDEX_METHOD_CLASS];
+ }
+ };
- {
- checkStandardGenericFunction(first)
- .slots[StandardGenericFunctionClass.SLOT_INDEX_ARGUMENT_PRECEDENCE_ORDER] = second;
- return second;
- }
- };
+ private static final Primitive SET_GENERIC_FUNCTION_METHOD_CLASS
+ = new pf_set_generic_function_method_class();
+ @DocString(name="set-generic-function-method-class")
+ private static final class pf_set_generic_function_method_class extends Primitive
+ {
+ pf_set_generic_function_method_class()
+ {
+ super("set-generic-function-method-class", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ checkStandardGenericFunction(first).slots[StandardGenericFunctionClass.SLOT_INDEX_METHOD_CLASS] = second;
+ return second;
+ }
+ };
- // ### generic-function-classes-to-emf-table
- private static final Primitive GENERIC_FUNCTION_CLASSES_TO_EMF_TABLE =
- new Primitive("generic-function-classes-to-emf-table", PACKAGE_SYS, true)
+ private static final Primitive GENERIC_FUNCTION_METHOD_COMBINATION
+ = new pf_generic_function_method_combination();
+ @DocString(name="generic-function-method-combination")
+ private static final class pf_generic_function_method_combination extends Primitive
+ {
+ pf_generic_function_method_combination()
{
- @Override
- public LispObject execute(LispObject arg)
- {
- return checkStandardGenericFunction(arg)
- .slots[StandardGenericFunctionClass.SLOT_INDEX_CLASSES_TO_EMF_TABLE];
- }
- };
+ super("generic-function-method-combination", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject arg)
+ {
+ return checkStandardGenericFunction(arg).slots[StandardGenericFunctionClass.SLOT_INDEX_METHOD_COMBINATION];
+ }
+ };
- // ### set-generic-function-classes-to-emf-table
- private static final Primitive SET_GENERIC_FUNCTION_CLASSES_TO_EMF_TABLE =
- new Primitive("set-generic-function-classes-to-emf-table", PACKAGE_SYS, true)
+ private static final Primitive SET_GENERIC_FUNCTION_METHOD_COMBINATION
+ = new pf_set_generic_function_method_combination();
+ @DocString(name="set-generic-function-method-combination")
+ private static final class pf_set_generic_function_method_combination extends Primitive
+ {
+ pf_set_generic_function_method_combination()
+ {
+ super("set-generic-function-method-combination", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
{
- @Override
- public LispObject execute(LispObject first, LispObject second)
+ checkStandardGenericFunction(first).slots[StandardGenericFunctionClass.SLOT_INDEX_METHOD_COMBINATION]
+ = second;
+ return second;
+ }
+ };
- {
- checkStandardGenericFunction(first)
- .slots[StandardGenericFunctionClass.SLOT_INDEX_CLASSES_TO_EMF_TABLE] = second;
- return second;
- }
- };
+ private static final Primitive GENERIC_FUNCTION_ARGUMENT_PRECEDENCE_ORDER
+ = new pf_generic_function_argument_precedence_order();
+ @DocString(name="generic-function-argument-precedence-order")
+ private static final class pf_generic_function_argument_precedence_order extends Primitive
+ {
+ pf_generic_function_argument_precedence_order()
+ {
+ super("generic-function-argument-precedence-order", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject arg)
+ {
+ return checkStandardGenericFunction(arg).slots[StandardGenericFunctionClass
+ .SLOT_INDEX_ARGUMENT_PRECEDENCE_ORDER];
+ }
+ };
- // ### generic-function-documentation
- private static final Primitive GENERIC_FUNCTION_DOCUMENTATION =
- new Primitive("generic-function-documentation", PACKAGE_SYS, true)
+ private static final Primitive SET_GENERIC_FUNCTION_ARGUMENT_PRECEDENCE_ORDER
+ = new pf_set_generic_function_argument_precedence_order();
+ @DocString(name="set-generic-function-argument-precedence-order")
+ private static final class pf_set_generic_function_argument_precedence_order extends Primitive
+ {
+ pf_set_generic_function_argument_precedence_order()
{
- @Override
- public LispObject execute(LispObject arg)
- {
- return checkStandardGenericFunction(arg).slots[StandardGenericFunctionClass.SLOT_INDEX_DOCUMENTATION];
- }
- };
+ super("set-generic-function-argument-precedence-order", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ checkStandardGenericFunction(first)
+ .slots[StandardGenericFunctionClass.SLOT_INDEX_ARGUMENT_PRECEDENCE_ORDER] = second;
+ return second;
+ }
+ };
- // ### set-generic-function-documentation
- private static final Primitive SET_GENERIC_FUNCTION_DOCUMENTATION =
- new Primitive("set-generic-function-documentation", PACKAGE_SYS, true)
+ private static final Primitive GENERIC_FUNCTION_CLASSES_TO_EMF_TABLE
+ = new pf_generic_function_classes_to_emf_table();
+ @DocString(name="generic-function-classes-to-emf-table")
+ private static final class pf_generic_function_classes_to_emf_table extends Primitive
+ {
+ pf_generic_function_classes_to_emf_table()
+ {
+ super("generic-function-classes-to-emf-table", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject arg)
{
- @Override
- public LispObject execute(LispObject first, LispObject second)
+ return checkStandardGenericFunction(arg)
+ .slots[StandardGenericFunctionClass.SLOT_INDEX_CLASSES_TO_EMF_TABLE];
+ }
+ };
- {
- checkStandardGenericFunction(first).slots[StandardGenericFunctionClass.SLOT_INDEX_DOCUMENTATION]
- = second;
- return second;
- }
- };
+ private static final Primitive SET_GENERIC_FUNCTION_CLASSES_TO_EMF_TABLE
+ = new pf_set_generic_function_classes_to_emf_table();
+ @DocString(name="set-generic-function-classes-to-emf-table")
+ private static final class pf_set_generic_function_classes_to_emf_table extends Primitive
+ {
+ pf_set_generic_function_classes_to_emf_table()
+ {
+ super("set-generic-function-classes-to-emf-table", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ checkStandardGenericFunction(first)
+ .slots[StandardGenericFunctionClass.SLOT_INDEX_CLASSES_TO_EMF_TABLE] = second;
+ return second;
+ }
+ };
- // ### %finalize-generic-function
- private static final Primitive _FINALIZE_GENERIC_FUNCTION =
- new Primitive("%finalize-generic-function", PACKAGE_SYS, true,
- "generic-function")
+ private static final Primitive GENERIC_FUNCTION_DOCUMENTATION
+ = new pf_generic_function_documentation();
+ @DocString(name="generic-function-documentation")
+ private static final class pf_generic_function_documentation extends Primitive
+ {
+ pf_generic_function_documentation()
{
- @Override
- public LispObject execute(LispObject arg)
- {
- final StandardGenericFunction gf = checkStandardGenericFunction(arg);
- gf.finalizeInternal();
- return T;
- }
- };
+ super("generic-function-documentation", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject arg)
+ {
+ return checkStandardGenericFunction(arg).slots[StandardGenericFunctionClass.SLOT_INDEX_DOCUMENTATION];
+ }
+ };
- // ### cache-emf
- private static final Primitive CACHE_EMF =
- new Primitive("cache-emf", PACKAGE_SYS, true, "generic-function args emf")
+ private static final Primitive SET_GENERIC_FUNCTION_DOCUMENTATION
+ = new pf_set_generic_function_documentation();
+ @DocString(name="set-generic-function-documentation")
+ private static final class pf_set_generic_function_documentation extends Primitive
+ {
+ pf_set_generic_function_documentation()
{
- @Override
- public LispObject execute(LispObject first, LispObject second,
- LispObject third)
+ super("set-generic-function-documentation", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ checkStandardGenericFunction(first).slots[StandardGenericFunctionClass.SLOT_INDEX_DOCUMENTATION]
+ = second;
+ return second;
+ }
+ };
- {
- final StandardGenericFunction gf = checkStandardGenericFunction(first);
- LispObject args = second;
- LispObject[] array = new LispObject[gf.numberOfRequiredArgs];
- for (int i = gf.numberOfRequiredArgs; i-- > 0;)
- {
- array[i] = gf.getArgSpecialization(args.car());
- args = args.cdr();
- }
- CacheEntry specializations = new CacheEntry(array);
- ConcurrentHashMap<CacheEntry,LispObject> ht = gf.cache;
- if (ht == null)
- ht = gf.cache = new ConcurrentHashMap<CacheEntry,LispObject>();
- ht.put(specializations, third);
- return third;
- }
- };
+ private static final Primitive _FINALIZE_GENERIC_FUNCTION
+ = new pf__finalize_generic_function();
+ @DocString(name="%finalize-generic-function",
+ args="generic-function")
+ private static final class pf__finalize_generic_function extends Primitive
+ {
+ pf__finalize_generic_function()
+ {
+ super("%finalize-generic-function", PACKAGE_SYS, true,
+ "generic-function");
+ }
+ @Override
+ public LispObject execute(LispObject arg)
+ {
+ final StandardGenericFunction gf = checkStandardGenericFunction(arg);
+ gf.finalizeInternal();
+ return T;
+ }
+ };
- // ### get-cached-emf
- private static final Primitive GET_CACHED_EMF =
- new Primitive("get-cached-emf", PACKAGE_SYS, true, "generic-function args")
+ private static final Primitive CACHE_EMF
+ = new pf_cache_emf();
+ @DocString(name="cache-emf",
+ args="generic-function args emf")
+ private static final class pf_cache_emf extends Primitive
+ {
+ pf_cache_emf()
+ {
+ super("cache-emf", PACKAGE_SYS, true, "generic-function args emf");
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second,
+ LispObject third)
{
- @Override
- public LispObject execute(LispObject first, LispObject second)
+ final StandardGenericFunction gf = checkStandardGenericFunction(first);
+ LispObject args = second;
+ LispObject[] array = new LispObject[gf.numberOfRequiredArgs];
+ for (int i = gf.numberOfRequiredArgs; i-- > 0;)
+ {
+ array[i] = gf.getArgSpecialization(args.car());
+ args = args.cdr();
+ }
+ CacheEntry specializations = new CacheEntry(array);
+ ConcurrentHashMap<CacheEntry,LispObject> ht = gf.cache;
+ if (ht == null)
+ ht = gf.cache = new ConcurrentHashMap<CacheEntry,LispObject>();
+ ht.put(specializations, third);
+ return third;
+ }
+ };
- {
- final StandardGenericFunction gf = checkStandardGenericFunction(first);
- LispObject args = second;
- LispObject[] array = new LispObject[gf.numberOfRequiredArgs];
- for (int i = gf.numberOfRequiredArgs; i-- > 0;)
- {
- array[i] = gf.getArgSpecialization(args.car());
- args = args.cdr();
- }
- CacheEntry specializations = new CacheEntry(array);
- ConcurrentHashMap<CacheEntry,LispObject> ht = gf.cache;
- if (ht == null)
- return NIL;
- LispObject emf = (LispObject) ht.get(specializations);
- return emf != null ? emf : NIL;
- }
- };
+ private static final Primitive GET_CACHED_EMF
+ = new pf_get_cached_emf();
+ @DocString(name="get-cached-emf",
+ args="generic-function args")
+ private static final class pf_get_cached_emf extends Primitive
+ {
+ pf_get_cached_emf() {
+ super("get-cached-emf", PACKAGE_SYS, true, "generic-function args");
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ final StandardGenericFunction gf = checkStandardGenericFunction(first);
+ LispObject args = second;
+ LispObject[] array = new LispObject[gf.numberOfRequiredArgs];
+ for (int i = gf.numberOfRequiredArgs; i-- > 0;)
+ {
+ array[i] = gf.getArgSpecialization(args.car());
+ args = args.cdr();
+ }
+ CacheEntry specializations = new CacheEntry(array);
+ ConcurrentHashMap<CacheEntry,LispObject> ht = gf.cache;
+ if (ht == null)
+ return NIL;
+ LispObject emf = (LispObject) ht.get(specializations);
+ return emf != null ? emf : NIL;
+ }
+ };
/**
* Returns an object representing generic function
@@ -680,56 +796,70 @@
return arg.classOf();
}
- // ### %get-arg-specialization
- private static final Primitive _GET_ARG_SPECIALIZATION =
- new Primitive("%get-arg-specialization", PACKAGE_SYS, true, "generic-function arg")
+ private static final Primitive _GET_ARG_SPECIALIZATION
+ = new pf__get_arg_specialization();
+ @DocString(name="%get-arg-specialization",
+ args="generic-function arg")
+ private static final class pf__get_arg_specialization extends Primitive
+ {
+ pf__get_arg_specialization()
{
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- final StandardGenericFunction gf = checkStandardGenericFunction(first);
- return gf.getArgSpecialization(second);
- }
- };
+ super("%get-arg-specialization", PACKAGE_SYS, true, "generic-function arg");
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ final StandardGenericFunction gf = checkStandardGenericFunction(first);
+ return gf.getArgSpecialization(second);
+ }
+ };
- // ### cache-slot-location
- private static final Primitive CACHE_SLOT_LOCATION =
- new Primitive("cache-slot-location", PACKAGE_SYS, true, "generic-function layout location")
+ private static final Primitive CACHE_SLOT_LOCATION
+ = new pf_cache_slot_location();
+ @DocString(name="cache-slot-location",
+ args="generic-function layout location")
+ private static final class pf_cache_slot_location extends Primitive
+ {
+ pf_cache_slot_location()
{
- @Override
- public LispObject execute(LispObject first, LispObject second,
+ super("cache-slot-location", PACKAGE_SYS, true, "generic-function layout location");
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second,
LispObject third)
-
- {
- final StandardGenericFunction gf = checkStandardGenericFunction(first);
- LispObject layout = second;
- LispObject location = third;
- ConcurrentHashMap<LispObject,LispObject> ht = gf.slotCache;
- if (ht == null)
- ht = gf.slotCache = new ConcurrentHashMap<LispObject,LispObject>();
- ht.put(layout, location);
- return third;
- }
- };
-
- // ### get-cached-slot-location
- private static final Primitive GET_CACHED_SLOT_LOCATION =
- new Primitive("get-cached-slot-location", PACKAGE_SYS, true, "generic-function layout")
{
- @Override
- public LispObject execute(LispObject first, LispObject second)
+ final StandardGenericFunction gf = checkStandardGenericFunction(first);
+ LispObject layout = second;
+ LispObject location = third;
+ ConcurrentHashMap<LispObject,LispObject> ht = gf.slotCache;
+ if (ht == null)
+ ht = gf.slotCache = new ConcurrentHashMap<LispObject,LispObject>();
+ ht.put(layout, location);
+ return third;
+ }
+ };
- {
- final StandardGenericFunction gf = checkStandardGenericFunction(first);
- LispObject layout = second;
- ConcurrentHashMap<LispObject,LispObject> ht = gf.slotCache;
- if (ht == null)
- return NIL;
- LispObject location = (LispObject) ht.get(layout);
- return location != null ? location : NIL;
- }
- };
+ private static final Primitive GET_CACHED_SLOT_LOCATION
+ = new pf_get_cached_slot_location();
+ @DocString(name="get-cached-slot-location")
+ private static final class pf_get_cached_slot_location extends Primitive
+ {
+ pf_get_cached_slot_location()
+ {
+ super("get-cached-slot-location", PACKAGE_SYS, true, "generic-function layout");
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ final StandardGenericFunction gf = checkStandardGenericFunction(first);
+ LispObject layout = second;
+ ConcurrentHashMap<LispObject,LispObject> ht = gf.slotCache;
+ if (ht == null)
+ return NIL;
+ LispObject location = (LispObject) ht.get(layout);
+ return location != null ? location : NIL;
+ }
+ };
private static final StandardGenericFunction GENERIC_FUNCTION_NAME =
new StandardGenericFunction("generic-function-name",
@@ -775,25 +905,30 @@
EqlSpecialization eqlSpecializations[] = new EqlSpecialization[0];
- // ### %init-eql-specializations
- private static final Primitive _INIT_EQL_SPECIALIZATIONS
- = new Primitive("%init-eql-specializations", PACKAGE_SYS, true,
- "generic-function eql-specilizer-objects-list")
- {
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- final StandardGenericFunction gf = checkStandardGenericFunction(first);
- LispObject eqlSpecializerObjects = second;
- gf.eqlSpecializations = new EqlSpecialization[eqlSpecializerObjects.length()];
- for (int i = 0; i < gf.eqlSpecializations.length; i++) {
- gf.eqlSpecializations[i] = new EqlSpecialization(eqlSpecializerObjects.car());
- eqlSpecializerObjects = eqlSpecializerObjects.cdr();
- }
- return NIL;
- }
- };
+ private static final Primitive _INIT_EQL_SPECIALIZATIONS
+ = new pf__init_eql_specializations();
+ @DocString(name="%init-eql-specializations",
+ args="generic-function eql-specilizer-objects-list")
+ private static final class pf__init_eql_specializations extends Primitive
+ {
+ pf__init_eql_specializations()
+ {
+ super("%init-eql-specializations", PACKAGE_SYS, true,
+ "generic-function eql-specilizer-objects-list");
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ final StandardGenericFunction gf = checkStandardGenericFunction(first);
+ LispObject eqlSpecializerObjects = second;
+ gf.eqlSpecializations = new EqlSpecialization[eqlSpecializerObjects.length()];
+ for (int i = 0; i < gf.eqlSpecializations.length; i++) {
+ gf.eqlSpecializations[i] = new EqlSpecialization(eqlSpecializerObjects.car());
+ eqlSpecializerObjects = eqlSpecializerObjects.cdr();
+ }
+ return NIL;
+ }
+ };
private static class EqlSpecialization extends LispObject
{
@@ -806,7 +941,6 @@
}
public static final StandardGenericFunction checkStandardGenericFunction(LispObject obj)
-
{
if (obj instanceof StandardGenericFunction)
return (StandardGenericFunction) obj;
Modified: trunk/abcl/src/org/armedbear/lisp/StandardMethod.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/StandardMethod.java Sat Aug 27 16:23:05 2011 (r13540)
+++ trunk/abcl/src/org/armedbear/lisp/StandardMethod.java Sat Aug 27 16:23:24 2011 (r13541)
@@ -63,81 +63,114 @@
slots[StandardMethodClass.SLOT_INDEX_DOCUMENTATION] = NIL;
}
- // ### method-lambda-list
- // generic function
- private static final Primitive METHOD_LAMBDA_LIST =
- new Primitive("method-lambda-list", PACKAGE_SYS, true, "method")
+ private static final Primitive METHOD_LAMBDA_LIST
+ = new pf_method_lambda_list();
+ @DocString(name="method-lambda-list",
+ args="generic-method")
+ private static final class pf_method_lambda_list extends Primitive
+ {
+ pf_method_lambda_list()
{
- @Override
- public LispObject execute(LispObject arg)
- {
- return checkStandardMethod(arg).slots[StandardMethodClass.SLOT_INDEX_LAMBDA_LIST];
- }
- };
-
- // ### set-method-lambda-list
- private static final Primitive SET_METHOD_LAMBDA_LIST =
- new Primitive("set-method-lambda-list", PACKAGE_SYS, true,
- "method lambda-list")
+ super("method-lambda-list", PACKAGE_SYS, true, "generic-method");
+ }
+ @Override
+ public LispObject execute(LispObject arg)
+ {
+ return checkStandardMethod(arg).slots[StandardMethodClass.SLOT_INDEX_LAMBDA_LIST];
+ }
+ };
+
+ private static final Primitive SET_METHOD_LAMBDA_LIST
+ = new pf_set_method_lambda_list();
+ @DocString(name="set-method-lambda-list",
+ args="method lambda-list")
+ private static final class pf_set_method_lambda_list extends Primitive
+ {
+ pf_set_method_lambda_list()
{
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- checkStandardMethod(first).slots[StandardMethodClass.SLOT_INDEX_LAMBDA_LIST] = second;
- return second;
- }
- };
-
- // ### method-qualifiers
- private static final Primitive _METHOD_QUALIFIERS =
- new Primitive("%method-qualifiers", PACKAGE_SYS, true, "method")
+ super("set-method-lambda-list", PACKAGE_SYS, true,
+ "method lambda-list");
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ checkStandardMethod(first).slots[StandardMethodClass.SLOT_INDEX_LAMBDA_LIST] = second;
+ return second;
+ }
+ };
+
+
+ private static final Primitive _METHOD_QUALIFIERS
+ = new gf__method_qualifiers();
+ @DocString(name="%method-qualifiers",
+ args="method")
+ private static final class gf__method_qualifiers extends Primitive
+ {
+ gf__method_qualifiers()
{
- @Override
- public LispObject execute(LispObject arg)
- {
- return checkStandardMethod(arg).slots[StandardMethodClass.SLOT_INDEX_QUALIFIERS];
- }
- };
-
- // ### set-method-qualifiers
- private static final Primitive SET_METHOD_QUALIFIERS =
- new Primitive("set-method-qualifiers", PACKAGE_SYS, true,
- "method qualifiers")
- {
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- checkStandardMethod(first).slots[StandardMethodClass.SLOT_INDEX_QUALIFIERS] = second;
- return second;
- }
- };
-
- // ### method-documentation
- private static final Primitive METHOD_DOCUMENTATION =
- new Primitive("method-documentation", PACKAGE_SYS, true, "method")
+ super("%method-qualifiers", PACKAGE_SYS, true, "method");
+ }
+ @Override
+ public LispObject execute(LispObject arg)
+ {
+ return checkStandardMethod(arg).slots[StandardMethodClass.SLOT_INDEX_QUALIFIERS];
+ }
+ };
+
+ private static final Primitive SET_METHOD_QUALIFIERS
+ = new pf_set_method_qualifiers();
+ @DocString(name="set-method-qualifiers",
+ args="method qualifiers")
+ private static final class pf_set_method_qualifiers extends Primitive
+ {
+ pf_set_method_qualifiers()
{
- @Override
- public LispObject execute(LispObject arg)
- {
- return checkStandardMethod(arg).slots[StandardMethodClass.SLOT_INDEX_DOCUMENTATION];
- }
- };
-
- // ### set-method-documentation
- private static final Primitive SET_METHOD_DOCUMENTATION =
- new Primitive("set-method-documentation", PACKAGE_SYS, true,
- "method documentation")
+ super("set-method-qualifiers", PACKAGE_SYS, true,
+ "method qualifiers");
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ checkStandardMethod(first).slots[StandardMethodClass.SLOT_INDEX_QUALIFIERS] = second;
+ return second;
+ }
+ };
+
+ private static final Primitive METHOD_DOCUMENTATION
+ = new pf_method_documentation();
+ @DocString(name="method-documentation",
+ args="method")
+ private static final class pf_method_documentation extends Primitive
+ {
+ pf_method_documentation()
{
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- checkStandardMethod(first).slots[StandardMethodClass.SLOT_INDEX_DOCUMENTATION] = second;
- return second;
- }
- };
+ super("method-documentation", PACKAGE_SYS, true, "method");
+ }
+ @Override
+ public LispObject execute(LispObject arg)
+ {
+ return checkStandardMethod(arg).slots[StandardMethodClass.SLOT_INDEX_DOCUMENTATION];
+ }
+ };
+
+ private static final Primitive SET_METHOD_DOCUMENTATION
+ = new pf_set_method_documentation();
+ @DocString(name="set-method-documentation",
+ args="method documentation")
+ private static final class pf_set_method_documentation extends Primitive
+ {
+ pf_set_method_documentation()
+ {
+ super("set-method-documentation", PACKAGE_SYS, true,
+ "method documentation");
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ checkStandardMethod(first).slots[StandardMethodClass.SLOT_INDEX_DOCUMENTATION] = second;
+ return second;
+ }
+ };
public LispObject getFunction()
{
@@ -190,104 +223,144 @@
return super.printObject();
}
- // ### %method-generic-function
- private static final Primitive _METHOD_GENERIC_FUNCTION =
- new Primitive("%method-generic-function", PACKAGE_SYS, true)
+ private static final Primitive _METHOD_GENERIC_FUNCTION
+ = new pf__method_generic_function();
+ @DocString(name="%method-generic-function")
+ private static final class pf__method_generic_function extends Primitive
+ {
+ pf__method_generic_function()
{
- @Override
- public LispObject execute(LispObject arg)
- {
- return checkStandardMethod(arg).slots[StandardMethodClass.SLOT_INDEX_GENERIC_FUNCTION];
- }
- };
-
- // ### %set-method-generic-function
- private static final Primitive _SET_METHOD_GENERICFUNCTION =
- new Primitive("%set-method-generic-function", PACKAGE_SYS, true)
+ super("%method-generic-function", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject arg)
+ {
+ return checkStandardMethod(arg).slots[StandardMethodClass.SLOT_INDEX_GENERIC_FUNCTION];
+ }
+ };
+
+ private static final Primitive _SET_METHOD_GENERICFUNCTION
+ = new pf__set_method_genericfunction();
+ @DocString(name="%set-method-generic-function")
+ private static final class pf__set_method_genericfunction extends Primitive
+ {
+ pf__set_method_genericfunction()
{
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- checkStandardMethod(first).slots[StandardMethodClass.SLOT_INDEX_GENERIC_FUNCTION] = second;
- return second;
- }
- };
-
- // ### %method-function
- private static final Primitive _METHOD_FUNCTION =
- new Primitive("%method-function", PACKAGE_SYS, true, "method")
+ super("%set-method-generic-function", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ checkStandardMethod(first).slots[StandardMethodClass.SLOT_INDEX_GENERIC_FUNCTION] = second;
+ return second;
+ }
+ };
+
+ private static final Primitive _METHOD_FUNCTION
+ = new pf__method_function();
+ @DocString(name="%method-function")
+ private static final class pf__method_function extends Primitive
+ {
+ pf__method_function()
+ {
+ super("%method-function", PACKAGE_SYS, true, "method");
+ }
+ @Override
+ public LispObject execute(LispObject arg)
{
- @Override
- public LispObject execute(LispObject arg)
- {
return checkStandardMethod(arg).slots[StandardMethodClass.SLOT_INDEX_FUNCTION];
- }
- };
+ }
+ };
- // ### %set-method-function
- private static final Primitive _SET_METHOD_FUNCTION =
- new Primitive("%set-method-function", PACKAGE_SYS, true,
- "method function")
+ private static final Primitive _SET_METHOD_FUNCTION
+ = new pf__set_method_function();
+ @DocString(name="%set-method-function",
+ args="method function")
+ private static final class pf__set_method_function extends Primitive
+ {
+ pf__set_method_function()
{
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- checkStandardMethod(first).slots[StandardMethodClass.SLOT_INDEX_FUNCTION] = second;
- return second;
- }
- };
-
- // ### %method-fast-function
- private static final Primitive _METHOD_FAST_FUNCTION =
- new Primitive("%method-fast-function", PACKAGE_SYS, true, "method")
+ super("%set-method-function", PACKAGE_SYS, true,
+ "method function");
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ checkStandardMethod(first).slots[StandardMethodClass.SLOT_INDEX_FUNCTION] = second;
+ return second;
+ }
+ };
+
+ private static final Primitive _METHOD_FAST_FUNCTION
+ = new pf__method_fast_function();
+ @DocString(name="%method-fast-function",
+ args="method")
+ private static final class pf__method_fast_function extends Primitive
+ {
+ pf__method_fast_function()
{
- @Override
- public LispObject execute(LispObject arg)
- {
- return checkStandardMethod(arg).slots[StandardMethodClass.SLOT_INDEX_FAST_FUNCTION];
- }
- };
-
- // ### %set-method-fast-function
- private static final Primitive _SET_METHOD_FAST_FUNCTION =
- new Primitive("%set-method-fast-function", PACKAGE_SYS, true,
- "method fast-function")
+ super("%method-fast-function", PACKAGE_SYS, true, "method");
+ }
+ @Override
+ public LispObject execute(LispObject arg)
+ {
+ return checkStandardMethod(arg).slots[StandardMethodClass.SLOT_INDEX_FAST_FUNCTION];
+ }
+ };
+
+ private static final Primitive _SET_METHOD_FAST_FUNCTION
+ = new pf__set_method_fast_function();
+ @DocString(name="%set-method-fast-function",
+ args="method fast-function")
+ private static final class pf__set_method_fast_function extends Primitive
+ {
+ pf__set_method_fast_function()
{
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- checkStandardMethod(first).slots[StandardMethodClass.SLOT_INDEX_FAST_FUNCTION] = second;
- return second;
- }
- };
-
- // ### %method-specializers
- private static final Primitive _METHOD_SPECIALIZERS =
- new Primitive("%method-specializers", PACKAGE_SYS, true, "method")
+ super("%set-method-fast-function", PACKAGE_SYS, true,
+ "method fast-function");
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ checkStandardMethod(first).slots[StandardMethodClass.SLOT_INDEX_FAST_FUNCTION] = second;
+ return second;
+ }
+ };
+
+ private static final Primitive _METHOD_SPECIALIZERS
+ = new pf__method_specializers();
+ @DocString(name="%method-specializers")
+ private static final class pf__method_specializers extends Primitive
+ {
+ pf__method_specializers()
{
- @Override
- public LispObject execute(LispObject arg)
- {
- return checkStandardMethod(arg).slots[StandardMethodClass.SLOT_INDEX_SPECIALIZERS];
- }
- };
-
- // ### %set-method-specializers
- private static final Primitive _SET_METHOD_SPECIALIZERS =
- new Primitive("%set-method-specializers", PACKAGE_SYS, true,
- "method specializers")
+ super("%method-specializers", PACKAGE_SYS, true, "method");
+ }
+ @Override
+ public LispObject execute(LispObject arg)
+ {
+ return checkStandardMethod(arg).slots[StandardMethodClass.SLOT_INDEX_SPECIALIZERS];
+ }
+ };
+
+ private static final Primitive _SET_METHOD_SPECIALIZERS
+ = new pf__set_method_specializers();
+ @DocString(name="%set-method-specializers",
+ args="method specializers")
+ private static final class pf__set_method_specializers extends Primitive
+ {
+ pf__set_method_specializers()
{
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- checkStandardMethod(first).slots[StandardMethodClass.SLOT_INDEX_SPECIALIZERS] = second;
- return second;
- }
- };
+ super("%set-method-specializers", PACKAGE_SYS, true,
+ "method specializers");
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ checkStandardMethod(first).slots[StandardMethodClass.SLOT_INDEX_SPECIALIZERS] = second;
+ return second;
+ }
+ };
private static final StandardGenericFunction METHOD_SPECIALIZERS =
new StandardGenericFunction("method-specializers",
@@ -305,11 +378,10 @@
list(Symbol.METHOD),
list(StandardClass.STANDARD_METHOD));
- final public static StandardMethod checkStandardMethod(LispObject first)
- {
- if (first instanceof StandardMethod)
- return (StandardMethod) first;
- return (StandardMethod) type_error(first, Symbol.METHOD);
- }
-
+ final public static StandardMethod checkStandardMethod(LispObject first)
+ {
+ if (first instanceof StandardMethod)
+ return (StandardMethod) first;
+ return (StandardMethod) type_error(first, Symbol.METHOD);
+ }
}
Modified: trunk/abcl/src/org/armedbear/lisp/StandardObject.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/StandardObject.java Sat Aug 27 16:23:05 2011 (r13540)
+++ trunk/abcl/src/org/armedbear/lisp/StandardObject.java Sat Aug 27 16:23:24 2011 (r13541)
@@ -320,171 +320,207 @@
}
Debug.assertTrue(layout != null);
int index = layout.getSlotIndex(slotName);
- //### FIXME: should call SLOT-MISSING (clhs)
+ // FIXME: should call SLOT-MISSING (clhs)
if (index < 0)
error(new LispError("Missing slot " + slotName.princToString()));
slots[index] = newValue;
}
-
- final public static StandardObject checkStandardObject(LispObject first)
+
+ final public static StandardObject checkStandardObject(LispObject first)
+ {
+ if (first instanceof StandardObject)
+ return (StandardObject) first;
+ return (StandardObject) type_error(first, Symbol.STANDARD_OBJECT);
+ }
+
+ private static final Primitive SWAP_SLOTS
+ = new pf_swap_slots();
+ @DocString(name="swap-slots",
+ args="instance-1 instance-2",
+ returns="nil")
+ private static final class pf_swap_slots extends Primitive
+ {
+ pf_swap_slots()
+ {
+ super("swap-slots", PACKAGE_SYS, true, "instance-1 instance-2");
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ final StandardObject obj1 = checkStandardObject(first);
+ final StandardObject obj2 = checkStandardObject(second);
+ LispObject[] temp = obj1.slots;
+ obj1.slots = obj2.slots;
+ obj2.slots = temp;
+ return NIL;
+ }
+ };
+
+ private static final Primitive STD_INSTANCE_LAYOUT
+ = new pf_std_instance_layout();
+ @DocString(name="std-instance-layout")
+ private static final class pf_std_instance_layout extends Primitive
+ {
+ pf_std_instance_layout()
+ {
+ super("std-instance-layout", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject arg)
+ {
+ final StandardObject instance = checkStandardObject(arg);
+ Layout layout = instance.layout;
+ if (layout.isInvalid())
{
- if (first instanceof StandardObject)
- return (StandardObject) first;
- return (StandardObject) type_error(first, Symbol.STANDARD_OBJECT);
+ // Update instance.
+ layout = instance.updateLayout();
}
-
- // ### swap-slots instance-1 instance-2 => nil
- private static final Primitive SWAP_SLOTS =
- new Primitive("swap-slots", PACKAGE_SYS, true, "instance-1 instance-2")
+ return layout;
+ }
+ };
+
+ private static final Primitive _SET_STD_INSTANCE_LAYOUT
+ = new pf__set_std_instance_layout();
+ @DocString(name="%set-std-instance-layout")
+ private static final class pf__set_std_instance_layout extends Primitive
+ {
+ pf__set_std_instance_layout()
{
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- final StandardObject obj1 = checkStandardObject(first);
- final StandardObject obj2 = checkStandardObject(second);
- LispObject[] temp = obj1.slots;
- obj1.slots = obj2.slots;
- obj2.slots = temp;
- return NIL;
- }
- };
-
- // ### std-instance-layout
- private static final Primitive STD_INSTANCE_LAYOUT =
- new Primitive("std-instance-layout", PACKAGE_SYS, true)
+ super("%set-std-instance-layout", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
{
- @Override
- public LispObject execute(LispObject arg)
- {
- final StandardObject instance = checkStandardObject(arg);
- Layout layout = instance.layout;
- if (layout.isInvalid())
- {
- // Update instance.
- layout = instance.updateLayout();
- }
- return layout;
- }
- };
-
- // ### %set-std-instance-layout
- private static final Primitive _SET_STD_INSTANCE_LAYOUT =
- new Primitive("%set-std-instance-layout", PACKAGE_SYS, true)
+ checkStandardObject(first).layout = checkLayout(second);
+ return second;
+ }
+ };
+
+ private static final Primitive STD_INSTANCE_CLASS
+ = new pf_std_instance_class();
+ @DocString(name="std-instance-class")
+ private static final class pf_std_instance_class extends Primitive
+ {
+ pf_std_instance_class()
{
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- checkStandardObject(first).layout = checkLayout(second);
- return second;
- }
- };
-
- // ### std-instance-class
- private static final Primitive STD_INSTANCE_CLASS =
- new Primitive("std-instance-class", PACKAGE_SYS, true)
+ super("std-instance-class", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject arg)
{
- @Override
- public LispObject execute(LispObject arg)
- {
- return checkStandardObject(arg).layout.getLispClass();
- }
- };
-
- // ### standard-instance-access instance location => value
- private static final Primitive STANDARD_INSTANCE_ACCESS =
- new Primitive("standard-instance-access", PACKAGE_SYS, true,
- "instance location")
+ return checkStandardObject(arg).layout.getLispClass();
+ }
+ };
+
+ private static final Primitive STANDARD_INSTANCE_ACCESS
+ = new pf_standard_instance_access();
+ @DocString(name="standard-instance-access",
+ args="instance location",
+ returns="value")
+ private static final class pf_standard_instance_access extends Primitive
+ {
+ pf_standard_instance_access()
{
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- final StandardObject instance = checkStandardObject(first);
- final int index;
- if (second instanceof Fixnum)
- {
- index = ((Fixnum)second).value;
- }
- else
- {
- return type_error(second,
- list(Symbol.INTEGER, Fixnum.ZERO,
- Fixnum.getInstance(instance.slots.length)));
- }
- LispObject value;
- try
- {
- value = instance.slots[index];
- }
- catch (ArrayIndexOutOfBoundsException e)
- {
- return type_error(second,
- list(Symbol.INTEGER, Fixnum.ZERO,
- Fixnum.getInstance(instance.slots.length)));
- }
- if (value == UNBOUND_VALUE)
- {
- LispObject slotName = instance.layout.getSlotNames()[index];
- value = Symbol.SLOT_UNBOUND.execute(instance.getLispClass(),
- instance, slotName);
- LispThread.currentThread()._values = null;
- }
- return value;
- }
- };
-
- // ### %set-standard-instance-access instance location new-value => new-value
- private static final Primitive _SET_STANDARD_INSTANCE_ACCESS =
- new Primitive("%set-standard-instance-access", PACKAGE_SYS, true)
- {
- @Override
- public LispObject execute(LispObject first, LispObject second,
- LispObject third)
-
- {
- checkStandardObject(first).slots[Fixnum.getValue(second)] = third; // FIXME
- return third;
- }
- };
-
- // ### std-slot-boundp
- private static final Primitive STD_SLOT_BOUNDP =
- new Primitive(Symbol.STD_SLOT_BOUNDP, "instance slot-name")
+ super("standard-instance-access", PACKAGE_SYS, true,
+ "instance location");
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
{
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- final StandardObject instance = checkStandardObject(first);
- Layout layout = instance.layout;
- if (layout.isInvalid())
- {
- // Update instance.
- layout = instance.updateLayout();
- }
- final LispObject index = layout.slotTable.get(second);
- if (index != null)
- {
- // Found instance slot.
- return instance.slots[((Fixnum)index).value] != UNBOUND_VALUE ? T : NIL;
- }
- // Check for shared slot.
- final LispObject location = layout.getSharedSlotLocation(second);
- if (location != null)
- return location.cdr() != UNBOUND_VALUE ? T : NIL;
- // Not found.
- final LispThread thread = LispThread.currentThread();
- LispObject value =
- thread.execute(Symbol.SLOT_MISSING, instance.getLispClass(),
- instance, second, Symbol.SLOT_BOUNDP);
- // "If SLOT-MISSING is invoked and returns a value, a boolean
- // equivalent to its primary value is returned by SLOT-BOUNDP."
- thread._values = null;
- return value != NIL ? T : NIL;
- }
- };
+ final StandardObject instance = checkStandardObject(first);
+ final int index;
+ if (second instanceof Fixnum)
+ {
+ index = ((Fixnum)second).value;
+ }
+ else
+ {
+ return type_error(second,
+ list(Symbol.INTEGER, Fixnum.ZERO,
+ Fixnum.getInstance(instance.slots.length)));
+ }
+ LispObject value;
+ try
+ {
+ value = instance.slots[index];
+ }
+ catch (ArrayIndexOutOfBoundsException e)
+ {
+ return type_error(second,
+ list(Symbol.INTEGER, Fixnum.ZERO,
+ Fixnum.getInstance(instance.slots.length)));
+ }
+ if (value == UNBOUND_VALUE)
+ {
+ LispObject slotName = instance.layout.getSlotNames()[index];
+ value = Symbol.SLOT_UNBOUND.execute(instance.getLispClass(),
+ instance, slotName);
+ LispThread.currentThread()._values = null;
+ }
+ return value;
+ }
+ };
+
+ private static final Primitive _SET_STANDARD_INSTANCE_ACCESS
+ = new pf__set_standard_instance_access();
+ @DocString(name="%set-standard-instance-access",
+ args="instance location new-value",
+ returns="new-value")
+ private static final class pf__set_standard_instance_access extends Primitive
+ {
+ pf__set_standard_instance_access()
+ {
+ super("%set-standard-instance-access", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second,
+ LispObject third)
+ {
+ checkStandardObject(first).slots[Fixnum.getValue(second)] = third; // FIXME
+ return third;
+ }
+ };
+
+ private static final Primitive STD_SLOT_BOUNDP
+ = new pf_std_slot_boundp();
+ @DocString(name="std-slot-boundp")
+ private static final class pf_std_slot_boundp extends Primitive
+ {
+ pf_std_slot_boundp()
+ {
+ super(Symbol.STD_SLOT_BOUNDP, "instance slot-name");
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ final StandardObject instance = checkStandardObject(first);
+ Layout layout = instance.layout;
+ if (layout.isInvalid())
+ {
+ // Update instance.
+ layout = instance.updateLayout();
+ }
+ final LispObject index = layout.slotTable.get(second);
+ if (index != null)
+ {
+ // Found instance slot.
+ return instance.slots[((Fixnum)index).value] != UNBOUND_VALUE ? T : NIL;
+ }
+ // Check for shared slot.
+ final LispObject location = layout.getSharedSlotLocation(second);
+ if (location != null)
+ return location.cdr() != UNBOUND_VALUE ? T : NIL;
+ // Not found.
+ final LispThread thread = LispThread.currentThread();
+ LispObject value =
+ thread.execute(Symbol.SLOT_MISSING, instance.getLispClass(),
+ instance, second, Symbol.SLOT_BOUNDP);
+ // "If SLOT-MISSING is invoked and returns a value, a boolean
+ // equivalent to its primary value is returned by SLOT-BOUNDP."
+ thread._values = null;
+ return value != NIL ? T : NIL;
+ }
+ };
@Override
public LispObject SLOT_VALUE(LispObject slotName)
@@ -518,21 +554,24 @@
return value;
}
- // ### std-slot-value
- private static final Primitive STD_SLOT_VALUE =
- new Primitive(Symbol.STD_SLOT_VALUE, "instance slot-name")
+ private static final Primitive STD_SLOT_VALUE
+ = new pf_std_slot_value();
+ @DocString(name="std-slot-value")
+ private static final class pf_std_slot_value extends Primitive
+ {
+ pf_std_slot_value()
{
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- return first.SLOT_VALUE(second);
- }
- };
+ super(Symbol.STD_SLOT_VALUE, "instance slot-name");
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ return first.SLOT_VALUE(second);
+ }
+ };
@Override
public void setSlotValue(LispObject slotName, LispObject newValue)
-
{
if (layout.isInvalid())
{
@@ -562,17 +601,21 @@
Symbol.SLOT_MISSING.execute(args);
}
- // ### set-std-slot-value
- private static final Primitive SET_STD_SLOT_VALUE =
- new Primitive(Symbol.SET_STD_SLOT_VALUE, "instance slot-name new-value")
- {
- @Override
- public LispObject execute(LispObject first, LispObject second,
- LispObject third)
-
- {
- first.setSlotValue(second, third);
- return third;
- }
- };
+ private static final Primitive SET_STD_SLOT_VALUE
+ = new pf_set_std_slot_value();
+ @DocString(name="set-std-slot-value")
+ private static final class pf_set_std_slot_value extends Primitive
+ {
+ pf_set_std_slot_value()
+ {
+ super(Symbol.SET_STD_SLOT_VALUE, "instance slot-name new-value");
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second,
+ LispObject third)
+ {
+ first.setSlotValue(second, third);
+ return third;
+ }
+ };
}
Modified: trunk/abcl/src/org/armedbear/lisp/StandardObjectFunctions.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/StandardObjectFunctions.java Sat Aug 27 16:23:05 2011 (r13540)
+++ trunk/abcl/src/org/armedbear/lisp/StandardObjectFunctions.java Sat Aug 27 16:23:24 2011 (r13541)
@@ -37,25 +37,32 @@
public class StandardObjectFunctions
{
- // ### %std-allocate-instance class => instance
- private static final Primitive _STD_ALLOCATE_INSTANCE =
- new Primitive("%std-allocate-instance", PACKAGE_SYS, true, "class")
+ private static final Primitive _STD_ALLOCATE_INSTANCE
+ = new pf__std_allocate_instance();
+ @DocString(name="%std-allocate-instance",
+ args="class",
+ returns="instance")
+ private static final class pf__std_allocate_instance extends Primitive
+ {
+ pf__std_allocate_instance()
{
- @Override
- public LispObject execute(LispObject arg)
- {
- if (arg == StandardClass.STANDARD_CLASS)
- return new StandardClass();
- if (arg instanceof StandardClass)
- return ((StandardClass)arg).allocateInstance();
- if (arg.typep(StandardClass.STANDARD_CLASS) != NIL) {
- LispObject l = Symbol.CLASS_LAYOUT.execute(arg);
- if (! (l instanceof Layout))
- return error(new ProgramError("Invalid standard class layout for: " + arg.princToString()));
-
- return new StandardObject((Layout)l);
- }
- return type_error(arg, Symbol.STANDARD_CLASS);
+ super("%std-allocate-instance", PACKAGE_SYS, true, "class");
+ }
+ @Override
+ public LispObject execute(LispObject arg)
+ {
+ if (arg == StandardClass.STANDARD_CLASS)
+ return new StandardClass();
+ if (arg instanceof StandardClass)
+ return ((StandardClass)arg).allocateInstance();
+ if (arg.typep(StandardClass.STANDARD_CLASS) != NIL) {
+ LispObject l = Symbol.CLASS_LAYOUT.execute(arg);
+ if (! (l instanceof Layout))
+ return error(new ProgramError("Invalid standard class layout for: " + arg.princToString()));
+
+ return new StandardObject((Layout)l);
}
- };
+ return type_error(arg, Symbol.STANDARD_CLASS);
+ }
+ };
}
Modified: trunk/abcl/src/org/armedbear/lisp/StandardReaderMethod.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/StandardReaderMethod.java Sat Aug 27 16:23:05 2011 (r13540)
+++ trunk/abcl/src/org/armedbear/lisp/StandardReaderMethod.java Sat Aug 27 16:23:24 2011 (r13541)
@@ -43,10 +43,16 @@
StandardClass.STANDARD_READER_METHOD.getClassLayout().getLength());
}
- // ### reader-method-slot-name
- private static final Primitive READER_METHOD_SLOT_NAME =
- new Primitive("reader-method-slot-name", PACKAGE_MOP, false, "reader-method")
+ private static final Primitive READER_METHOD_SLOT_NAME
+ = new pf_reader_method_slot_name();
+ @DocString(name="reader-method-slot-name",
+ args="reader-method")
+ private static final class pf_reader_method_slot_name extends Primitive
{
+ pf_reader_method_slot_name()
+ {
+ super("reader-method-slot-name", PACKAGE_MOP, false, "reader-method");
+ }
@Override
public LispObject execute(LispObject arg)
{
@@ -56,11 +62,17 @@
}
};
- // ### set-reader-method-slot-name
- private static final Primitive SET_READER_METHOD_SLOT_NAME =
- new Primitive("set-reader-method-slot-name", PACKAGE_MOP, false,
- "reader-method slot-name")
+ private static final Primitive SET_READER_METHOD_SLOT_NAME
+ = new pf_set_reader_method_slot_name();
+ @DocString(name="set-reader-method-slot-name",
+ args="reader-method slot-name")
+ private static final class pf_set_reader_method_slot_name extends Primitive
{
+ pf_set_reader_method_slot_name()
+ {
+ super("set-reader-method-slot-name", PACKAGE_MOP, false,
+ "reader-method slot-name");
+ }
@Override
public LispObject execute(LispObject first, LispObject second)
Modified: trunk/abcl/src/org/armedbear/lisp/StructureObject.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/StructureObject.java Sat Aug 27 16:23:05 2011 (r13540)
+++ trunk/abcl/src/org/armedbear/lisp/StructureObject.java Sat Aug 27 16:23:24 2011 (r13541)
@@ -522,39 +522,59 @@
}
}
- // ### structure-object-p object => generalized-boolean
- private static final Primitive STRUCTURE_OBJECT_P =
- new Primitive("structure-object-p", PACKAGE_SYS, true, "object")
- {
- @Override
- public LispObject execute(LispObject arg)
- {
- return arg instanceof StructureObject ? T : NIL;
- }
- };
-
- // ### structure-length instance => length
- private static final Primitive STRUCTURE_LENGTH =
- new Primitive("structure-length", PACKAGE_SYS, true, "instance")
- {
- @Override
- public LispObject execute(LispObject arg)
- {
- if (arg instanceof StructureObject)
- return Fixnum.getInstance(((StructureObject)arg).slots.length);
- return type_error(arg, Symbol.STRUCTURE_OBJECT);
- }
- };
-
- // ### structure-ref instance index => value
- private static final Primitive STRUCTURE_REF =
- new Primitive("structure-ref", PACKAGE_SYS, true)
+ private static final Primitive STRUCTURE_OBJECT_P
+ = new pf_structure_object_p();
+ @DocString(name="structure-object-p",
+ args="object",
+ returns="generalized-boolean")
+ private static final class pf_structure_object_p extends Primitive
+ {
+ pf_structure_object_p()
+ {
+ super("structure-object-p", PACKAGE_SYS, true, "object");
+ }
+ @Override
+ public LispObject execute(LispObject arg)
+ {
+ return arg instanceof StructureObject ? T : NIL;
+ }
+ };
+
+ private static final Primitive STRUCTURE_LENGTH
+ = new pf_structure_length();
+ @DocString(name="structure-length",
+ args="instance",
+ returns="length")
+ private static final class pf_structure_length extends Primitive
+ {
+ pf_structure_length()
+ {
+ super("structure-length", PACKAGE_SYS, true, "instance");
+ }
+ @Override
+ public LispObject execute(LispObject arg)
+ {
+ if (arg instanceof StructureObject)
+ return Fixnum.getInstance(((StructureObject)arg).slots.length);
+ return type_error(arg, Symbol.STRUCTURE_OBJECT);
+ }
+ };
+
+ private static final Primitive STRUCTURE_REF
+ = new pf_structure_ref();
+ @DocString(name="structure-ref",
+ args="instance index",
+ returns="value")
+ private static final class pf_structure_ref extends Primitive
+ {
+ pf_structure_ref()
+ {
+ super("structure-ref", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
{
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- if (first instanceof StructureObject)
+ if (first instanceof StructureObject)
try
{
return ((StructureObject)first).slots[Fixnum.getValue(second)];
@@ -565,110 +585,129 @@
return error(new LispError("Internal error."));
}
return type_error(first, Symbol.STRUCTURE_OBJECT);
- }
- };
+ }
+ };
- // ### structure-set instance index new-value => new-value
- private static final Primitive STRUCTURE_SET =
- new Primitive("structure-set", PACKAGE_SYS, true)
- {
- @Override
- public LispObject execute(LispObject first, LispObject second,
- LispObject third)
-
- {
-
- if (first instanceof StructureObject)
- try
- {
- ((StructureObject)first).slots[Fixnum.getValue(second)] = third;
- return third;
- }
- catch (ArrayIndexOutOfBoundsException e)
- {
- // Shouldn't happen.
- return error(new LispError("Internal error."));
- }
- return type_error(first, Symbol.STRUCTURE_OBJECT);
- }
- };
-
- // ### make-structure
- private static final Primitive MAKE_STRUCTURE =
- new Primitive("make-structure", PACKAGE_SYS, true)
+ private static final Primitive STRUCTURE_SET
+ = new pf_structure_set();
+ @DocString(name="structure-set",
+ args="instance index new-value",
+ returns="new-value")
+ private static final class pf_structure_set extends Primitive
+ {
+ pf_structure_set()
+ {
+ super("structure-set", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second,
+ LispObject third)
{
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- return new StructureObject(checkSymbol(first), second);
- }
- @Override
- public LispObject execute(LispObject first, LispObject second,
- LispObject third)
-
- {
- return new StructureObject(checkSymbol(first), second, third);
- }
- @Override
- public LispObject execute(LispObject first, LispObject second,
- LispObject third, LispObject fourth)
-
- {
- return new StructureObject(checkSymbol(first), second, third, fourth);
- }
- @Override
- public LispObject execute(LispObject first, LispObject second,
- LispObject third, LispObject fourth,
- LispObject fifth)
-
- {
- return new StructureObject(checkSymbol(first), second, third, fourth,
- fifth);
- }
- @Override
- public LispObject execute(LispObject first, LispObject second,
- LispObject third, LispObject fourth,
- LispObject fifth, LispObject sixth)
-
- {
- return new StructureObject(checkSymbol(first), second, third, fourth,
- fifth, sixth);
- }
- @Override
- public LispObject execute(LispObject first, LispObject second,
- LispObject third, LispObject fourth,
- LispObject fifth, LispObject sixth,
- LispObject seventh)
-
- {
- return new StructureObject(checkSymbol(first), second, third, fourth,
- fifth, sixth, seventh);
- }
- };
-
- // ### %make-structure name slot-values => object
- private static final Primitive _MAKE_STRUCTURE =
- new Primitive("%make-structure", PACKAGE_SYS, true)
- {
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- return new StructureObject(checkSymbol(first), second.copyToArray());
- }
- };
+ if (first instanceof StructureObject)
+ try
+ {
+ ((StructureObject)first).slots[Fixnum.getValue(second)] = third;
+ return third;
+ }
+ catch (ArrayIndexOutOfBoundsException e)
+ {
+ // Shouldn't happen.
+ return error(new LispError("Internal error."));
+ }
+ return type_error(first, Symbol.STRUCTURE_OBJECT);
+ }
+ };
- // ### copy-structure structure => copy
- private static final Primitive COPY_STRUCTURE =
- new Primitive(Symbol.COPY_STRUCTURE, "structure")
- {
- @Override
- public LispObject execute(LispObject arg)
- {
- if (arg instanceof StructureObject)
- return new StructureObject((StructureObject)arg);
- return type_error(arg, Symbol.STRUCTURE_OBJECT);
- }
- };
+ private static final Primitive MAKE_STRUCTURE
+ = new pf_make_structure();
+ @DocString(name="make-structure")
+ private static final class pf_make_structure extends Primitive
+ {
+ pf_make_structure()
+ {
+ super("make-structure", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ return new StructureObject(checkSymbol(first), second);
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second,
+ LispObject third)
+
+ {
+ return new StructureObject(checkSymbol(first), second, third);
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second,
+ LispObject third, LispObject fourth)
+
+ {
+ return new StructureObject(checkSymbol(first), second, third, fourth);
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second,
+ LispObject third, LispObject fourth,
+ LispObject fifth)
+ {
+ return new StructureObject(checkSymbol(first), second, third, fourth,
+ fifth);
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second,
+ LispObject third, LispObject fourth,
+ LispObject fifth, LispObject sixth)
+ {
+ return new StructureObject(checkSymbol(first), second, third, fourth,
+ fifth, sixth);
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second,
+ LispObject third, LispObject fourth,
+ LispObject fifth, LispObject sixth,
+ LispObject seventh)
+ {
+ return new StructureObject(checkSymbol(first), second, third, fourth,
+ fifth, sixth, seventh);
+ }
+ };
+
+ private static final Primitive _MAKE_STRUCTURE
+ = new pf__make_structure();
+ @DocString(name="%make-structure",
+ args="name slot-values",
+ returns="object")
+ private static final class pf__make_structure extends Primitive
+ {
+ pf__make_structure()
+ {
+ super("%make-structure", PACKAGE_SYS, true);
+ }
+ @Override
+ public LispObject execute(LispObject first, LispObject second)
+ {
+ return new StructureObject(checkSymbol(first), second.copyToArray());
+ }
+ };
+
+ private static final Primitive COPY_STRUCTURE
+ = new pf_copy_structure();
+ @DocString(name="copy-structure",
+ args="structure",
+ returns="copy")
+ private static final class pf_copy_structure extends Primitive
+ {
+ pf_copy_structure()
+ {
+ super(Symbol.COPY_STRUCTURE, "structure");
+ }
+ @Override
+ public LispObject execute(LispObject arg)
+ {
+ if (arg instanceof StructureObject)
+ return new StructureObject((StructureObject)arg);
+ return type_error(arg, Symbol.STRUCTURE_OBJECT);
+ }
+ };
}
Modified: trunk/abcl/src/org/armedbear/lisp/mop.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/mop.lisp Sat Aug 27 16:23:05 2011 (r13540)
+++ trunk/abcl/src/org/armedbear/lisp/mop.lisp Sat Aug 27 16:23:24 2011 (r13541)
@@ -23,6 +23,8 @@
"This generic function is called to determine whether the class
superclass is suitable for use as a superclass of class."))
+;;; TODO Hook VALIDATE-SUPERCLASS into during class metaobject
+;;; initialization and reinitialization. (AMOP p.240-1)
(defmethod validate-superclass ((class class) (superclass class))
(or (eql (class-name superclass) t)
(eql (class-name class) (class-name superclass))
More information about the armedbear-cvs
mailing list