[armedbear-cvs] r11856 - in trunk/abcl: examples/abcl/jsr-223 src/org/armedbear/lisp src/org/armedbear/lisp/scripting/lisp
Alessio Stalla
astalla at common-lisp.net
Mon May 11 21:12:19 UTC 2009
Author: astalla
Date: Mon May 11 17:12:17 2009
New Revision: 11856
Log:
* loading:
added a new primitive sys::load-returning-last-result which behaves like
load but returns the last value produced instead of T
* JSR-223:
- used the new load-returning-last-result to evaluate both interpreted and
compiled code for consistency (with a caveat, see the wiki page on JSR-223)
- bindings established through ScriptContext are now declared special
- compilation using the runtime compiler has been removed due to
inconsistencies with evaluation and file-based compilation
- updated the example as suggested on the ML to show both modes of getting
the AbclScriptEngine
Modified:
trunk/abcl/examples/abcl/jsr-223/JSR223Example.java
trunk/abcl/src/org/armedbear/lisp/Load.java
trunk/abcl/src/org/armedbear/lisp/load.lisp
trunk/abcl/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp
trunk/abcl/src/org/armedbear/lisp/scripting/lisp/config.lisp
Modified: trunk/abcl/examples/abcl/jsr-223/JSR223Example.java
==============================================================================
--- trunk/abcl/examples/abcl/jsr-223/JSR223Example.java (original)
+++ trunk/abcl/examples/abcl/jsr-223/JSR223Example.java Mon May 11 17:12:17 2009
@@ -3,8 +3,19 @@
public class JSR223Example {
public static void main(String[] args) {
- //Script Engine instantiation
- ScriptEngine lispEngine = new ScriptEngineManager().getEngineByExtension("lisp");
+ //Script Engine instantiation using ServiceProvider - this will
+ //look in the classpath for a file
+ // /META-INF/services/javax.script.ScriptEngineFactory
+ //where the AbclScriptEngineFactory is registered
+ ScriptEngine lispEngine = new ScriptEngineManager().getEngineByExtension("lisp");
+
+ //Alternatively, you can directly instantiate the script engine:
+
+ //ScriptEngineManager scriptManager = new ScriptEngineManager();
+ //scriptManager.registerEngineExtension("lisp", new AbclScriptEngineFactory());
+ //ScriptEngine lispEngine = scriptManager.getEngineByExtension("lisp");
+
+ //(thanks to Peter Tsenter for suggesting this)
//Accessing variables
System.out.println();
Modified: trunk/abcl/src/org/armedbear/lisp/Load.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Load.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Load.java Mon May 11 17:12:17 2009
@@ -90,6 +90,17 @@
boolean verbose,
boolean print,
boolean ifDoesNotExist)
+ throws ConditionThrowable {
+ return load(pathname, filename, verbose, print, ifDoesNotExist, false);
+ }
+
+
+ public static final LispObject load(Pathname pathname,
+ String filename,
+ boolean verbose,
+ boolean print,
+ boolean ifDoesNotExist,
+ boolean returnLastResult)
throws ConditionThrowable
{
String dir = null;
@@ -153,7 +164,7 @@
try {
return loadFileFromStream(null, truename,
new Stream(in, Symbol.CHARACTER),
- verbose, print, false);
+ verbose, print, false, returnLastResult);
}
catch (FaslVersionMismatch e) {
FastStringBuffer sb =
@@ -380,6 +391,17 @@
boolean verbose,
boolean print,
boolean auto)
+ throws ConditionThrowable {
+ return loadFileFromStream(pathname, truename, in, verbose, print, auto, false);
+ }
+
+ private static final LispObject loadFileFromStream(LispObject pathname,
+ String truename,
+ Stream in,
+ boolean verbose,
+ boolean print,
+ boolean auto,
+ boolean returnLastResult)
throws ConditionThrowable
{
long start = System.currentTimeMillis();
@@ -415,7 +437,7 @@
out._writeString(truename != null ? truename : "stream");
out._writeLine(" ...");
out._finishOutput();
- LispObject result = loadStream(in, print, thread);
+ LispObject result = loadStream(in, print, thread, returnLastResult);
long elapsed = System.currentTimeMillis() - start;
out.freshLine();
out._writeString(prefix);
@@ -427,7 +449,7 @@
out._finishOutput();
return result;
} else
- return loadStream(in, print, thread);
+ return loadStream(in, print, thread, returnLastResult);
}
finally {
thread.lastSpecialBinding = lastSpecialBinding;
@@ -444,6 +466,12 @@
private static final LispObject loadStream(Stream in, boolean print,
LispThread thread)
+ throws ConditionThrowable {
+ return loadStream(in, print, thread, false);
+ }
+
+ private static final LispObject loadStream(Stream in, boolean print,
+ LispThread thread, boolean returnLastResult)
throws ConditionThrowable
{
SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
@@ -454,12 +482,13 @@
thread.lastSpecialBinding = sourcePositionBinding;
try {
final Environment env = new Environment();
+ LispObject result = NIL;
while (true) {
sourcePositionBinding.value = Fixnum.getInstance(in.getOffset());
LispObject obj = in.read(false, EOF, false, thread);
if (obj == EOF)
break;
- LispObject result = eval(obj, env, thread);
+ result = eval(obj, env, thread);
if (print) {
Stream out =
checkCharacterOutputStream(Symbol.STANDARD_OUTPUT.symbolValue(thread));
@@ -467,7 +496,11 @@
out._finishOutput();
}
}
- return T;
+ if(returnLastResult) {
+ return result;
+ } else {
+ return T;
+ }
}
finally {
thread.lastSpecialBinding = lastSpecialBinding;
@@ -480,19 +513,24 @@
Stream in = (Stream) _LOAD_STREAM_.symbolValue(thread);
final Environment env = new Environment();
final SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+ LispObject result = NIL;
try {
thread.bindSpecial(_FASL_ANONYMOUS_PACKAGE_, new Package());
while (true) {
LispObject obj = in.faslRead(false, EOF, true, thread);
if (obj == EOF)
break;
- eval(obj, env, thread);
+ result = eval(obj, env, thread);
}
}
finally {
thread.lastSpecialBinding = lastSpecialBinding;
}
- return T;
+ return result;
+ //There's no point in using here the returnLastResult flag like in
+ //loadStream(): this function is only called from init-fasl, which is
+ //only called from load, which already has its own policy for choosing
+ //whether to return T or the last value.
}
// Returns extension including leading '.'
@@ -562,41 +600,64 @@
{
@Override
public LispObject execute(LispObject filespec, LispObject verbose,
- LispObject print, LispObject ifDoesNotExist)
- throws ConditionThrowable
- {
- if (filespec instanceof Stream) {
- if (((Stream)filespec).isOpen()) {
- LispObject pathname;
- if (filespec instanceof FileStream)
- pathname = ((FileStream)filespec).getPathname();
- else
- pathname = NIL;
- String truename;
- if (pathname instanceof Pathname)
- truename = ((Pathname)pathname).getNamestring();
- else
- truename = null;
- return loadFileFromStream(pathname,
- truename,
- (Stream) filespec,
- verbose != NIL,
- print != NIL,
- false);
- }
- // If stream is closed, fall through...
- }
- Pathname pathname = coerceToPathname(filespec);
- if (pathname instanceof LogicalPathname)
- pathname = LogicalPathname.translateLogicalPathname((LogicalPathname)pathname);
- return load(pathname,
- pathname.getNamestring(),
- verbose != NIL,
- print != NIL,
- ifDoesNotExist != NIL);
- }
+ LispObject print, LispObject ifDoesNotExist)
+ throws ConditionThrowable {
+ return load(filespec, verbose, print, ifDoesNotExist, NIL);
+ }
};
+ // ### %load-returning-last-result filespec verbose print if-does-not-exist => object
+ private static final Primitive _LOAD_RETURNING_LAST_RESULT =
+ new Primitive("%load-returning-last-result", PACKAGE_SYS, false,
+ "filespec verbose print if-does-not-exist")
+ {
+ @Override
+ public LispObject execute(LispObject filespec, LispObject verbose,
+ LispObject print, LispObject ifDoesNotExist)
+ throws ConditionThrowable {
+ return load(filespec, verbose, print, ifDoesNotExist, T);
+ }
+ };
+
+ private static final LispObject load(LispObject filespec,
+ LispObject verbose,
+ LispObject print,
+ LispObject ifDoesNotExist,
+ LispObject returnLastResult)
+ throws ConditionThrowable {
+ if (filespec instanceof Stream) {
+ if (((Stream)filespec).isOpen()) {
+ LispObject pathname;
+ if (filespec instanceof FileStream)
+ pathname = ((FileStream)filespec).getPathname();
+ else
+ pathname = NIL;
+ String truename;
+ if (pathname instanceof Pathname)
+ truename = ((Pathname)pathname).getNamestring();
+ else
+ truename = null;
+ return loadFileFromStream(pathname,
+ truename,
+ (Stream) filespec,
+ verbose != NIL,
+ print != NIL,
+ false,
+ returnLastResult != NIL);
+ }
+ // If stream is closed, fall through...
+ }
+ Pathname pathname = coerceToPathname(filespec);
+ if (pathname instanceof LogicalPathname)
+ pathname = LogicalPathname.translateLogicalPathname((LogicalPathname)pathname);
+ return load(pathname,
+ pathname.getNamestring(),
+ verbose != NIL,
+ print != NIL,
+ ifDoesNotExist != NIL,
+ returnLastResult != NIL);
+ }
+
// ### load-system-file
private static final Primitive LOAD_SYSTEM_FILE =
new Primitive("load-system-file", PACKAGE_SYS, true)
Modified: trunk/abcl/src/org/armedbear/lisp/load.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/load.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/load.lisp Mon May 11 17:12:17 2009
@@ -42,3 +42,15 @@
filespec
(merge-pathnames (pathname filespec)))
verbose print if-does-not-exist))
+
+(defun load-returning-last-result (filespec
+ &key
+ (verbose *load-verbose*)
+ (print *load-print*)
+ (if-does-not-exist t)
+ (external-format :default))
+ (declare (ignore external-format)) ; FIXME
+ (%load-returning-last-result (if (streamp filespec)
+ filespec
+ (merge-pathnames (pathname filespec)))
+ verbose print if-does-not-exist))
\ No newline at end of file
Modified: trunk/abcl/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp Mon May 11 17:12:17 2009
@@ -51,6 +51,12 @@
(cdr binding)))
bindings)))
+(defun generate-special-declarations (bindings)
+ (let ((*package* (find-package :abcl-script-user)))
+ `(declare (special
+ ,@(mapcar (lambda (binding) (read-from-string (car binding)))
+ bindings)))))
+
(defun generate-java-bindings (bindings-list actual-bindings java-bindings)
(loop :for binding :in actual-bindings
:for jbinding :in bindings-list
@@ -72,6 +78,8 @@
(,actual-engine-bindings (generate-bindings ,engine-bindings)))
(eval `(let (,@,actual-global-bindings)
(let (,@,actual-engine-bindings)
+ ,(generate-special-declarations ,global-bindings)
+ ,(generate-special-declarations ,engine-bindings)
(prog1
(progn ,@,body)
(finish-output *standard-output*)
@@ -87,8 +95,8 @@
(defun eval-script (global-bindings engine-bindings stdin stdout
code-string script-context)
(eval-in-script-context (global-bindings engine-bindings stdin stdout script-context)
- (read-from-string
- (concatenate 'string "(" code-string ")"))))
+ `((with-input-from-string (str ,code-string)
+ (sys::load-returning-last-result str)))))
(defun eval-compiled-script (global-bindings engine-bindings stdin stdout
function script-context)
@@ -96,32 +104,24 @@
`((funcall ,function))))
(defun compile-script (code-string)
- (if *compile-using-temp-files*
- (let* ((tmp-file (jstatic (jmethod "java.io.File" "createTempFile" "java.lang.String" "java.lang.String")
- nil "abcl-src-file-" ".lisp"))
- (tmp-file-path (jcall (jmethod "java.io.File" "getAbsolutePath") tmp-file)))
- (jcall (jmethod "java.io.File" "deleteOnExit") tmp-file) ;to be really-really-really sure...
- (unwind-protect
- (progn
- (with-open-file (stream tmp-file-path :direction :output)
- (princ "(in-package :abcl-script-user)" stream)
- (princ code-string stream)
- (finish-output stream))
- (let ((compiled-file (compile-file tmp-file-path)))
- (jcall (jmethod "java.io.File" "deleteOnExit")
- (jnew (jconstructor "java.io.File" "java.lang.String")
- (namestring compiled-file)))
- (lambda ()
- (let ((*package* (find-package :abcl-script-user)))
- (load compiled-file :verbose t :print t)))))
- (delete-file tmp-file-path)))
- (eval
- `(compile
- nil
- (lambda ()
- ,@(let ((*package* (find-package :abcl-script-user)))
- (read-from-string
- (concatenate 'string "(" code-string " cl:t)")))))))) ;return T in conformity of what LOAD does.
+ (let* ((tmp-file (jstatic (jmethod "java.io.File" "createTempFile" "java.lang.String" "java.lang.String")
+ nil "abcl-src-file-" ".lisp"))
+ (tmp-file-path (jcall (jmethod "java.io.File" "getAbsolutePath") tmp-file)))
+ (jcall (jmethod "java.io.File" "deleteOnExit") tmp-file) ;to be really-really-really sure...
+ (unwind-protect
+ (progn
+ (with-open-file (stream tmp-file-path :direction :output)
+ (princ "(in-package :abcl-script-user)" stream)
+ (princ code-string stream)
+ (finish-output stream))
+ (let ((compiled-file (compile-file tmp-file-path)))
+ (jcall (jmethod "java.io.File" "deleteOnExit")
+ (jnew (jconstructor "java.io.File" "java.lang.String")
+ (namestring compiled-file)))
+ (lambda ()
+ (let ((*package* (find-package :abcl-script-user)))
+ (sys::load-returning-last-result compiled-file)))))
+ (delete-file tmp-file-path))))
;;Java interface implementation - TODO
Modified: trunk/abcl/src/org/armedbear/lisp/scripting/lisp/config.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/scripting/lisp/config.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/scripting/lisp/config.lisp Mon May 11 17:12:17 2009
@@ -39,8 +39,6 @@
(defparameter *use-throwing-debugger* t)
-(defparameter *compile-using-temp-files* t)
-
(defun configure-abcl (abcl-script-engine)
(when *launch-swank-at-startup*
(unless *swank-dir*
More information about the armedbear-cvs
mailing list