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

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Fri Mar 29 14:19:19 2013
New Revision: 14452

Log:
Fix cl-cont, which causes %SET-LAMBDA-NAME to be called on a
  FUNCALLABLE-INSTANCE, which until now didn't support that.

This commit moves the use of the NAME slot from STANDARD-GENERIC-FUNCTION
to FUNCALLABLE-INSTANCE.

Modified:
   trunk/abcl/src/org/armedbear/lisp/FuncallableStandardClass.java
   trunk/abcl/src/org/armedbear/lisp/FuncallableStandardObject.java
   trunk/abcl/src/org/armedbear/lisp/Primitives.java
   trunk/abcl/src/org/armedbear/lisp/StandardGenericFunction.java

Modified: trunk/abcl/src/org/armedbear/lisp/FuncallableStandardClass.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/FuncallableStandardClass.java	Wed Mar 27 07:35:18 2013	(r14451)
+++ trunk/abcl/src/org/armedbear/lisp/FuncallableStandardClass.java	Fri Mar 29 14:19:19 2013	(r14452)
@@ -37,6 +37,7 @@
 
 public class FuncallableStandardClass extends StandardClass
 {
+  public static final int SLOT_INDEX_NAME                      = 0;
 
   public FuncallableStandardClass()
   {

Modified: trunk/abcl/src/org/armedbear/lisp/FuncallableStandardObject.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/FuncallableStandardObject.java	Wed Mar 27 07:35:18 2013	(r14451)
+++ trunk/abcl/src/org/armedbear/lisp/FuncallableStandardObject.java	Fri Mar 29 14:19:19 2013	(r14452)
@@ -42,6 +42,9 @@
 {
   protected LispObject function;
 
+  public static int SLOT_INDEX_NAME = 1;
+
+
   protected FuncallableStandardObject()
   {
     super();
@@ -86,6 +89,17 @@
     return super.typep(type);
   }
 
+  public LispObject getName()
+  {
+    return slots[FuncallableStandardClass.SLOT_INDEX_NAME];
+  }
+
+  public void setName(LispObject name)
+  {
+    slots[FuncallableStandardClass.SLOT_INDEX_NAME] = name;
+  }
+
+
   @Override
   public LispObject execute()
   {

Modified: trunk/abcl/src/org/armedbear/lisp/Primitives.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Primitives.java	Wed Mar 27 07:35:18 2013	(r14451)
+++ trunk/abcl/src/org/armedbear/lisp/Primitives.java	Fri Mar 29 14:19:19 2013	(r14452)
@@ -2658,10 +2658,10 @@
                 value1 = NIL;
                 value2 = T;
                 value3 = ((Function)arg).getLambdaName();
-            } else if (arg instanceof StandardGenericFunction) {
+            } else if (arg instanceof FuncallableStandardObject) {
                 value1 = NIL;
                 value2 = T;
-                value3 = ((StandardGenericFunction)arg).getGenericFunctionName();
+                value3 = ((FuncallableStandardObject)arg).getName();
             } else
                 return type_error(arg, Symbol.FUNCTION);
             return LispThread.currentThread().setValues(value1, value2, value3);
@@ -4218,8 +4218,8 @@
             if (arg instanceof Operator) {
                 return ((Operator)arg).getLambdaName();
             }
-            if (arg instanceof StandardGenericFunction) {
-                return ((StandardGenericFunction)arg).getGenericFunctionName();
+            if (arg instanceof FuncallableStandardObject) {
+                return ((FuncallableStandardObject)arg).getName();
             }
             return type_error(arg, Symbol.FUNCTION);
         }
@@ -4240,8 +4240,8 @@
                 ((Operator)first).setLambdaName(second);
                 return second;
             }
-            if (first instanceof StandardGenericFunction) {
-                ((StandardGenericFunction)first).setGenericFunctionName(second);
+            if (first instanceof FuncallableStandardObject) {
+                ((FuncallableStandardObject)first).setName(second);
                 return second;
             }
             return type_error(first, Symbol.FUNCTION);

Modified: trunk/abcl/src/org/armedbear/lisp/StandardGenericFunction.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/StandardGenericFunction.java	Wed Mar 27 07:35:18 2013	(r14451)
+++ trunk/abcl/src/org/armedbear/lisp/StandardGenericFunction.java	Fri Mar 29 14:19:19 2013	(r14452)
@@ -91,20 +91,10 @@
     return super.typep(type);
   }
 
-  public LispObject getGenericFunctionName()
-  {
-    return slots[StandardGenericFunctionClass.SLOT_INDEX_NAME];
-  }
-
-  public void setGenericFunctionName(LispObject name)
-  {
-    slots[StandardGenericFunctionClass.SLOT_INDEX_NAME] = name;
-  }
-
   @Override
   public String printObject()
   {
-    LispObject name = getGenericFunctionName();
+    LispObject name = getName();
     if (name != null)
       {
         StringBuilder sb = new StringBuilder();