Changeset 11393 for branches/scripting/j/src

Timestamp:

11/19/08 20:57:04 (14 years ago)

Author:

astalla

Message:

Implemented the Compilable interface and refactored the script evaluation code in the process.

Location:

branches/scripting/j/src/org/armedbear/lisp/scripting

Files:

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

branches/scripting/j/src/org/armedbear/lisp/scripting/AbclScriptEngine.java

@@ -31 +31 @@
 import javax.script.AbstractScriptEngine;
 import javax.script.Bindings;
+import javax.script.Compilable;
+import javax.script.CompiledScript;
 import javax.script.Invocable;
 import javax.script.ScriptContext;
+import javax.script.ScriptEngine;
 import javax.script.ScriptEngineFactory;
 import javax.script.ScriptException;
@@ -59 +62 @@
 
 
-public class AbclScriptEngine extends AbstractScriptEngine implements Invocable {
+public class AbclScriptEngine extends AbstractScriptEngine implements Invocable, Compilable {
 
   private Interpreter interpreter;
   private LispObject nonThrowingDebugHook;
   private Function evalScript;
+  private Function compileScript;
+  private Function evalCompiledScript;
 
   public AbclScriptEngine(Interpreter interpreter, boolean enableThrowingDebugger) {
+    
     this.interpreter = interpreter;
     Interpreter.initializeLisp();
@@ -81 +87 @@
       loadFromClasspath("/org/armedbear/lisp/scripting/lisp/abcl-script.lisp");
       evalScript = (Function) this.findSymbol("EVAL-SCRIPT", "ABCL-SCRIPT").getSymbolFunction();
+      compileScript = (Function) this.findSymbol("COMPILE-SCRIPT", "ABCL-SCRIPT").getSymbolFunction();
+      evalCompiledScript = (Function) this.findSymbol("EVAL-COMPILED-SCRIPT", "ABCL-SCRIPT").getSymbolFunction();
     } catch (ConditionThrowable e) {
-      e.printStackTrace();
+      throw new Error(e);
     }
   }
@@ -270 +278 @@
   }
 
-  @Override
-  public Object eval(String code, ScriptContext ctx) throws ScriptException {
+  private Object eval(Function evaluator, LispObject code, ScriptContext ctx) throws ScriptException {
     ReaderInputStream in = null;
     WriterOutputStream out = null;
@@ -280 +287 @@
       Stream outStream = new Stream(out, Symbol.CHARACTER);
       Stream inStream  = new Stream(in,  Symbol.CHARACTER);
-      retVal = evalScript.execute(makeBindings(ctx.getBindings(ScriptContext.GLOBAL_SCOPE)),
-                    makeBindings(ctx.getBindings(ScriptContext.ENGINE_SCOPE)),
-                    inStream, outStream,
-                    new SimpleString(code), new JavaObject(ctx));
+      retVal = evaluator.execute(makeBindings(ctx.getBindings(ScriptContext.GLOBAL_SCOPE)),
+                     makeBindings(ctx.getBindings(ScriptContext.ENGINE_SCOPE)),
+                     inStream, outStream,
+                     code, new JavaObject(ctx));
       return toJava(retVal);
     } catch (ConditionThrowable e) {
@@ -291 +298 @@
     }
   }
-
-  @Override
-  public Object eval(Reader code, ScriptContext ctx) throws ScriptException {
+  
+  @Override
+  public Object eval(String code, ScriptContext ctx) throws ScriptException {
+    return eval(evalScript, new SimpleString(code), ctx);
+  }
+
+  private static String toString(Reader reader) throws IOException {
     StringWriter w = new StringWriter();
     int i;
-    try {
-      i = code.read();
-      while (i != -1) {
-        w.write(i);
-        i = code.read();
-      }
-      return eval(w.toString(), ctx);
+    i = reader.read();
+    while (i != -1) {
+      w.write(i);
+      i = reader.read();
+    }
+    return w.toString();
+  }
+  
+  @Override
+  public Object eval(Reader code, ScriptContext ctx) throws ScriptException {
+    try {
+      return eval(toString(code), ctx);
     } catch (IOException e) {
       return new ScriptException(e);
@@ -351 +367 @@
           v.aset(i, new JavaObject(array[i]));
         } catch (ConditionThrowable e) {
-          throw new Error("Can't set simplevector index " + i, e);
+          throw new Error("Can't set SimpleVector index " + i, e);
         }
             }
@@ -432 +448 @@
   }
 
+  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;
+    }
+
+  }
+
+  
+  @Override
+  public CompiledScript compile(String script) throws ScriptException {
+    try {
+      Function f = (Function) compileScript.execute(new SimpleString(script));
+      return new AbclCompiledScript(f);
+    } catch (ConditionThrowable e) {
+      throw new ScriptException(new Exception(e));
+    } catch(ClassCastException e) {
+      throw new ScriptException(e);
+    }
+  }
+
+  @Override
+  public CompiledScript compile(Reader script) throws ScriptException {
+    try {
+      return compile(toString(script));
+    } catch (IOException e) {
+      throw new ScriptException(e);
+    }
+  }
+
 }

branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp

@@ -46 +46 @@
        ,java-bindings ,(car jbinding) ,(car binding))))
 
+(defmacro with-script-context ((global-bindings engine-bindings stdin stdout script-context)
+             body)
+  (let ((actual-global-bindings (gensym))
+  (actual-engine-bindings (gensym)))
+    `(let ((*package* (find-package :abcl-script-user))
+     (*standard-input* ,stdin)
+     (*standard-output* ,stdout)
+     (,actual-global-bindings (generate-bindings ,global-bindings))
+     (,actual-engine-bindings (generate-bindings ,engine-bindings)))
+      (eval `(let ((*standard-input* ,,stdin)
+       (*standard-output* ,,stdout)
+       (*package* (find-package :abcl-script-user)))
+        (let (,@,actual-global-bindings)
+    (let (,@,actual-engine-bindings)
+      (prog1
+          (progn ,@,body)
+        (finish-output *standard-output*)
+        ,@(generate-java-bindings
+           ,global-bindings 
+           ,actual-global-bindings
+           (jcall +get-bindings+ ,script-context +global-scope+))
+        ,@(generate-java-bindings
+           ,engine-bindings 
+           ,actual-engine-bindings
+           (jcall +get-bindings+ ,script-context +engine-scope+))))))))))
+  
 (defun eval-script (global-bindings engine-bindings stdin stdout
         code-string script-context)
-  (let ((*package* (find-package :abcl-script-user))
-  (*standard-input* stdin)
-  (*standard-output* stdout)
-  (actual-global-bindings (generate-bindings global-bindings))
-  (actual-engine-bindings (generate-bindings engine-bindings)))
-    (eval `(let ((*standard-input* ,stdin)
-     (*standard-output* ,stdout)
-     (*package* (find-package :abcl-script-user)))
-      (let (,@actual-global-bindings)
-        (let (,@actual-engine-bindings)
-    (prog1
-        (progn
-          ,@(read-from-string
-       (concatenate 'string "(" code-string ")")))
-      (finish-output *standard-output*)
-      ,@(generate-java-bindings
-         global-bindings 
-         actual-global-bindings
-         (jcall +get-bindings+ script-context +global-scope+))
-      ,@(generate-java-bindings
-         engine-bindings 
-         actual-engine-bindings
-         (jcall +get-bindings+ script-context +engine-scope+)))))))))
+  (with-script-context (global-bindings engine-bindings stdin stdout script-context)
+    (read-from-string
+     (concatenate 'string "(" code-string ")"))))
+
+(defun eval-compiled-script (global-bindings engine-bindings stdin stdout
+           function script-context)
+  (with-script-context (global-bindings engine-bindings stdin stdout script-context)
+    `((funcall ,function))))
+
+(defun compile-script (code-string)
+  (let ((*package* (find-package :abcl-script-user)))
+    (eval `(compile nil
+      (lambda ()
+        ,@(read-from-string (concatenate 'string "(" code-string ")")))))))

branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/packages.lisp

@@ -20 +20 @@
   (:use :cl :java)
   (:export #:eval-script
+     #:compile-script
+     #:eval-compiled-script
      #:define-java-interface-implementation
      #:find-java-interface-implementation