[armedbear-cvs] r13871 - trunk/abcl/src/org/armedbear/lisp
rschlatte at common-lisp.net
rschlatte at common-lisp.net
Sat Feb 11 22:28:12 UTC 2012
Author: rschlatte
Date: Sat Feb 11 14:28:11 2012
New Revision: 13871
Log:
Add FuncallableStandardClass.java
... make classes generic-function and standard-generic-function
instances of funcallable-standard-class, per AMOP.
Added:
trunk/abcl/src/org/armedbear/lisp/FuncallableStandardClass.java
- copied, changed from r13870, trunk/abcl/src/org/armedbear/lisp/StandardGenericFunctionClass.java
Modified:
trunk/abcl/src/org/armedbear/lisp/StandardClass.java
trunk/abcl/src/org/armedbear/lisp/StandardGenericFunctionClass.java
Copied and modified: trunk/abcl/src/org/armedbear/lisp/FuncallableStandardClass.java (from r13870, trunk/abcl/src/org/armedbear/lisp/StandardGenericFunctionClass.java)
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/StandardGenericFunctionClass.java Sat Feb 11 07:53:33 2012 (r13870, copy source)
+++ trunk/abcl/src/org/armedbear/lisp/FuncallableStandardClass.java Sat Feb 11 14:28:11 2012 (r13871)
@@ -1,7 +1,7 @@
/*
- * StandardGenericFunctionClass.java
+ * StandardClass.java
*
- * Copyright (C) 2005 Peter Graves
+ * Copyright (C) 2003-2005 Peter Graves
* $Id$
*
* This program is free software; you can redistribute it and/or
@@ -35,46 +35,66 @@
import static org.armedbear.lisp.Lisp.*;
-public final class StandardGenericFunctionClass extends StandardClass
+public class FuncallableStandardClass extends StandardClass
{
- public static final int SLOT_INDEX_NAME = 0;
- public static final int SLOT_INDEX_LAMBDA_LIST = 1;
- public static final int SLOT_INDEX_REQUIRED_ARGS = 2;
- public static final int SLOT_INDEX_OPTIONAL_ARGS = 3;
- public static final int SLOT_INDEX_INITIAL_METHODS = 4;
- public static final int SLOT_INDEX_METHODS = 5;
- public static final int SLOT_INDEX_METHOD_CLASS = 6;
- public static final int SLOT_INDEX_METHOD_COMBINATION = 7;
- public static final int SLOT_INDEX_ARGUMENT_PRECEDENCE_ORDER = 8;
- public static final int SLOT_INDEX_CLASSES_TO_EMF_TABLE = 9;
- public static final int SLOT_INDEX_DOCUMENTATION = 10;
-
- public StandardGenericFunctionClass()
- {
- super(Symbol.STANDARD_GENERIC_FUNCTION,
- list(StandardClass.GENERIC_FUNCTION));
- Package pkg = PACKAGE_SYS;
- LispObject[] instanceSlotNames =
- {
- pkg.intern("NAME"),
- pkg.intern("LAMBDA-LIST"),
- pkg.intern("REQUIRED-ARGS"),
- pkg.intern("OPTIONAL-ARGS"),
- pkg.intern("INITIAL-METHODS"),
- pkg.intern("METHODS"),
- pkg.intern("METHOD-CLASS"),
- pkg.intern("METHOD-COMBINATION"),
- pkg.intern("ARGUMENT-PRECEDENCE-ORDER"),
- pkg.intern("CLASSES-TO-EMF-TABLE"),
- Symbol.DOCUMENTATION
- };
- setClassLayout(new Layout(this, instanceSlotNames, NIL));
- setFinalized(true);
+
+ public FuncallableStandardClass()
+ {
+ super(StandardClass.layoutFuncallableStandardClass);
+ }
+
+ public FuncallableStandardClass(Symbol symbol, LispObject directSuperclasses)
+ {
+ super(StandardClass.layoutFuncallableStandardClass,
+ symbol, directSuperclasses);
}
@Override
+ public LispObject typeOf()
+ {
+ return Symbol.FUNCALLABLE_STANDARD_CLASS;
+ }
+
+ @Override
+ public LispObject classOf()
+ {
+ return StandardClass.FUNCALLABLE_STANDARD_CLASS;
+ }
+
+ @Override
+ public LispObject typep(LispObject type)
+ {
+ if (type == Symbol.FUNCALLABLE_STANDARD_CLASS)
+ return T;
+ if (type == StandardClass.FUNCALLABLE_STANDARD_CLASS)
+ return T;
+ return super.typep(type);
+ }
+
public LispObject allocateInstance()
{
- return new StandardGenericFunction();
+ Layout layout = getClassLayout();
+ if (layout == null)
+ {
+ Symbol.ERROR.execute(Symbol.SIMPLE_ERROR,
+ Keyword.FORMAT_CONTROL,
+ new SimpleString("No layout for class ~S."),
+ Keyword.FORMAT_ARGUMENTS,
+ list(this));
+ }
+ return new FuncallableStandardObject(this, layout.getLength());
+ }
+
+ @Override
+ public String printObject()
+ {
+ StringBuilder sb =
+ new StringBuilder(Symbol.FUNCALLABLE_STANDARD_CLASS.printObject());
+ if (getName() != null)
+ {
+ sb.append(' ');
+ sb.append(getName().printObject());
+ }
+ return unreadableString(sb.toString());
}
}
Modified: trunk/abcl/src/org/armedbear/lisp/StandardClass.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/StandardClass.java Sat Feb 11 07:53:33 2012 (r13870)
+++ trunk/abcl/src/org/armedbear/lisp/StandardClass.java Sat Feb 11 14:28:11 2012 (r13871)
@@ -93,6 +93,31 @@
}
};
+ static Layout layoutFuncallableStandardClass =
+ new Layout(null,
+ list(symName,
+ symLayout,
+ symDirectSuperclasses,
+ symDirectSubclasses,
+ symPrecedenceList,
+ symDirectMethods,
+ symDirectSlots,
+ symSlots,
+ symDirectDefaultInitargs,
+ symDefaultInitargs,
+ symFinalizedP,
+ Symbol.DOCUMENTATION),
+ NIL)
+ {
+ @Override
+ public LispClass getLispClass()
+ {
+ return FUNCALLABLE_STANDARD_CLASS;
+ }
+ };
+
+
+
public StandardClass()
{
super(layoutStandardClass);
@@ -125,6 +150,38 @@
setFinalized(false);
}
+ public StandardClass(Layout layout)
+ {
+ super(layout);
+ setDirectSuperclasses(NIL);
+ setDirectSubclasses(NIL);
+ setClassLayout(layout);
+ setCPL(NIL);
+ setDirectMethods(NIL);
+ setDocumentation(NIL);
+ setDirectSlotDefinitions(NIL);
+ setSlotDefinitions(NIL);
+ setDirectDefaultInitargs(NIL);
+ setDefaultInitargs(NIL);
+ setFinalized(false);
+ }
+
+ public StandardClass(Layout layout, Symbol symbol, LispObject directSuperclasses)
+ {
+ super(layout, symbol, directSuperclasses);
+ setDirectSubclasses(NIL);
+ setClassLayout(layout);
+ setCPL(NIL);
+ setDirectMethods(NIL);
+ setDocumentation(NIL);
+ setDirectSlotDefinitions(NIL);
+ setSlotDefinitions(NIL);
+ setDirectDefaultInitargs(NIL);
+ setDefaultInitargs(NIL);
+ setFinalized(false);
+
+ }
+
@Override
public LispObject getName()
{
@@ -426,8 +483,11 @@
list(STANDARD_OBJECT, BuiltInClass.FUNCTION));
public static final StandardClass GENERIC_FUNCTION =
- addStandardClass(Symbol.GENERIC_FUNCTION,
- list(METAOBJECT, FUNCALLABLE_STANDARD_OBJECT));
+ new FuncallableStandardClass(Symbol.GENERIC_FUNCTION,
+ list(METAOBJECT, FUNCALLABLE_STANDARD_OBJECT));
+ static {
+ addClass(Symbol.GENERIC_FUNCTION, GENERIC_FUNCTION);
+ }
public static final StandardClass METHOD_COMBINATION =
addStandardClass(Symbol.METHOD_COMBINATION, list(METAOBJECT));
Modified: trunk/abcl/src/org/armedbear/lisp/StandardGenericFunctionClass.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/StandardGenericFunctionClass.java Sat Feb 11 07:53:33 2012 (r13870)
+++ trunk/abcl/src/org/armedbear/lisp/StandardGenericFunctionClass.java Sat Feb 11 14:28:11 2012 (r13871)
@@ -35,7 +35,7 @@
import static org.armedbear.lisp.Lisp.*;
-public final class StandardGenericFunctionClass extends StandardClass
+public final class StandardGenericFunctionClass extends FuncallableStandardClass
{
public static final int SLOT_INDEX_NAME = 0;
public static final int SLOT_INDEX_LAMBDA_LIST = 1;
More information about the armedbear-cvs
mailing list