[armedbear-cvs] r14079 - trunk/abcl/src/org/armedbear/lisp

[rschlatte at common-lisp.net]

Author: rschlatte
Date: Mon Aug 13 06:22:17 2012
New Revision: 14079

Log:
Don't overwrite existing attributes in ensure-generic-function

- also add initargs :method-combination, :documentation for generic functions

Modified:
   trunk/abcl/src/org/armedbear/lisp/StandardClass.java
   trunk/abcl/src/org/armedbear/lisp/clos.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/StandardClass.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/StandardClass.java	Mon Aug 13 04:34:07 2012	(r14078)
+++ trunk/abcl/src/org/armedbear/lisp/StandardClass.java	Mon Aug 13 06:22:17 2012	(r14079)
@@ -865,7 +865,31 @@
                                      STANDARD_OBJECT,
                                      BuiltInClass.FUNCTION,
                                      BuiltInClass.CLASS_T);
-    STANDARD_GENERIC_FUNCTION.setDirectSlotDefinitions(STANDARD_GENERIC_FUNCTION.getClassLayout().generateSlotDefinitions());
+    STANDARD_GENERIC_FUNCTION.setDirectSlotDefinitions(
+      list(new SlotDefinition(PACKAGE_SYS.intern("NAME"), NIL, constantlyNil),
+           new SlotDefinition(PACKAGE_SYS.intern("LAMBDA-LIST"), NIL,
+                              constantlyNil),
+           new SlotDefinition(PACKAGE_SYS.intern("REQUIRED-ARGS"), NIL,
+                              constantlyNil),
+           new SlotDefinition(PACKAGE_SYS.intern("OPTIONAL-ARGS"), NIL,
+                              constantlyNil),
+           new SlotDefinition(PACKAGE_SYS.intern("INITIAL-METHODS"), NIL,
+                              constantlyNil),
+           new SlotDefinition(PACKAGE_SYS.intern("METHODS"), NIL,
+                              constantlyNil),
+           new SlotDefinition(PACKAGE_SYS.intern("METHOD-CLASS"), NIL,
+                              constantlyNil),
+           new SlotDefinition(PACKAGE_SYS.intern("%METHOD-COMBINATION"), NIL,
+                              constantlyNil,
+                              list(internKeyword("METHOD-COMBINATION"))),
+           new SlotDefinition(PACKAGE_SYS.intern("ARGUMENT-PRECEDENCE-ORDER"),
+                              NIL, constantlyNil),
+           new SlotDefinition(PACKAGE_SYS.intern("DECLARATIONS"), NIL,
+                              constantlyNil),
+           new SlotDefinition(PACKAGE_SYS.intern("CLASSES-TO-EMF-TABLE"), NIL,
+                              constantlyNil),
+           new SlotDefinition(Symbol._DOCUMENTATION, NIL, constantlyNil,
+                              list(internKeyword("DOCUMENTATION")))));
     // There are no inherited slots.
     STANDARD_GENERIC_FUNCTION.setSlotDefinitions(STANDARD_GENERIC_FUNCTION.getDirectSlotDefinitions());
   }

Modified: trunk/abcl/src/org/armedbear/lisp/clos.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/clos.lisp	Mon Aug 13 04:34:07 2012	(r14078)
+++ trunk/abcl/src/org/armedbear/lisp/clos.lisp	Mon Aug 13 06:22:17 2012	(r14079)
@@ -4493,10 +4493,10 @@
     ((generic-function generic-function)
      function-name
      &rest all-keys
-     &key (generic-function-class +the-standard-generic-function-class+)
+     &key (generic-function-class (class-of generic-function))
      (lambda-list nil lambda-list-supplied-p)
-     (method-class +the-standard-method-class+)
-     (method-combination +the-standard-method-combination+)
+     (method-class (generic-function-method-class generic-function))
+     (method-combination (generic-function-method-combination generic-function))
      &allow-other-keys)
   (setf all-keys (copy-list all-keys))  ; since we modify it
   (remf all-keys :generic-function-class)