[armedbear-cvs] r11360 - in branches/scripting/j/src: META-INF META-INF/services org/armedbear/lisp/scripting org/armedbear/lisp/scripting/lisp org/armedbear/lisp/scripting/lisp/test org/armedbear/lisp/scripting/util
Erik Huelsmann
ehuelsmann at common-lisp.net
Sun Oct 19 06:07:34 UTC 2008
Author: ehuelsmann
Date: Sun Oct 19 06:07:32 2008
New Revision: 11360
Log:
Initial import of ABCL scripting engine implementation.
Patch by: Alessio Stalla <alessiostalla at gmail dot com>
Added:
branches/scripting/j/src/META-INF/
branches/scripting/j/src/META-INF/services/
branches/scripting/j/src/META-INF/services/javax.script.ScriptEngineFactory (contents, props changed)
branches/scripting/j/src/org/armedbear/lisp/scripting/
branches/scripting/j/src/org/armedbear/lisp/scripting/AbclScriptEngine.java (contents, props changed)
branches/scripting/j/src/org/armedbear/lisp/scripting/AbclScriptEngineFactory.java (contents, props changed)
branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/
branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp (contents, props changed)
branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/packages.lisp (contents, props changed)
branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/test/
branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/test/AbclTest.java (contents, props changed)
branches/scripting/j/src/org/armedbear/lisp/scripting/util/
branches/scripting/j/src/org/armedbear/lisp/scripting/util/ReaderInputStream.java (contents, props changed)
branches/scripting/j/src/org/armedbear/lisp/scripting/util/WriterOutputStream.java (contents, props changed)
Added: branches/scripting/j/src/META-INF/services/javax.script.ScriptEngineFactory
==============================================================================
--- (empty file)
+++ branches/scripting/j/src/META-INF/services/javax.script.ScriptEngineFactory Sun Oct 19 06:07:32 2008
@@ -0,0 +1 @@
+org.armedbear.lisp.scripting.AbclScriptEngineFactory
\ No newline at end of file
Added: branches/scripting/j/src/org/armedbear/lisp/scripting/AbclScriptEngine.java
==============================================================================
--- (empty file)
+++ branches/scripting/j/src/org/armedbear/lisp/scripting/AbclScriptEngine.java Sun Oct 19 06:07:32 2008
@@ -0,0 +1,437 @@
+/*
+ * AbclScriptEngine.java
+ *
+ * Copyright (C) 2008 Alessio Stalla
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ */
+
+package org.armedbear.lisp.scripting;
+
+import java.io.File;
+import java.io.IOException;
+import java.io.InputStream;
+import java.io.Reader;
+import java.io.StringWriter;
+import java.math.BigInteger;
+import java.util.Map;
+
+import javax.script.AbstractScriptEngine;
+import javax.script.Bindings;
+import javax.script.Invocable;
+import javax.script.ScriptContext;
+import javax.script.ScriptEngineFactory;
+import javax.script.ScriptException;
+import javax.script.SimpleBindings;
+
+import org.armedbear.lisp.AbstractString;
+import org.armedbear.lisp.Bignum;
+import org.armedbear.lisp.ConditionThrowable;
+import org.armedbear.lisp.Cons;
+import org.armedbear.lisp.DoubleFloat;
+import org.armedbear.lisp.Fixnum;
+import org.armedbear.lisp.Function;
+import org.armedbear.lisp.Interpreter;
+import org.armedbear.lisp.JavaObject;
+import org.armedbear.lisp.Keyword;
+import org.armedbear.lisp.Lisp;
+import org.armedbear.lisp.LispCharacter;
+import org.armedbear.lisp.LispObject;
+import org.armedbear.lisp.LispThread;
+import org.armedbear.lisp.SimpleString;
+import org.armedbear.lisp.SingleFloat;
+import org.armedbear.lisp.Stream;
+import org.armedbear.lisp.Symbol;
+import org.armedbear.lisp.scripting.util.ReaderInputStream;
+import org.armedbear.lisp.scripting.util.WriterOutputStream;
+
+
+public class AbclScriptEngine extends AbstractScriptEngine implements Invocable {
+
+ private Interpreter interpreter;
+ private LispObject nonThrowingDebugHook;
+ private Function evalScript;
+
+ public AbclScriptEngine(Interpreter interpreter, boolean enableThrowingDebugger) {
+ this.interpreter = interpreter;
+ Interpreter.initializeLisp();
+ final LispThread thread = LispThread.currentThread();
+ this.nonThrowingDebugHook = Symbol.DEBUGGER_HOOK.getSymbolValue();
+ if (enableThrowingDebugger) {
+ try {
+ installThrowingDebuggerHook(thread);
+ } catch (ConditionThrowable e) {
+ throw new InternalError("Can't set throwing debugger hook!");
+ }
+ }
+ try {
+ loadFromClasspath("/org/armedbear/lisp/scripting/lisp/packages.lisp");
+ loadFromClasspath("/org/armedbear/lisp/scripting/lisp/abcl-script.lisp");
+ evalScript = (Function) this.findSymbol("EVAL-SCRIPT", "ABCL-SCRIPT").getSymbolFunction();
+ } catch (ConditionThrowable e) {
+ e.printStackTrace();
+ }
+ }
+
+ public AbclScriptEngine(Interpreter interpreter) {
+ this(interpreter, false);
+ }
+
+ public AbclScriptEngine(boolean enableThrowingDebugger) {
+ this(Interpreter.createInstance(), enableThrowingDebugger);
+ }
+
+ public AbclScriptEngine() {
+ this(Interpreter.createInstance(), true);
+ }
+
+ public Interpreter getInterpreter() {
+ return interpreter;
+ }
+
+ public void installNonThrowingDebugHook() {
+ installNonThrowingDebugHook(LispThread.currentThread());
+ }
+
+ public void installNonThrowingDebugHook(LispThread thread) {
+ thread.setSpecialVariable(Symbol.DEBUGGER_HOOK, this.nonThrowingDebugHook);
+ }
+
+ public void installThrowingDebuggerHook(LispThread thread) throws ConditionThrowable {
+ Symbol dbgrhkfunSym;
+ dbgrhkfunSym = Lisp.PACKAGE_SYS.findAccessibleSymbol("%DEBUGGER-HOOK-FUNCTION");
+ LispObject throwingDebugHook = dbgrhkfunSym.getSymbolFunction();
+ thread.setSpecialVariable(Symbol.DEBUGGER_HOOK, throwingDebugHook);
+ }
+
+ public void installThrowingDebuggerHook() throws ConditionThrowable {
+ installThrowingDebuggerHook(LispThread.currentThread());
+ }
+
+ public void setStandardInput(InputStream stream, LispThread thread) {
+ thread.setSpecialVariable(Symbol.STANDARD_INPUT, new Stream(stream, Symbol.CHARACTER, true));
+ }
+
+ public void setStandardInput(InputStream stream) {
+ setStandardInput(stream, LispThread.currentThread());
+ }
+
+ public void setInterpreter(Interpreter interpreter) {
+ this.interpreter = interpreter;
+ }
+
+ public static String escape(String s) {
+ StringBuffer b = new StringBuffer();
+ int len = s.length();
+ char c;
+ for (int i = 0; i < len; ++i) {
+ c = s.charAt(i);
+ if (c == '\\' || c == '"') {
+ b.append('\\');
+ }
+ b.append(c);
+ }
+ return b.toString();
+ }
+
+ public LispObject loadFromClasspath(String classpathResource) throws ConditionThrowable {
+ InputStream istream = getClass().getResourceAsStream(classpathResource);
+ Stream stream = new Stream(istream, Symbol.CHARACTER);
+ return load(stream);
+ }
+
+ public LispObject load(Stream stream) throws ConditionThrowable {
+ Symbol keyword_verbose = Lisp.internKeyword("VERBOSE");
+ Symbol keyword_print = Lisp.internKeyword("PRINT");
+ /*
+ * load (filespec &key (verbose *load-verbose*) (print *load-print*)
+ * (if-does-not-exist t) (external-format :default)
+ */
+ return Symbol.LOAD.getSymbolFunction().execute(
+ new LispObject[] { stream, keyword_verbose, Lisp.NIL,
+ keyword_print, Lisp.T, Keyword.IF_DOES_NOT_EXIST,
+ Lisp.T, Keyword.EXTERNAL_FORMAT, Keyword.DEFAULT });
+ }
+
+ public LispObject load(String filespec) throws ConditionThrowable {
+ return load(filespec, true);
+ }
+
+ public LispObject load(String filespec, boolean compileIfNecessary) throws ConditionThrowable {
+ if (isCompiled(filespec) || !compileIfNecessary) {
+ return interpreter.eval("(load \"" + escape(filespec) + "\")");
+ } else {
+ return compileAndLoad(filespec);
+ }
+ }
+
+ public static boolean isCompiled(String filespec) {
+ if (filespec.endsWith(".abcl")) {
+ return true;
+ }
+ File source;
+ File compiled;
+ if (filespec.endsWith(".lisp")) {
+ source = new File(filespec);
+ compiled = new File(filespec.substring(0, filespec.length() - 5)
+ + ".abcl");
+ } else {
+ source = new File(filespec + ".lisp");
+ compiled = new File(filespec + ".abcl");
+ }
+ if (!source.exists()) {
+ throw new IllegalArgumentException("The source file " + filespec + " cannot be found");
+ }
+ return compiled.exists()
+ && compiled.lastModified() >= source.lastModified();
+ }
+
+ public LispObject compileFile(String filespec) throws ConditionThrowable {
+ return interpreter.eval("(compile-file \"" + escape(filespec) + "\")");
+ }
+
+ public LispObject compileAndLoad(String filespec) throws ConditionThrowable {
+ return interpreter.eval("(load (compile-file \"" + escape(filespec) + "\"))");
+ }
+
+ public static boolean functionp(LispObject obj) {
+ return obj instanceof Function;
+ }
+
+ public JavaObject jsetq(String symbol, Object value) throws ConditionThrowable {
+ Symbol s = findSymbol(symbol);
+ JavaObject jo;
+ if (value instanceof JavaObject) {
+ jo = (JavaObject) value;
+ } else {
+ jo = new JavaObject(value);
+ }
+ s.setSymbolValue(jo);
+ return jo;
+ }
+
+ public Symbol findSymbol(String name, String pkg) throws ConditionThrowable {
+ Cons values = (Cons) (interpreter.eval("(cl:multiple-value-list (find-symbol (symbol-name '#:"
+ + escape(name) + ")" + (pkg == null ? "" : " :" + escape(pkg))
+ + "))"));
+ if(values.cadr() == Lisp.NIL) {
+ return null;
+ } else {
+ return (Symbol) values.car();
+ }
+ }
+
+ public Symbol findSymbol(String name) throws ConditionThrowable {
+ //Known bug: doesn't handle escaped ':' e.g. |a:b|
+ int i = name.indexOf(':');
+ if(i < 0) {
+ return findSymbol(name, null);
+ } else {
+ return findSymbol(name.substring(i + 1), name.substring(0, i));
+ }
+ }
+
+ public Function findFunction(String name) throws ConditionThrowable {
+ return (Function) interpreter.eval("#'" + name);
+ }
+
+ @Override
+ public Bindings createBindings() {
+ return new SimpleBindings();
+ }
+
+ private static LispObject makeBindings(Bindings bindings) throws ConditionThrowable {
+ if (bindings == null || bindings.size() == 0) {
+ return Lisp.NIL;
+ }
+ LispObject[] argList = new LispObject[bindings.size()];
+ int i = 0;
+ for (Map.Entry<String, Object> entry : bindings.entrySet()) {
+ argList[i++] = Symbol.CONS.execute(new SimpleString(entry.getKey()), toLisp(entry.getValue()));
+ }
+ return Symbol.LIST.getSymbolFunction().execute(argList);
+ }
+
+ @Override
+ public ScriptContext getContext() {
+ return super.getContext();
+ }
+
+ @Override
+ public Object eval(String code, ScriptContext ctx) throws ScriptException {
+ ReaderInputStream in = null;
+ WriterOutputStream out = null;
+ LispObject retVal = null;
+ try {
+ in = new ReaderInputStream(ctx.getReader());
+ out = new WriterOutputStream(ctx.getWriter());
+ retVal = evalScript.execute(makeBindings(ctx.getBindings(ScriptContext.GLOBAL_SCOPE)),
+ makeBindings(ctx.getBindings(ScriptContext.ENGINE_SCOPE)),
+ new Stream(in, Symbol.CHARACTER),
+ new Stream(out, Symbol.CHARACTER),
+ new SimpleString(code), new JavaObject(ctx));
+ return toJava(retVal);
+ } catch (ConditionThrowable e) {
+ throw new ScriptException(new Exception(e));
+ } catch (IOException e) {
+ throw new ScriptException(e);
+ }
+ }
+
+ @Override
+ public Object eval(Reader code, ScriptContext ctx) throws ScriptException {
+ StringWriter w = new StringWriter();
+ int i;
+ try {
+ i = code.read();
+ while (i != -1) {
+ w.write(i);
+ i = code.read();
+ }
+ return eval(w.toString(), ctx);
+ } catch (IOException e) {
+ return new ScriptException(e);
+ }
+ }
+
+ @Override
+ public ScriptEngineFactory getFactory() {
+ return new AbclScriptEngineFactory();
+ }
+
+ public static String decoratedVariableName(String jvar) {
+ return jvar.toUpperCase();
+ }
+
+ private static Object toJava(LispObject lispObject) {
+ if(lispObject instanceof JavaObject) {
+ return ((JavaObject) lispObject).getObject();
+ } else if(lispObject instanceof SingleFloat) {
+ return ((SingleFloat) lispObject).value;
+ } else if(lispObject instanceof DoubleFloat) {
+ return ((DoubleFloat) lispObject).value;
+ } else if(lispObject instanceof LispCharacter) {
+ return ((LispCharacter) lispObject).value;
+ } else if(lispObject instanceof Bignum) {
+ return ((Bignum) lispObject).value;
+ } else if(lispObject instanceof Fixnum) {
+ return ((Fixnum) lispObject).value;
+ } else if(lispObject instanceof SimpleString) {
+ return ((SimpleString) lispObject).javaInstance();
+ } else {
+ return lispObject;
+ }
+ }
+
+ public static LispObject toLisp(Object javaObject) {
+ if(javaObject instanceof LispObject) {
+ return (LispObject) javaObject;
+ } else if(javaObject instanceof Float) {
+ return new SingleFloat((Float) javaObject);
+ } else if(javaObject instanceof Double) {
+ return new DoubleFloat((Double) javaObject);
+ } else if(javaObject instanceof Character) {
+ return LispCharacter.getInstance((Character) javaObject);
+ } else if(javaObject instanceof Long) {
+ return new Bignum((Long) javaObject);
+ } else if(javaObject instanceof BigInteger) {
+ return new Bignum((BigInteger) javaObject);
+ } else if(javaObject instanceof Integer) {
+ return new Fixnum((Integer) javaObject);
+ } else if(javaObject instanceof String) {
+ return new SimpleString((String) javaObject);
+ } else {
+ return new JavaObject(javaObject);
+ }
+ }
+
+ @SuppressWarnings("unchecked")
+ @Override
+ public <T> T getInterface(Class<T> clasz) {
+ try {
+ Symbol s = findSymbol("find-java-interface-implementation", "abcl-script");
+ Object obj = s.getSymbolFunction().execute(new JavaObject(clasz));
+ if(obj instanceof JavaObject) {
+ return (T) ((JavaObject) obj).getObject();
+ } else {
+ return null;
+ }
+ } catch (ConditionThrowable e) {
+ throw new Error(e);
+ }
+ }
+
+ @SuppressWarnings("unchecked")
+ @Override
+ public <T> T getInterface(Object thiz, Class<T> clasz) {
+ try {
+ Symbol s = findSymbol("implement-java-interface", "abcl-script");
+ Object obj = s.getSymbolFunction().execute(new JavaObject(clasz), (LispObject) thiz);
+ return (T) ((JavaObject) obj).getObject();
+ } catch (ConditionThrowable e) {
+ throw new Error(e);
+ }
+ }
+
+ @Override
+ public Object invokeFunction(String name, Object... args) throws ScriptException, NoSuchMethodException {
+ try {
+ Symbol s = findSymbol(name);
+ 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);
+ }
+ } else {
+ throw new NoSuchMethodException(name);
+ }
+ } 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.");
+ }
+
+}
Added: branches/scripting/j/src/org/armedbear/lisp/scripting/AbclScriptEngineFactory.java
==============================================================================
--- (empty file)
+++ branches/scripting/j/src/org/armedbear/lisp/scripting/AbclScriptEngineFactory.java Sun Oct 19 06:07:32 2008
@@ -0,0 +1,133 @@
+/*
+ * AbclScriptEngineFactory.java
+ *
+ * Copyright (C) 2008 Alessio Stalla
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ */
+
+package org.armedbear.lisp.scripting;
+
+import java.util.ArrayList;
+import java.util.List;
+
+import javax.script.ScriptEngine;
+import javax.script.ScriptEngineFactory;
+
+public class AbclScriptEngineFactory implements ScriptEngineFactory {
+
+ private static final AbclScriptEngine THE_ONLY_ONE_ENGINE = new AbclScriptEngine(true);
+
+ @Override
+ public String getEngineName() {
+ return "ABCL Script";
+ }
+
+ @Override
+ public String getEngineVersion() {
+ return "0.1";
+ }
+
+ @Override
+ public List<String> getExtensions() {
+ List<String> extensions = new ArrayList<String>(1);
+ extensions.add("lisp");
+ return extensions;
+ }
+
+ @Override
+ public String getLanguageName() {
+ return "ANSI Common Lisp";
+ }
+
+ @Override
+ public String getLanguageVersion() {
+ return "ANSI X3.226:1994";
+ }
+
+ public static String escape(String raw) {
+ StringBuilder sb = new StringBuilder();
+ int len = raw.length();
+ char c;
+ for(int i = 0; i < len; ++i) {
+ c = raw.charAt(i);
+ if(c != '"') {
+ sb.append(c);
+ } else {
+ sb.append("\\\"");
+ }
+ }
+ return sb.toString();
+ }
+
+ @Override
+ public String getMethodCallSyntax(String obj, String method, String... args) {
+ StringBuilder sb = new StringBuilder();
+ sb.append("(jcall \"");
+ sb.append(method);
+ sb.append("\" ");
+ sb.append(AbclScriptEngine.decoratedVariableName(obj));
+ for(String arg : args) {
+ sb.append(" ");
+ sb.append(AbclScriptEngine.decoratedVariableName(arg));
+ }
+ sb.append(")");
+ return sb.toString();
+ }
+
+ @Override
+ public List<String> getMimeTypes() {
+ return new ArrayList<String>();
+ }
+
+ @Override
+ public List<String> getNames() {
+ List<String> names = new ArrayList<String>(1);
+ names.add("ABCL");
+ names.add("cl");
+ names.add("Lisp");
+ names.add("Common Lisp");
+ return names;
+ }
+
+ @Override
+ public String getOutputStatement(String str) {
+ return "(cl:print \"" + str + "\")";
+ }
+
+ @Override
+ public Object getParameter(String key) {
+ // TODO Auto-generated method stub
+ return null;
+ }
+
+ @Override
+ public String getProgram(String... statements) {
+ StringBuilder sb = new StringBuilder();
+ sb.append("(cl:progn");
+ for(String stmt : statements) {
+ sb.append("\n\t");
+ sb.append(stmt);
+ }
+ sb.append(")");
+ return sb.toString();
+ }
+
+ @Override
+ public ScriptEngine getScriptEngine() {
+ return THE_ONLY_ONE_ENGINE;
+ }
+
+}
Added: branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp
==============================================================================
--- (empty file)
+++ branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp Sun Oct 19 06:07:32 2008
@@ -0,0 +1,102 @@
+;;; abcl-script.lisp
+;;;
+;;; Copyright (C) 2008 Alessio Stalla
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License
+;;; as published by the Free Software Foundation; either version 2
+;;; of the License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(in-package :abcl-script)
+
+(defvar *java-interface-implementations* (make-hash-table :test #'equal))
+
+(defconstant +global-scope+
+ (jfield "javax.script.ScriptContext" "GLOBAL_SCOPE"))
+
+(defconstant +engine-scope+
+ (jfield "javax.script.ScriptContext" "ENGINE_SCOPE"))
+
+(defconstant +put-binding+ (jmethod "javax.script.Bindings"
+ "put"
+ "java.lang.String"
+ "java.lang.Object"))
+
+(defconstant +get-bindings+ (jmethod "javax.script.ScriptContext"
+ "getBindings"
+ "int"))
+
+(defun generate-bindings (bindings)
+ (let ((*package* (find-package :abcl-script-user)))
+ (mapcar (lambda (binding) (list (read-from-string (car binding))
+ (cdr binding)))
+ bindings)))
+
+(defun generate-java-bindings (bindings-list actual-bindings java-bindings)
+ (loop :for binding :in actual-bindings
+ :for jbinding :in bindings-list
+ :collect `(jcall +put-binding+
+ ,java-bindings ,(car jbinding) ,(car binding))))
+
+(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 (, at actual-global-bindings)
+ (let (, at 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+)))))))))
+
+(defstruct (java-interface-implementation (:type list))
+ (method-definitions (list) :type list))
+
+(defun define-java-interface-implementation (interface &rest method-definitions)
+ (register-java-interface-implementation
+ (canonicalize-interface interface)
+ (make-java-interface-implementation :method-definitions method-definitions)))
+
+(defun canonicalize-interface (interface)
+ (cond
+ ((stringp interface) interface)
+ ((jclass-interface-p interface) (jclass-name interface))
+ (t (error "not an interface: ~A" interface))))
+
+(defun register-java-interface-implementation (interface implementation)
+ (setf (gethash (canonicalize-interface interface)
+ *java-interface-implementations*)
+ (implement-java-interface interface implementation)))
+
+(defun find-java-interface-implementation (interface)
+ (gethash (canonicalize-interface interface)
+ *java-interface-implementations*))
+
+(defun implement-java-interface (interface implementation)
+ (apply #'jinterface-implementation
+ `(,interface
+ ,@(java-interface-implementation-method-definitions implementation))))
\ No newline at end of file
Added: branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/packages.lisp
==============================================================================
--- (empty file)
+++ branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/packages.lisp Sun Oct 19 06:07:32 2008
@@ -0,0 +1,27 @@
+;;; packages.lisp
+;;;
+;;; Copyright (C) 2008 Alessio Stalla
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License
+;;; as published by the Free Software Foundation; either version 2
+;;; of the License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(defpackage :abcl-script
+ (:use :cl :java)
+ (:export #:eval-script
+ #:define-java-interface-implementation
+ #:find-java-interface-implementation
+ #:implement-java-interface))
+
+(defpackage :abcl-script-user
+ (:use :cl :ext :java :abcl-script))
\ No newline at end of file
Added: branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/test/AbclTest.java
==============================================================================
--- (empty file)
+++ branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/test/AbclTest.java Sun Oct 19 06:07:32 2008
@@ -0,0 +1,104 @@
+package org.armedbear.lisp.scripting;
+
+import java.io.InputStreamReader;
+import java.io.OutputStreamWriter;
+import java.io.StringReader;
+import java.io.StringWriter;
+
+import javax.script.Bindings;
+import javax.script.ScriptContext;
+import javax.script.ScriptException;
+import javax.script.SimpleScriptContext;
+
+import junit.framework.TestCase;
+
+import org.armedbear.lisp.ConditionThrowable;
+import org.armedbear.lisp.Cons;
+import org.armedbear.lisp.Fixnum;
+import org.armedbear.lisp.Lisp;
+import org.armedbear.lisp.LispObject;
+import org.armedbear.lisp.scripting.AbclScriptEngine;
+
+public class AbclTest extends TestCase {
+
+ private static AbclScriptEngine engine = new AbclScriptEngine(false);
+
+ public void testBindings() {
+ try {
+ engine.put("foo", 42);
+ assertEquals(new Integer(42), engine.eval("foo"));
+ engine.eval("(setq foo 45)");
+ assertEquals(new Integer(45), engine.get("foo"));
+ } catch (ScriptException e) {
+ e.printStackTrace();
+ fail("Exception was thrown.");
+ }
+ }
+
+ public void testContext() {
+ try {
+ SimpleScriptContext ctx = new SimpleScriptContext();
+ ctx.setReader(new StringReader("\"test\""));
+ StringWriter out = new StringWriter();
+ ctx.setWriter(out);
+ Bindings bindings = engine.createBindings();
+ ctx.setBindings(bindings, ScriptContext.ENGINE_SCOPE);
+
+ bindings.put("bar", 42);
+ assertEquals(new Integer(42), engine.eval("bar", ctx));
+ engine.eval("(setq bar 45)", ctx);
+ assertEquals(new Integer(45), bindings.get("bar"));
+
+ engine.eval("(princ (read))", ctx);
+ assertEquals("test", out.toString());
+ } catch (ScriptException e) {
+ e.printStackTrace();
+ fail("Exception was thrown.");
+ }
+ }
+
+ public void testFunctions() {
+ try {
+ assertEquals(42, ((Fixnum) engine.invokeFunction("+", 40, 2)).value);
+ assertEquals(Lisp.NIL, engine.invokeFunction("car", new Cons(Lisp.NIL, Lisp.NIL)));
+ assertEquals(9, ((Fixnum) engine.invokeFunction("length", "megaceppa")).value);
+ } catch (Throwable t) {
+ t.printStackTrace();
+ fail("Exception: " + t);
+ }
+ }
+
+ public void testInterface() {
+ try {
+ engine.eval("(define-java-interface-implementation \"java.lang.Comparable\" \"compareTo\" (lambda (obj) 42))");
+ Comparable comp = engine.getInterface(Comparable.class);
+ assertEquals(42, comp.compareTo(null));
+ } catch (Exception e) {
+ e.printStackTrace();
+ fail("Exception: " + e);
+ }
+ }
+
+ public static void main(String[] args) {
+ AbclScriptEngine engine = new AbclScriptEngine(false);
+ try {
+ //System.out.println(((LispObject) engine.eval("(print (read))")).writeToString());
+ SimpleScriptContext ctx = new SimpleScriptContext();
+ ctx.setReader(new InputStreamReader(System.in));
+ ctx.setWriter(new OutputStreamWriter(System.out));
+ Bindings bindings = engine.createBindings();
+ bindings.put("x", 3);
+ ctx.setBindings(bindings, ctx.ENGINE_SCOPE);
+ engine.eval("(print \"Hello, World!\")");
+ System.out.println("EVAL returned: " + ((LispObject) engine.eval("(print x) (print (jcall (jmethod \"java.lang.Integer\" \"intValue\") x)) (print (type-of (jcall (jmethod \"java.lang.Integer\" \"intValue\") x))) (print 4)", ctx)).writeToString());
+ engine.put("y", 42);
+ System.out.println("EVAL returned: " + ((LispObject) engine.eval("(print y) (print (jcall (jmethod \"java.lang.Integer\" \"intValue\") y)) (setq y 45)")).writeToString());
+ System.out.println("y = " + engine.get("y"));
+ } catch (ScriptException e) {
+ e.printStackTrace();
+ } catch (ConditionThrowable e) {
+ e.printStackTrace();
+ }
+ }
+
+}
Added: branches/scripting/j/src/org/armedbear/lisp/scripting/util/ReaderInputStream.java
==============================================================================
--- (empty file)
+++ branches/scripting/j/src/org/armedbear/lisp/scripting/util/ReaderInputStream.java Sun Oct 19 06:07:32 2008
@@ -0,0 +1,79 @@
+package org.armedbear.lisp.scripting.util;
+
+import java.io.*;
+
+public class ReaderInputStream extends InputStream {
+
+ private final Reader reader;
+ private final Writer writer;
+ private final PipedInputStream inPipe;
+
+ public ReaderInputStream(Reader reader) throws IOException {
+ this(reader, null);
+ }
+
+ public ReaderInputStream(final Reader reader, String encoding) throws IOException {
+ this.reader = reader;
+ inPipe = new PipedInputStream();
+ OutputStream outPipe = new PipedOutputStream(inPipe);
+ writer = (encoding == null) ? new OutputStreamWriter(outPipe) : new OutputStreamWriter(outPipe, encoding);
+ }
+
+ public int read() throws IOException {
+ if(doRead()) {
+ return inPipe.read();
+ } else {
+ return -1;
+ }
+ }
+
+ public int read(byte b[]) throws IOException {
+ return super.read(b);
+ }
+
+ public int read(byte b[], int off, int len) throws IOException {
+ if(len <= 0) {
+ return 0;
+ }
+ int n = read();
+ if(n == -1) {
+ return -1;
+ } else {
+ b[off] = (byte)n;
+ }
+ return 1;
+ }
+
+ public long skip(long n) throws IOException {
+ return super.skip(n);
+ }
+
+ public int available() throws IOException {
+ return 0;
+ }
+
+ public synchronized void close() throws IOException {
+ close(reader);
+ close(writer);
+ close(inPipe);
+ }
+
+ private static void close(Closeable cl) {
+ try {
+ cl.close();
+ } catch (IOException e) {
+ e.printStackTrace();
+ }
+ }
+
+ private boolean doRead() throws IOException {
+ int n = reader.read();
+ if(n == -1) {
+ return false;
+ }
+ writer.write(n);
+ writer.flush();
+ return true;
+ }
+
+}
\ No newline at end of file
Added: branches/scripting/j/src/org/armedbear/lisp/scripting/util/WriterOutputStream.java
==============================================================================
--- (empty file)
+++ branches/scripting/j/src/org/armedbear/lisp/scripting/util/WriterOutputStream.java Sun Oct 19 06:07:32 2008
@@ -0,0 +1,64 @@
+package org.armedbear.lisp.scripting.util;
+
+import java.io.*;
+
+public class WriterOutputStream extends OutputStream {
+
+ private final Reader reader;
+ private final Writer writer;
+ private final PipedOutputStream outPipe;
+
+ public WriterOutputStream(Writer writer) throws IOException {
+ this(writer, null);
+ }
+
+ public WriterOutputStream(final Writer writer, String encoding) throws IOException {
+ this.writer = writer;
+ outPipe = new PipedOutputStream();
+ InputStream inPipe = new PipedInputStream(outPipe);
+ reader = (encoding == null) ? new InputStreamReader(inPipe) : new InputStreamReader(inPipe, encoding);
+ }
+
+ @Override
+ public void write(int b) throws IOException {
+ doWrite(b);
+ writer.flush();
+ }
+
+ @Override
+ public void flush() throws IOException {
+ super.flush();
+ }
+
+ @Override
+ public void write(byte[] b, int off, int len) throws IOException {
+ super.write(b, off, len);
+ }
+
+ @Override
+ public void write(byte[] b) throws IOException {
+ super.write(b);
+ }
+
+ public synchronized void close() throws IOException {
+ close(reader);
+ close(writer);
+ close(outPipe);
+ }
+
+ private static void close(Closeable cl) {
+ try {
+ cl.close();
+ } catch (IOException e) {
+ e.printStackTrace();
+ }
+ }
+
+ private void doWrite(int n) throws IOException {
+ outPipe.write(n);
+ outPipe.flush();
+ n = reader.read();
+ writer.write(n);
+ }
+
+}
\ No newline at end of file
More information about the armedbear-cvs
mailing list