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@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@common-lisp.net http://common-lisp.net/cgi-bin/mailman/listinfo/armedbear-cvs