Changeset 11894

Timestamp:

05/18/09 19:37:43 (14 years ago)

Author:

astalla

Message:

Fixed function evaluation using invokeFunction. It was broken since last
commit on JSR-223. Now invokeFunction uses the same "eval-in-script-context"
macro that is used to evaluate interpreted and compiled code in the right
environment, including special variables from the ScriptContext?.
In passing, the invokeFunction() method has also been fixed so that
javaInstance() is called on its return value, like it happens in all other
kinds of Lisp calls from Java.

Location:

trunk/abcl/src/org/armedbear/lisp/scripting

Files:

• AbclScriptEngine.java (modified) (6 diffs)
• lisp/abcl-script.lisp (modified) (1 diff)
• lisp/packages.lisp (modified) (1 diff)

trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngine.java

@@ -40 +40 @@
 
     private Interpreter interpreter;
+    /**
+     * The function used to evaluate a string of code.
+     */
     private Function evalScript;
+    /**
+     * The function used to evaluate a Lisp function.
+     */
+    private Function evalFunction;
+    /**
+     * The function used to compile Lisp code.
+     */
     private Function compileScript;
+    /**
+     * The function used to evaluate a compiled script.
+     */
     private Function evalCompiledScript;
 
@@ -62 +75 @@
       compileScript = (Function) this.findSymbol("COMPILE-SCRIPT", "ABCL-SCRIPT").getSymbolFunction();
       evalCompiledScript = (Function) this.findSymbol("EVAL-COMPILED-SCRIPT", "ABCL-SCRIPT").getSymbolFunction();
+      evalFunction = (Function) this.findSymbol("EVAL-FUNCTION", "ABCL-SCRIPT").getSymbolFunction();
   } catch (ConditionThrowable e) {
       throw new RuntimeException(e);
@@ -219 +233 @@
   }
 
-  @Override
-  public ScriptContext getContext() {
-    return super.getContext();
-  }
-
     private Object eval(Function evaluator, LispObject code, ScriptContext ctx) throws ScriptException {
   ReaderInputStream in = null;
@@ -233 +242 @@
       Stream outStream = new Stream(out, Symbol.CHARACTER);
       Stream inStream  = new Stream(in,  Symbol.CHARACTER);
-
       retVal = evaluator.execute(makeBindings(ctx.getBindings(ScriptContext.GLOBAL_SCOPE)),
                makeBindings(ctx.getBindings(ScriptContext.ENGINE_SCOPE)),
                inStream, outStream,
                code, new JavaObject(ctx));
-      return toJava(retVal);
+      return retVal.javaInstance();
   } catch (ConditionThrowable e) {
       throw new ScriptException(new Exception(e));
@@ -274 +282 @@
   public ScriptEngineFactory getFactory() {
     return new AbclScriptEngineFactory();
-  }
-
-  private static Object toJava(LispObject lispObject) throws ConditionThrowable {
-    return lispObject.javaInstance();
   }
   
@@ -342 +346 @@
   } 
   
-  @Override
-  public Object invokeFunction(String name, Object... args) throws ScriptException, NoSuchMethodException {
-      try {
-    Symbol s;
-    if(name.indexOf(':') >= 0) {
-        s = findSymbol(name);
-    } else {
-        s = findSymbol(name, "ABCL-SCRIPT-USER");
-    }
-    if(s != null) {
-        LispObject f = s.getSymbolFunction();
-        if(f != null && f instanceof Function) {
-      LispObject[] wrappedArgs = new LispObject[args.length];
-      for(int i = 0; i < args.length; ++i) {
-          wrappedArgs[i] = toLisp(args[i]);
-      }
-      switch(args.length) {
-      case 0:
-          return LispThread.currentThread().execute(f);
-      case 1:
-          return LispThread.currentThread().execute(f, wrappedArgs[0]);
-      case 2:
-          return LispThread.currentThread().execute(f, wrappedArgs[0], wrappedArgs[1]);
-      case 3:
-          return LispThread.currentThread().execute(f, wrappedArgs[0], wrappedArgs[1], wrappedArgs[2]);             
-      case 4:
-          return LispThread.currentThread().execute(f, wrappedArgs[0], wrappedArgs[1], wrappedArgs[2], wrappedArgs[3]);
-      case 5:
-          return LispThread.currentThread().execute(f, wrappedArgs[0], wrappedArgs[1], wrappedArgs[2], wrappedArgs[3], wrappedArgs[4]);
-      case 6:
-          return LispThread.currentThread().execute(f, wrappedArgs[0], wrappedArgs[1], wrappedArgs[2], wrappedArgs[3], wrappedArgs[4], wrappedArgs[5]);
-      case 7:
-          return LispThread.currentThread().execute(f, wrappedArgs[0], wrappedArgs[1], wrappedArgs[2], wrappedArgs[3], wrappedArgs[4], wrappedArgs[5], wrappedArgs[6]);
-      case 8:
-          return LispThread.currentThread().execute(f, wrappedArgs[0], wrappedArgs[1], wrappedArgs[2], wrappedArgs[3], wrappedArgs[4], wrappedArgs[5], wrappedArgs[6], wrappedArgs[7]);
-      default:
-          return LispThread.currentThread().execute(f, wrappedArgs);
-      } 
-        } else {
-      throw new NoSuchMethodException(name);
+    @Override
+    public Object invokeFunction(String name, Object... args) throws ScriptException, NoSuchMethodException {
+  try {
+      Symbol s;
+      if(name.indexOf(':') >= 0) {
+    s = findSymbol(name);
+      } else {
+    s = findSymbol(name, "ABCL-SCRIPT-USER");
+      }
+      if(s != null) {
+    LispObject f = s.getSymbolFunction();
+    if(f != null && f instanceof Function) {
+        LispObject functionAndArgs = Lisp.NIL.push(f);
+        for(int i = 0; i < args.length; ++i) {
+      functionAndArgs = functionAndArgs.push(toLisp(args[i]));
         }
+        functionAndArgs = functionAndArgs.reverse();
+        return eval(evalFunction, functionAndArgs, getContext());
     } else {
         throw new NoSuchMethodException(name);
     }
-      } catch (ConditionThrowable e) {
-    throw new ScriptException(new RuntimeException(e));
+      } else {
+    throw new NoSuchMethodException(name);
       }
-  }
-
-  @Override
-  public Object invokeMethod(Object thiz, String name, Object... args) throws ScriptException, NoSuchMethodException {
-    throw new UnsupportedOperationException("Common Lisp does not have methods in the Java sense.");
-  }
-
-  public class AbclCompiledScript extends CompiledScript {
-
-    private LispObject function;
-    
-    public AbclCompiledScript(LispObject function) {
-      this.function = function;
-    }
-    
-    @Override
-    public Object eval(ScriptContext context) throws ScriptException {
-      return AbclScriptEngine.this.eval(evalCompiledScript, function, context);
-    }
-
-    @Override
-    public ScriptEngine getEngine() {
-      return AbclScriptEngine.this;
-    }
-
-  }
+  } catch (ConditionThrowable e) {
+      throw new ScriptException(new RuntimeException(e));
+  }
+    }
+
+    @Override
+    public Object invokeMethod(Object thiz, String name, Object... args) throws ScriptException, NoSuchMethodException {
+  throw new UnsupportedOperationException("Common Lisp does not have methods in the Java sense.");
+    }
+
+    public class AbclCompiledScript extends CompiledScript {
+
+  private LispObject function;
+  
+  public AbclCompiledScript(LispObject function) {
+      this.function = function;
+  }
+  
+  @Override
+  public Object eval(ScriptContext context) throws ScriptException {
+      return AbclScriptEngine.this.eval(evalCompiledScript, function, context);
+  }
+  
+  @Override
+  public ScriptEngine getEngine() {
+      return AbclScriptEngine.this;
+  }
+  
+    }
 
   

trunk/abcl/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp

@@ -93 +93 @@
            (jcall +get-bindings+ ,script-context +engine-scope+)))))))))
   
+(defun eval-function (global-bindings engine-bindings stdin stdout function-and-args script-context)
+  (eval-in-script-context (global-bindings engine-bindings stdin stdout script-context)
+    `((funcall ,@(mapcar (lambda (arg) `(quote ,arg))
+       function-and-args)))))
+
 (defun eval-script (global-bindings engine-bindings stdin stdout
         code-string script-context)

trunk/abcl/src/org/armedbear/lisp/scripting/lisp/packages.lisp

@@ -32 +32 @@
   (:use :cl :java)
   (:export 
-   #:eval-script
    #:compile-script
    #:*compile-using-temp-files*
    #:configure-abcl
    #:eval-compiled-script
+   #:eval-function
+   #:eval-script
    #:define-java-interface-implementation
    #:find-java-interface-implementation