[armedbear-cvs] r11465 - trunk/abcl/src/org/armedbear/lisp
Erik Huelsmann
ehuelsmann at common-lisp.net
Sun Dec 21 22:16:30 UTC 2008
Author: ehuelsmann
Date: Sun Dec 21 22:16:29 2008
New Revision: 11465
Log:
Make clear difference between calling the template evaluator or evaluating the object. (Relates to ClosureTemplateFunction.)
Modified:
trunk/abcl/src/org/armedbear/lisp/ClosureTemplateFunction.java
trunk/abcl/src/org/armedbear/lisp/CompiledClosure.java
trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
Modified: trunk/abcl/src/org/armedbear/lisp/ClosureTemplateFunction.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/ClosureTemplateFunction.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/ClosureTemplateFunction.java Sun Dec 21 22:16:29 2008
@@ -33,42 +33,62 @@
package org.armedbear.lisp;
-public abstract class ClosureTemplateFunction extends Closure
+public class ClosureTemplateFunction extends Closure
+ implements Cloneable
{
+
+ public LispObject[] ctx;
+
public ClosureTemplateFunction(LispObject lambdaList)
throws ConditionThrowable
{
super(list2(Symbol.LAMBDA, lambdaList), null);
}
+ public ClosureTemplateFunction setContext(LispObject[] context)
+ {
+ ctx = context;
+ return this;
+ }
+
+ public ClosureTemplateFunction dup()
+ throws CloneNotSupportedException
+ {
+ return (ClosureTemplateFunction)super.clone();
+ }
+
+
+
+ // execute methods have the semantic meaning
+ // "evaluate this object"
public final LispObject execute() throws ConditionThrowable
{
- return notImplemented();
+ return _execute(ctx);
}
public final LispObject execute(LispObject arg) throws ConditionThrowable
{
- return notImplemented();
+ return _execute(ctx);
}
public final LispObject execute(LispObject first, LispObject second)
throws ConditionThrowable
{
- return notImplemented();
+ return _execute(ctx, first, second);
}
public final LispObject execute(LispObject first, LispObject second,
LispObject third)
throws ConditionThrowable
{
- return notImplemented();
+ return _execute(ctx, first, second, third);
}
public final LispObject execute(LispObject first, LispObject second,
LispObject third, LispObject fourth)
throws ConditionThrowable
{
- return notImplemented();
+ return _execute(ctx, first, second, third, fourth);
}
public final LispObject execute(LispObject first, LispObject second,
@@ -76,7 +96,7 @@
LispObject fifth)
throws ConditionThrowable
{
- return notImplemented();
+ return _execute(ctx, first, second, third, fourth, fifth);
}
public final LispObject execute(LispObject first, LispObject second,
@@ -84,7 +104,7 @@
LispObject fifth, LispObject sixth)
throws ConditionThrowable
{
- return notImplemented();
+ return _execute(ctx, first, second, third, fourth, fifth, sixth);
}
public final LispObject execute(LispObject first, LispObject second,
@@ -93,7 +113,7 @@
LispObject seventh)
throws ConditionThrowable
{
- return notImplemented();
+ return _execute(ctx, first, second, third, fourth, fifth, sixth, seventh);
}
public final LispObject execute(LispObject first, LispObject second,
@@ -102,7 +122,14 @@
LispObject seventh, LispObject eighth)
throws ConditionThrowable
{
- return notImplemented();
+ return _execute(ctx, first, second, third, fourth, fifth,
+ sixth, seventh, eighth);
+ }
+
+ public final LispObject execute(LispObject[] args)
+ throws ConditionThrowable
+ {
+ return _execute(ctx, args);
}
private final LispObject notImplemented() throws ConditionThrowable
@@ -110,35 +137,39 @@
return error(new WrongNumberOfArgumentsException(this));
}
+
+ // _execute methods have the semantic meaning
+ // "evaluate this template with these values"
+
// Zero args.
- public LispObject execute(LispObject[] context) throws ConditionThrowable
+ public LispObject _execute(LispObject[] context) throws ConditionThrowable
{
LispObject[] args = new LispObject[0];
- return execute(context, args);
+ return _execute(context, args);
}
// One arg.
- public LispObject execute(LispObject[] context, LispObject first)
+ public LispObject _execute(LispObject[] context, LispObject first)
throws ConditionThrowable
{
LispObject[] args = new LispObject[1];
args[0] = first;
- return execute(context, args);
+ return _execute(context, args);
}
// Two args.
- public LispObject execute(LispObject[] context, LispObject first,
+ public LispObject _execute(LispObject[] context, LispObject first,
LispObject second)
throws ConditionThrowable
{
LispObject[] args = new LispObject[2];
args[0] = first;
args[1] = second;
- return execute(context, args);
+ return _execute(context, args);
}
// Three args.
- public LispObject execute(LispObject[] context, LispObject first,
+ public LispObject _execute(LispObject[] context, LispObject first,
LispObject second, LispObject third)
throws ConditionThrowable
{
@@ -146,11 +177,11 @@
args[0] = first;
args[1] = second;
args[2] = third;
- return execute(context, args);
+ return _execute(context, args);
}
// Four args.
- public LispObject execute(LispObject[] context, LispObject first,
+ public LispObject _execute(LispObject[] context, LispObject first,
LispObject second, LispObject third,
LispObject fourth)
throws ConditionThrowable
@@ -160,11 +191,11 @@
args[1] = second;
args[2] = third;
args[3] = fourth;
- return execute(context, args);
+ return _execute(context, args);
}
// Five args.
- public LispObject execute(LispObject[] context, LispObject first,
+ public LispObject _execute(LispObject[] context, LispObject first,
LispObject second, LispObject third,
LispObject fourth, LispObject fifth)
throws ConditionThrowable
@@ -175,11 +206,11 @@
args[2] = third;
args[3] = fourth;
args[4] = fifth;
- return execute(context, args);
+ return _execute(context, args);
}
// Six args.
- public LispObject execute(LispObject[] context, LispObject first,
+ public LispObject _execute(LispObject[] context, LispObject first,
LispObject second, LispObject third,
LispObject fourth, LispObject fifth,
LispObject sixth)
@@ -192,11 +223,11 @@
args[3] = fourth;
args[4] = fifth;
args[5] = sixth;
- return execute(context, args);
+ return _execute(context, args);
}
// Seven args.
- public LispObject execute(LispObject[] context, LispObject first,
+ public LispObject _execute(LispObject[] context, LispObject first,
LispObject second, LispObject third,
LispObject fourth, LispObject fifth,
LispObject sixth, LispObject seventh)
@@ -210,11 +241,11 @@
args[4] = fifth;
args[5] = sixth;
args[6] = seventh;
- return execute(context, args);
+ return _execute(context, args);
}
// Eight args.
- public LispObject execute(LispObject[] context, LispObject first,
+ public LispObject _execute(LispObject[] context, LispObject first,
LispObject second, LispObject third,
LispObject fourth, LispObject fifth,
LispObject sixth, LispObject seventh,
@@ -230,11 +261,11 @@
args[5] = sixth;
args[6] = seventh;
args[7] = eighth;
- return execute(context, args);
+ return _execute(context, args);
}
// Arg array.
- public LispObject execute(LispObject[] context, LispObject[] args)
+ public LispObject _execute(LispObject[] context, LispObject[] args)
throws ConditionThrowable
{
return notImplemented();
Modified: trunk/abcl/src/org/armedbear/lisp/CompiledClosure.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/CompiledClosure.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/CompiledClosure.java Sun Dec 21 22:16:29 2008
@@ -53,32 +53,32 @@
public LispObject execute() throws ConditionThrowable
{
- return ctf.execute(context);
+ return ctf._execute(context);
}
public LispObject execute(LispObject arg) throws ConditionThrowable
{
- return ctf.execute(context, arg);
+ return ctf._execute(context, arg);
}
public LispObject execute(LispObject first, LispObject second)
throws ConditionThrowable
{
- return ctf.execute(context, first, second);
+ return ctf._execute(context, first, second);
}
public LispObject execute(LispObject first, LispObject second,
LispObject third)
throws ConditionThrowable
{
- return ctf.execute(context, first, second, third);
+ return ctf._execute(context, first, second, third);
}
public LispObject execute(LispObject first, LispObject second,
LispObject third, LispObject fourth)
throws ConditionThrowable
{
- return ctf.execute(context, first, second, third, fourth);
+ return ctf._execute(context, first, second, third, fourth);
}
public LispObject execute(LispObject first, LispObject second,
@@ -86,7 +86,7 @@
LispObject fifth)
throws ConditionThrowable
{
- return ctf.execute(context, first, second, third, fourth, fifth);
+ return ctf._execute(context, first, second, third, fourth, fifth);
}
public LispObject execute(LispObject first, LispObject second,
@@ -94,7 +94,7 @@
LispObject fifth, LispObject sixth)
throws ConditionThrowable
{
- return ctf.execute(context, first, second, third, fourth, fifth, sixth);
+ return ctf._execute(context, first, second, third, fourth, fifth, sixth);
}
public LispObject execute(LispObject first, LispObject second,
@@ -103,7 +103,7 @@
LispObject seventh)
throws ConditionThrowable
{
- return ctf.execute(context, first, second, third, fourth, fifth, sixth,
+ return ctf._execute(context, first, second, third, fourth, fifth, sixth,
seventh);
}
@@ -113,12 +113,12 @@
LispObject seventh, LispObject eighth)
throws ConditionThrowable
{
- return ctf.execute(context, first, second, third, fourth, fifth, sixth,
+ return ctf._execute(context, first, second, third, fourth, fifth, sixth,
seventh, eighth);
}
public LispObject execute(LispObject[] args) throws ConditionThrowable
{
- return ctf.execute(context, args);
+ return ctf._execute(context, args);
}
}
Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp Sun Dec 21 22:16:29 2008
@@ -8939,7 +8939,14 @@
super)
(*child-p*
(if *closure-variables*
- +lisp-ctf-class+
+ (progn
+ (setf execute-method-name
+ (setf (method-name execute-method) "_execute"))
+ (setf (method-name-index execute-method)
+ (pool-name (method-name execute-method)))
+ (setf (method-descriptor-index execute-method)
+ (pool-name (method-descriptor execute-method)))
+ +lisp-ctf-class+)
(if *hairy-arglist-p*
+lisp-compiled-function-class+
+lisp-primitive-class+)))
@@ -9251,4 +9258,4 @@
(initialize-p2-handlers)
-(provide "COMPILER-PASS2")
\ No newline at end of file
+(provide "COMPILER-PASS2")
More information about the armedbear-cvs
mailing list