[armedbear-cvs] r13947 - trunk/abcl/src/org/armedbear/lisp
rschlatte at common-lisp.net
rschlatte at common-lisp.net
Thu May 24 17:50:30 UTC 2012
Author: rschlatte
Date: Thu May 24 10:50:29 2012
New Revision: 13947
Log:
change slot names to avoid symbols from CL
- The mop-feature-tests suite tells us that using symbols from the CL
package is not allowed. This means slots named DOCUMENTATION, TYPE,
FUNCTION, GENERIC-FUNCTION, METHOD-COMBINATION, SLOT-DEFINITION need
to be renamed.
- Decreases missing standard features (as reported by mop-feature-tests)
from 52 to 41.
Modified:
trunk/abcl/src/org/armedbear/lisp/Primitives.java
trunk/abcl/src/org/armedbear/lisp/SlotDefinition.java
trunk/abcl/src/org/armedbear/lisp/SlotDefinitionClass.java
trunk/abcl/src/org/armedbear/lisp/StandardClass.java
trunk/abcl/src/org/armedbear/lisp/StandardGenericFunction.java
trunk/abcl/src/org/armedbear/lisp/StandardGenericFunctionClass.java
trunk/abcl/src/org/armedbear/lisp/Symbol.java
trunk/abcl/src/org/armedbear/lisp/clos.lisp
Modified: trunk/abcl/src/org/armedbear/lisp/Primitives.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Primitives.java Thu May 24 04:26:06 2012 (r13946)
+++ trunk/abcl/src/org/armedbear/lisp/Primitives.java Thu May 24 10:50:29 2012 (r13947)
@@ -5561,7 +5561,7 @@
if (arg instanceof LispClass)
return ((LispClass)arg).getDocumentation();
else
- return ((StandardObject)arg).getInstanceSlotValue(Symbol.DOCUMENTATION);
+ return ((StandardObject)arg).getInstanceSlotValue(Symbol._DOCUMENTATION);
}
};
@@ -5579,7 +5579,7 @@
if (first instanceof LispClass)
((LispClass)first).setDocumentation(second);
else
- ((StandardObject)first).setInstanceSlotValue(Symbol.DOCUMENTATION, second);
+ ((StandardObject)first).setInstanceSlotValue(Symbol._DOCUMENTATION, second);
return second;
}
};
Modified: trunk/abcl/src/org/armedbear/lisp/SlotDefinition.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/SlotDefinition.java Thu May 24 04:26:06 2012 (r13946)
+++ trunk/abcl/src/org/armedbear/lisp/SlotDefinition.java Thu May 24 10:50:29 2012 (r13947)
@@ -104,6 +104,19 @@
slots[SlotDefinitionClass.SLOT_INDEX_ALLOCATION] = Keyword.INSTANCE;
}
+ public SlotDefinition(LispObject name, LispObject readers,
+ Function initFunction, LispObject initargs)
+ {
+ this();
+ Debug.assertTrue(name instanceof Symbol);
+ slots[SlotDefinitionClass.SLOT_INDEX_NAME] = name;
+ slots[SlotDefinitionClass.SLOT_INDEX_INITFUNCTION] = initFunction;
+ slots[SlotDefinitionClass.SLOT_INDEX_INITFORM] = NIL;
+ slots[SlotDefinitionClass.SLOT_INDEX_INITARGS] = initargs;
+ slots[SlotDefinitionClass.SLOT_INDEX_READERS] = readers;
+ slots[SlotDefinitionClass.SLOT_INDEX_ALLOCATION] = Keyword.INSTANCE;
+ }
+
public static StandardObject checkSlotDefinition(LispObject obj) {
if (obj instanceof StandardObject) return (StandardObject)obj;
return (StandardObject)type_error(obj, Symbol.SLOT_DEFINITION);
@@ -278,7 +291,7 @@
}
};
- private static final Primitive SET_SLOT_DEFINITION_INITARGS
+ static final Primitive SET_SLOT_DEFINITION_INITARGS
= new pf_set_slot_definition_initargs();
@DocString(name="set-slot-definition-initargs",
args="slot-definition initargs")
Modified: trunk/abcl/src/org/armedbear/lisp/SlotDefinitionClass.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/SlotDefinitionClass.java Thu May 24 04:26:06 2012 (r13946)
+++ trunk/abcl/src/org/armedbear/lisp/SlotDefinitionClass.java Thu May 24 10:50:29 2012 (r13947)
@@ -66,8 +66,8 @@
pkg.intern("ALLOCATION"),
pkg.intern("ALLOCATION-CLASS"),
pkg.intern("LOCATION"),
- Symbol.TYPE,
- Symbol.DOCUMENTATION
+ Symbol._TYPE,
+ Symbol._DOCUMENTATION
};
setClassLayout(new Layout(this, instanceSlotNames, NIL));
//Set up slot definitions so that this class can be extended by users
@@ -78,11 +78,16 @@
// The Java class SlotDefinition sets the location slot to NIL
// in its constructor; here we make Lisp-side subclasses of
// standard-*-slot-definition do the same.
- LispObject locationSlot = slotDefinitions.nthcdr(8).car();
+ LispObject locationSlot = slotDefinitions.nthcdr(SLOT_INDEX_LOCATION).car();
SlotDefinition.SET_SLOT_DEFINITION_INITFORM.execute(locationSlot, NIL);
SlotDefinition.SET_SLOT_DEFINITION_INITFUNCTION.execute(locationSlot, StandardClass.constantlyNil);
setDirectSlotDefinitions(slotDefinitions);
setSlotDefinitions(slotDefinitions);
+ // Fix initargs of TYPE, DOCUMENTATION slots.
+ LispObject typeSlot = slotDefinitions.nthcdr(SLOT_INDEX_TYPE).car();
+ SlotDefinition.SET_SLOT_DEFINITION_INITARGS.execute(typeSlot, list(internKeyword("TYPE")));
+ LispObject documentationSlot = slotDefinitions.nthcdr(SLOT_INDEX_DOCUMENTATION).car();
+ SlotDefinition.SET_SLOT_DEFINITION_INITARGS.execute(documentationSlot, list(internKeyword("DOCUMENTATION")));
setFinalized(true);
}
Modified: trunk/abcl/src/org/armedbear/lisp/StandardClass.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/StandardClass.java Thu May 24 04:26:06 2012 (r13946)
+++ trunk/abcl/src/org/armedbear/lisp/StandardClass.java Thu May 24 10:50:29 2012 (r13947)
@@ -83,7 +83,7 @@
symDirectDefaultInitargs,
symDefaultInitargs,
symFinalizedP,
- Symbol.DOCUMENTATION),
+ Symbol._DOCUMENTATION),
NIL)
{
@Override
@@ -106,7 +106,7 @@
symDirectDefaultInitargs,
symDefaultInitargs,
symFinalizedP,
- Symbol.DOCUMENTATION),
+ Symbol._DOCUMENTATION),
NIL)
{
@Override
@@ -292,13 +292,13 @@
@Override
public LispObject getDocumentation()
{
- return getInstanceSlotValue(Symbol.DOCUMENTATION);
+ return getInstanceSlotValue(Symbol._DOCUMENTATION);
}
@Override
public void setDocumentation(LispObject doc)
{
- setInstanceSlotValue(Symbol.DOCUMENTATION, doc);
+ setInstanceSlotValue(Symbol._DOCUMENTATION, doc);
}
@Override
@@ -412,7 +412,9 @@
helperMakeSlotDefinition("DIRECT-DEFAULT-INITARGS", constantlyNil),
helperMakeSlotDefinition("DEFAULT-INITARGS", constantlyNil),
helperMakeSlotDefinition("FINALIZED-P", constantlyNil),
- helperMakeSlotDefinition("DOCUMENTATION", constantlyNil));
+ new SlotDefinition(Symbol._DOCUMENTATION,
+ list(PACKAGE_MOP.intern("CLASS-DOCUMENTATION")),
+ constantlyNil, list(internKeyword("DOCUMENTATION"))));
}
@@ -739,20 +741,24 @@
STANDARD_METHOD.setCPL(STANDARD_METHOD, METHOD, METAOBJECT, STANDARD_OBJECT,
BuiltInClass.CLASS_T);
STANDARD_METHOD.setDirectSlotDefinitions(
- list(new SlotDefinition(Symbol.GENERIC_FUNCTION, NIL, constantlyNil),
+ list(new SlotDefinition(Symbol._GENERIC_FUNCTION, NIL, constantlyNil,
+ list(internKeyword("GENERIC-FUNCTION"))),
new SlotDefinition(Symbol.LAMBDA_LIST, NIL, constantlyNil),
new SlotDefinition(Symbol.KEYWORDS, NIL, constantlyNil),
new SlotDefinition(Symbol.OTHER_KEYWORDS_P, NIL, constantlyNil),
new SlotDefinition(Symbol.SPECIALIZERS, NIL, constantlyNil),
new SlotDefinition(Symbol.QUALIFIERS, NIL, constantlyNil),
- new SlotDefinition(Symbol.FUNCTION, NIL, constantlyNil),
+ new SlotDefinition(Symbol._FUNCTION, NIL, constantlyNil,
+ list(internKeyword("FUNCTION"))),
new SlotDefinition(Symbol.FAST_FUNCTION, NIL, constantlyNil),
- new SlotDefinition(Symbol.DOCUMENTATION, NIL, constantlyNil)));
+ new SlotDefinition(Symbol._DOCUMENTATION, NIL, constantlyNil,
+ list(internKeyword("DOCUMENTATION")))));
STANDARD_ACCESSOR_METHOD.setCPL(STANDARD_ACCESSOR_METHOD, STANDARD_METHOD,
METHOD, METAOBJECT, STANDARD_OBJECT,
BuiltInClass.CLASS_T);
STANDARD_ACCESSOR_METHOD.setDirectSlotDefinitions(
- list(new SlotDefinition(Symbol.SLOT_DEFINITION, NIL)));
+ list(new SlotDefinition(Symbol._SLOT_DEFINITION, NIL, constantlyNil,
+ list(internKeyword("SLOT-DEFINITION")))));
STANDARD_READER_METHOD.setCPL(STANDARD_READER_METHOD,
STANDARD_ACCESSOR_METHOD, STANDARD_METHOD,
METHOD, METAOBJECT, STANDARD_OBJECT,
@@ -767,9 +773,9 @@
list(new SlotDefinition(Symbol.NAME,
list(Symbol.METHOD_COMBINATION_NAME),
constantlyNil),
- new SlotDefinition(Symbol.DOCUMENTATION,
+ new SlotDefinition(Symbol._DOCUMENTATION,
list(Symbol.METHOD_COMBINATION_DOCUMENTATION),
- constantlyNil)));
+ constantlyNil, list(internKeyword("DOCUMENTATION")))));
SHORT_METHOD_COMBINATION.setCPL(SHORT_METHOD_COMBINATION,
METHOD_COMBINATION, METAOBJECT,
STANDARD_OBJECT, BuiltInClass.CLASS_T);
Modified: trunk/abcl/src/org/armedbear/lisp/StandardGenericFunction.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/StandardGenericFunction.java Thu May 24 04:26:06 2012 (r13946)
+++ trunk/abcl/src/org/armedbear/lisp/StandardGenericFunction.java Thu May 24 10:50:29 2012 (r13947)
@@ -93,7 +93,7 @@
NIL;
StandardObject method
= (StandardObject)StandardClass.STANDARD_METHOD.allocateInstance();
- method.setInstanceSlotValue(Symbol.GENERIC_FUNCTION, this);
+ method.setInstanceSlotValue(Symbol._GENERIC_FUNCTION, this);
method.setInstanceSlotValue(Symbol.LAMBDA_LIST, lambdaList);
method.setInstanceSlotValue(Symbol.KEYWORDS, NIL);
method.setInstanceSlotValue(Symbol.OTHER_KEYWORDS_P, NIL);
@@ -103,9 +103,9 @@
// constructor for StandardMethod instances did (that Java class was
// removed for the implementation of subclassable standard-method).
// (rudi 2012-01-27)
- method.setInstanceSlotValue(Symbol.FUNCTION, NIL);
+ method.setInstanceSlotValue(Symbol._FUNCTION, NIL);
method.setInstanceSlotValue(Symbol.FAST_FUNCTION, function);
- method.setInstanceSlotValue(Symbol.DOCUMENTATION, NIL);
+ method.setInstanceSlotValue(Symbol._DOCUMENTATION, NIL);
slots[StandardGenericFunctionClass.SLOT_INDEX_METHODS] =
list(method);
slots[StandardGenericFunctionClass.SLOT_INDEX_METHOD_CLASS] =
Modified: trunk/abcl/src/org/armedbear/lisp/StandardGenericFunctionClass.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/StandardGenericFunctionClass.java Thu May 24 04:26:06 2012 (r13946)
+++ trunk/abcl/src/org/armedbear/lisp/StandardGenericFunctionClass.java Thu May 24 10:50:29 2012 (r13947)
@@ -63,10 +63,10 @@
pkg.intern("INITIAL-METHODS"),
pkg.intern("METHODS"),
pkg.intern("METHOD-CLASS"),
- pkg.intern("METHOD-COMBINATION"),
+ pkg.intern("%METHOD-COMBINATION"),
pkg.intern("ARGUMENT-PRECEDENCE-ORDER"),
pkg.intern("CLASSES-TO-EMF-TABLE"),
- Symbol.DOCUMENTATION
+ Symbol._DOCUMENTATION
};
setClassLayout(new Layout(this, instanceSlotNames, NIL));
setFinalized(true);
Modified: trunk/abcl/src/org/armedbear/lisp/Symbol.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Symbol.java Thu May 24 04:26:06 2012 (r13946)
+++ trunk/abcl/src/org/armedbear/lisp/Symbol.java Thu May 24 10:50:29 2012 (r13947)
@@ -3162,8 +3162,12 @@
public static final Symbol FORMAT_CONTROL =
PACKAGE_SYS.addInternalSymbol("FORMAT-CONTROL");
public static final Symbol FSET = PACKAGE_SYS.addInternalSymbol("FSET");
+ public static final Symbol _FUNCTION =
+ PACKAGE_SYS.addInternalSymbol("%FUNCTION");
public static final Symbol FUNCTION_PRELOAD =
PACKAGE_SYS.addInternalSymbol("FUNCTION-PRELOAD");
+ public static final Symbol _GENERIC_FUNCTION =
+ PACKAGE_SYS.addInternalSymbol("%GENERIC-FUNCTION");
public static final Symbol INSTANCE =
PACKAGE_SYS.addInternalSymbol("INSTANCE");
public static final Symbol KEYWORDS =
@@ -3184,6 +3188,8 @@
PACKAGE_SYS.addInternalSymbol("PROXY-PRELOADED-FUNCTION");
public static final Symbol QUALIFIERS =
PACKAGE_SYS.addInternalSymbol("QUALIFIERS");
+ public static final Symbol _SLOT_DEFINITION =
+ PACKAGE_SYS.addInternalSymbol("%SLOT-DEFINITION");
public static final Symbol _SOURCE =
PACKAGE_SYS.addInternalSymbol("%SOURCE");
public static final Symbol SOCKET_STREAM =
@@ -3198,6 +3204,8 @@
PACKAGE_SYS.addInternalSymbol("SYSTEM-STREAM");
public static final Symbol STACK_FRAME =
PACKAGE_SYS.addInternalSymbol("STACK-FRAME");
+ public static final Symbol _TYPE =
+ PACKAGE_SYS.addInternalSymbol("%TYPE");
public static final Symbol LISP_STACK_FRAME =
PACKAGE_SYS.addInternalSymbol("LISP-STACK-FRAME");
public static final Symbol JAVA_STACK_FRAME =
Modified: trunk/abcl/src/org/armedbear/lisp/clos.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/clos.lisp Thu May 24 04:26:06 2012 (r13946)
+++ trunk/abcl/src/org/armedbear/lisp/clos.lisp Thu May 24 10:50:29 2012 (r13947)
@@ -211,7 +211,6 @@
funcallable-standard-class))))
(fixup-standard-class-hierarchy)
-
(defun no-applicable-method (generic-function &rest args)
(error "There is no applicable method for the generic function ~S when called with arguments ~S."
generic-function
@@ -869,7 +868,7 @@
arguments declarations forms)
(let ((instance (std-allocate-instance (find-class 'long-method-combination))))
(setf (std-slot-value instance 'sys::name) name)
- (setf (std-slot-value instance 'documentation) documentation)
+ (setf (std-slot-value instance 'sys:%documentation) documentation)
(setf (std-slot-value instance 'sys::lambda-list) lambda-list)
(setf (std-slot-value instance 'method-group-specs) method-group-specs)
(setf (std-slot-value instance 'args-lambda-list) args-lambda-list)
@@ -887,7 +886,7 @@
(defun method-combination-documentation (method-combination)
(check-type method-combination method-combination)
- (std-slot-value method-combination 'documentation))
+ (std-slot-value method-combination 'sys:%documentation))
(defun short-method-combination-operator (method-combination)
(check-type method-combination short-method-combination)
@@ -943,7 +942,7 @@
(let ((instance (std-allocate-instance
(find-class 'short-method-combination))))
(setf (std-slot-value instance 'sys::name) ',name)
- (setf (std-slot-value instance 'documentation) ',documentation)
+ (setf (std-slot-value instance 'sys:%documentation) ',documentation)
(setf (std-slot-value instance 'operator) ',operator)
(setf (std-slot-value instance 'identity-with-one-argument)
',identity-with-one-arg)
@@ -1277,10 +1276,10 @@
;;; AMOP pg. 218ff, will be redefined when generic functions are set up.
(defun std-method-function (method)
- (std-slot-value method 'cl:function))
+ (std-slot-value method 'sys::%function))
(defun std-method-generic-function (method)
- (std-slot-value method 'cl:generic-function))
+ (std-slot-value method 'sys::%generic-function))
(defun std-method-specializers (method)
(std-slot-value method 'sys::specializers))
@@ -1289,7 +1288,7 @@
(std-slot-value method 'sys::qualifiers))
(defun std-accessor-method-slot-definition (accessor-method)
- (std-slot-value accessor-method 'sys:slot-definition))
+ (std-slot-value accessor-method 'sys::%slot-definition))
;;; Additional method readers
(defun std-method-fast-function (method)
@@ -1372,10 +1371,10 @@
(setf (std-slot-value method 'sys::qualifiers) new-value))
(defun method-documentation (method)
- (std-slot-value method 'documentation))
+ (std-slot-value method 'sys:%documentation))
(defun (setf method-documentation) (new-value method)
- (setf (std-slot-value method 'documentation) new-value))
+ (setf (std-slot-value method 'sys:%documentation) new-value))
;;; defgeneric
@@ -1869,8 +1868,8 @@
(setf (std-slot-value method 'sys::specializers)
(canonicalize-specializers specializers))
(setf (method-documentation method) documentation)
- (setf (std-slot-value method 'generic-function) nil) ; set by add-method
- (setf (std-slot-value method 'function) function)
+ (setf (std-slot-value method 'sys::%generic-function) nil) ; set by add-method
+ (setf (std-slot-value method 'sys::%function) function)
(setf (std-slot-value method 'sys::fast-function) fast-function)
(setf (std-slot-value method 'sys::keywords) (getf analyzed-args :keywords))
(setf (std-slot-value method 'sys::other-keywords-p)
@@ -1903,7 +1902,7 @@
(method-specializers method) nil)))
(when old-method
(std-remove-method gf old-method)))
- (setf (std-slot-value method 'generic-function) gf)
+ (setf (std-slot-value method 'sys::%generic-function) gf)
(push method (generic-function-methods gf))
(dolist (specializer (method-specializers method))
(add-direct-method specializer method))
@@ -1913,7 +1912,7 @@
(defun std-remove-method (gf method)
(setf (generic-function-methods gf)
(remove method (generic-function-methods gf)))
- (setf (std-slot-value method 'generic-function) nil)
+ (setf (std-slot-value method 'sys::%generic-function) nil)
(dolist (specializer (method-specializers method))
(remove-direct-method specializer method))
(finalize-standard-generic-function gf)
@@ -2566,10 +2565,10 @@
(setf (std-slot-value method 'sys::specializers)
(canonicalize-specializers specializers))
(setf (method-documentation method) documentation)
- (setf (std-slot-value method 'generic-function) nil)
- (setf (std-slot-value method 'function) function)
+ (setf (std-slot-value method 'sys::%generic-function) nil)
+ (setf (std-slot-value method 'sys::%function) function)
(setf (std-slot-value method 'sys::fast-function) fast-function)
- (setf (std-slot-value method 'sys:slot-definition) slot-definition)
+ (setf (std-slot-value method 'sys::%slot-definition) slot-definition)
(setf (std-slot-value method 'sys::keywords) nil)
(setf (std-slot-value method 'sys::other-keywords-p) nil)
method))
@@ -3679,25 +3678,25 @@
(:method ((slot-definition slot-definition))
(slot-definition-dispatch slot-definition
(%slot-definition-type slot-definition)
- (slot-value slot-definition 'cl:type))))
+ (slot-value slot-definition 'sys::%type))))
(atomic-defgeneric (setf slot-definition-type) (value slot-definition)
(:method (value (slot-definition slot-definition))
(slot-definition-dispatch slot-definition
(set-slot-definition-type slot-definition value)
- (setf (slot-value slot-definition 'cl:type) value))))
+ (setf (slot-value slot-definition 'sys::%type) value))))
(atomic-defgeneric slot-definition-documentation (slot-definition)
(:method ((slot-definition slot-definition))
(slot-definition-dispatch slot-definition
(%slot-definition-documentation slot-definition)
- (slot-value slot-definition 'cl:documentation))))
+ (slot-value slot-definition 'sys:%documentation))))
(atomic-defgeneric (setf slot-definition-documentation) (value slot-definition)
(:method (value (slot-definition slot-definition))
(slot-definition-dispatch slot-definition
(set-slot-definition-documentation slot-definition value)
- (setf (slot-value slot-definition 'cl:documentation) value))))
+ (setf (slot-value slot-definition 'sys:%documentation) value))))
;;; Conditions.
More information about the armedbear-cvs
mailing list