[armedbear-devel] [armedbear-cvs] r11465 - trunk/abcl/src/org/armedbear/lisp
Erik Huelsmann
ehuels at gmail.com
Sun Dec 21 23:02:47 UTC 2008
If you're using trunk, you'll need to delete your .abcl files after
updating and building this commit:
it changes the structure of the .cls files stored in the .abcl files.
Bye,
Erik.
On Sun, Dec 21, 2008 at 11:16 PM, Erik Huelsmann
<ehuelsmann at common-lisp.net> wrote:
> 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")
>
> _______________________________________________
> armedbear-cvs mailing list
> armedbear-cvs at common-lisp.net
> http://common-lisp.net/cgi-bin/mailman/listinfo/armedbear-cvs
>
More information about the armedbear-devel
mailing list