Changeset 14468

Timestamp:

04/24/13 12:50:45 (11 years ago)

Author:

rschlatte

Message:

Fix set-lambda-name & friends

• in funcallable-standard-object, delegate to the real function, don't access potentially non-existing slots

Location:

trunk/abcl/src/org/armedbear/lisp

Files:

• FuncallableStandardClass.java (modified) (1 diff)
• FuncallableStandardObject.java (modified) (2 diffs)
• Primitives.java (modified) (3 diffs)
• StandardGenericFunction.java (modified) (1 diff)

trunk/abcl/src/org/armedbear/lisp/FuncallableStandardClass.java

@@ -38 +38 @@
 public class FuncallableStandardClass extends StandardClass
 {
-  public static final int SLOT_INDEX_NAME                      = 0;
-
   public FuncallableStandardClass()
   {

trunk/abcl/src/org/armedbear/lisp/FuncallableStandardObject.java

@@ -41 +41 @@
 public class FuncallableStandardObject extends StandardObject
 {
-  protected LispObject function;
+  LispObject function;
 
   protected FuncallableStandardObject()
@@ -86 +86 @@
     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

trunk/abcl/src/org/armedbear/lisp/Primitives.java

@@ -2658 +2658 @@
                 value2 = T;
                 value3 = ((Function)arg).getLambdaName();
-            } else if (arg instanceof FuncallableStandardObject) {
+            } else if (arg instanceof StandardGenericFunction) {
                 value1 = NIL;
                 value2 = T;
-                value3 = ((FuncallableStandardObject)arg).getName();
-            } else
-                return type_error(arg, Symbol.FUNCTION);
+                value3 = ((StandardGenericFunction)arg).getName();
+            } else if (arg instanceof FuncallableStandardObject) {
+              return this.execute(((FuncallableStandardObject)arg).function);
+            } else {
+              return type_error(arg, Symbol.FUNCTION);
+            }
             return LispThread.currentThread().setValues(value1, value2, value3);
         }
@@ -4218 +4221 @@
                 return ((Operator)arg).getLambdaName();
             }
+            if (arg instanceof StandardGenericFunction) {
+                return ((StandardGenericFunction)arg).getName();
+            }
             if (arg instanceof FuncallableStandardObject) {
-                return ((FuncallableStandardObject)arg).getName();
+              return this.execute(((FuncallableStandardObject)arg).function);
             }
             return type_error(arg, Symbol.FUNCTION);
@@ -4240 +4246 @@
                 return second;
             }
+            if (first instanceof StandardGenericFunction) {
+                ((StandardGenericFunction)first).setName(second);
+                return second;
+            }
             if (first instanceof FuncallableStandardObject) {
-                ((FuncallableStandardObject)first).setName(second);
-                return second;
+              return this.execute(((FuncallableStandardObject)first).function, second);
             }
             return type_error(first, Symbol.FUNCTION);

trunk/abcl/src/org/armedbear/lisp/StandardGenericFunction.java

@@ -75 +75 @@
   }
 
+  public LispObject getName()
+  {
+    return slots[StandardGenericFunctionClass.SLOT_INDEX_NAME];
+  }
+
+  public void setName(LispObject name)
+  {
+    slots[StandardGenericFunctionClass.SLOT_INDEX_NAME] = name;
+  }
+
+
   @Override
   public LispObject typep(LispObject type)