From d6cfb903659c30d6db0b4caa670ee12f855e4739 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=B6rg=20F=2E=20Wittenberger?= Date: Mon, 2 Nov 2020 11:26:22 +0100 Subject: [PATCH 01/26] ANDROID: additional error checking on JNI an more 1.) Android 9/10 restricts access to JNI and Jave reflection API's. This adds additional checks. Commented out an possible optimization, which could be assumed to works, but does not for me so far. Please leave this comment in, so we recall before we wonder why and try over and over again. Once in a while we should ponder if it still does not work or why. 2.) Clear Java exceptions. This enables to continue to run when an exception occured during a JNI call. (Future versions shall forward this as an exception in Gambit.) 3.) Avoid some JNI calls and provide more information about the Java/Android environment to Scheme. This is required for (upcoming) tricks to still call embedded dynamic libraries as subprocesses. It also enables to figure out a sane path to store app-private data instead of the deprecated hard coding of the publicly accessible path `/sdcard`. 4.) Add support to switch the apps content view to Java and back. An upcoming module `webview` will need this. --- loaders/android/bootstrap.c.in | 45 +++++++++++++++++---- loaders/android/bootstrap.java.in | 67 +++++++++++++++++++++---------- modules/config/config.scm | 14 +++++++ 3 files changed, 97 insertions(+), 29 deletions(-) diff --git a/loaders/android/bootstrap.c.in b/loaders/android/bootstrap.c.in index 267670d3..b7bdddc3 100644 --- a/loaders/android/bootstrap.c.in +++ b/loaders/android/bootstrap.c.in @@ -62,11 +62,23 @@ void Java_@SYS_PACKAGE_UNDERSCORE@_@SYS_APPNAME@_nativeEvent(JNIEnv* e, jobject // JNI Hooks and Global Objects static jobject globalObj=NULL; static JavaVM* s_vm = NULL; +static const char* app_directory_files = NULL; +static const char* app_code_path = NULL; -void Java_@SYS_PACKAGE_UNDERSCORE@_@SYS_APPNAME@_nativeInstanceInit(JNIEnv* env, jobject thiz){ - globalObj = (*env)->NewGlobalRef(env,thiz); +void Java_@SYS_PACKAGE_UNDERSCORE@_@SYS_APPNAME@_nativeInstanceInit(JNIEnv* env, jobject thiz, jstring codePath, jstring directoryFiles){ + + globalObj = (*env)->NewGlobalRef(env,thiz); + app_directory_files = strdup((*env)->GetStringUTFChars(env, directoryFiles, 0)); + (*env)->ReleaseStringUTFChars(env, directoryFiles, NULL); + app_code_path = strdup((*env)->GetStringUTFChars(env, codePath, 0)); + (*env)->ReleaseStringUTFChars(env, codePath, NULL); } +char* android_getFilesDir() { return (char*) app_directory_files; } +char* android_getPackageCodePath() { return (char*) app_code_path; } + +char* android_getFilesDir_info_get() { return android_getFilesDir(); } + jint JNI_OnLoad(JavaVM* vm, void* reserved){ JNIEnv *env; s_vm=vm; @@ -77,19 +89,38 @@ jint JNI_OnLoad(JavaVM* vm, void* reserved){ JNIEnv* GetJNIEnv(){ int error=0; JNIEnv* env = NULL; - if (s_vm) error=(*s_vm)->AttachCurrentThread(s_vm, &env, NULL); - if (!error&&(*env)->ExceptionCheck(env)) return NULL; + /* static `env` does NOT work! Once in a while we should ponder if + it still does not work or why. + + if(env) { + if((*env)->ExceptionCheck(env)) (*env)->ExceptionClear(env); + return env; + } + */ + if(s_vm) error=(*s_vm)->AttachCurrentThread(s_vm, &env, NULL); + //if(!error&&(*env)->ExceptionCheck(env)) return NULL; + if(!error) error = JNI_forward_exception_to_gambit(env); return (error?NULL:env); } +int JNI_forward_exception_to_gambit(JNIEnv*env) { + // TBD: actually forward, not only clear! + if((*env)->ExceptionCheck(env)) { + (*env)->ExceptionClear(env); + return 1; + } + return 0; +} + // url launcher ffi void android_launch_url(char* urlstring){ JNIEnv *env = GetJNIEnv(); - jstring jurlstring = (*env)->NewStringUTF(env,urlstring); if (env&&globalObj) { + jstring jurlstring = (*env)->NewStringUTF(env, urlstring); jclass cls = (*env)->FindClass(env, "@SYS_PACKAGE_SLASH@/@SYS_APPNAME@"); - jmethodID method = (*env)->GetMethodID(env, cls, "openURL", "(Ljava/lang/String;)V"); - (*env)->CallVoidMethod(env, globalObj, method, jurlstring); + jmethodID method = cls ? (*env)->GetMethodID(env, cls, "openURL", "(Ljava/lang/String;)V") : NULL; + if(method) (*env)->CallVoidMethod(env, globalObj, method, jurlstring); + JNI_forward_exception_to_gambit(env); } } diff --git a/loaders/android/bootstrap.java.in b/loaders/android/bootstrap.java.in index dd99563d..d96ac4e1 100644 --- a/loaders/android/bootstrap.java.in +++ b/loaders/android/bootstrap.java.in @@ -126,20 +126,42 @@ public class @SYS_APPNAME@ extends Activity implements @ANDROID_JAVA_IMPLEMENTS@ } } + private android.view.View current_ContentView = null; + @Override + public void setContentView(android.view.View view) { + if(current_ContentView != view) { + // Note: this is a bit brain deas as it ONLY handles GLSurfaceView + if(current_ContentView instanceof android.opengl.GLSurfaceView) { + ((android.opengl.GLSurfaceView)current_ContentView).onPause(); + } + android.view.ViewParent parent0 = view.getParent(); + if(parent0 instanceof android.view.ViewGroup) { + android.view.ViewGroup parent = (android.view.ViewGroup) parent0; + if(parent!=null) { parent.removeView(current_ContentView); } + } + current_ContentView = view; + super.setContentView(current_ContentView); + if(current_ContentView instanceof android.opengl.GLSurfaceView) { + ((android.opengl.GLSurfaceView)current_ContentView).onResume(); + } + } + } + @Override protected void onCreate(Bundle savedInstanceState) { + current_ContentView = null; super.onCreate(savedInstanceState); Thread.setDefaultUncaughtExceptionHandler( new Thread.UncaughtExceptionHandler() { public void uncaughtException(Thread t, Throwable e) { final String TAG = "@SYS_PACKAGE_DOT@"; - Log.e(TAG, e.toString()); + Log.e(TAG, e.toString()); try { Thread.sleep(1000); } catch (Exception ex) { } System.exit(1); } }); setRequestedOrientation(ActivityInfo.SCREEN_ORIENTATION_PORTRAIT); - this.requestWindowFeature(Window.FEATURE_NO_TITLE); + this.requestWindowFeature(Window.FEATURE_NO_TITLE); // make sure volume controls control media this.setVolumeControlStream(AudioManager.STREAM_MUSIC); getWindow().setFlags(WindowManager.LayoutParams.FLAG_FULLSCREEN, @@ -147,7 +169,7 @@ public class @SYS_APPNAME@ extends Activity implements @ANDROID_JAVA_IMPLEMENTS@ // prevent sleep getWindow().addFlags(WindowManager.LayoutParams.FLAG_KEEP_SCREEN_ON); mGLView = new xGLSurfaceView(this); - setContentView(mGLView); + // NOTE: we MAY better move the following lines BELOW nativeInstanceInit mSensorManager = (SensorManager)getSystemService(Context.SENSOR_SERVICE); checkOrRequestPermission(android.Manifest.permission.WRITE_EXTERNAL_STORAGE); @@ -155,13 +177,14 @@ public class @SYS_APPNAME@ extends Activity implements @ANDROID_JAVA_IMPLEMENTS@ // Additions needed by modules, e.g. gps @ANDROID_JAVA_ONCREATE@ - // start EVENT_IDLE + nativeInstanceInit(getApplicationContext().getPackageCodePath().toString(), getFilesDir().toString()); + // start EVENT_IDLE + setContentView(mGLView); // MUST NOT run before nativeInstanceInit completed if(idle_tmScheduleRate > 0) idle_tm.scheduleAtFixedRate(idle_task, 0, idle_tmScheduleRate); - - nativeInstanceInit(); } - @Override + @Override protected void onDestroy() { + setContentView(mGLView); @ANDROID_JAVA_ONDESTROY@ nativeEvent(14,0,0); // EVENT_CLOSE nativeEvent(127,0,0); // EVENT_TERMINATE @@ -173,19 +196,19 @@ public class @SYS_APPNAME@ extends Activity implements @ANDROID_JAVA_IMPLEMENTS@ } @Override protected void onPause() { - super.onPause(); // Additions needed by modules, e.g. gps @ANDROID_JAVA_ONPAUSE@ - if (!isFinishing()) { + if (!isFinishing() && current_ContentView==mGLView) { mGLView.onPause(); } + super.onPause(); } @Override protected void onResume() { super.onResume(); + if(current_ContentView==mGLView) { mGLView.onResume(); } // Additions needed by modules, e.g. gps @ANDROID_JAVA_ONRESUME@ - mGLView.onResume(); } @Override public void onAccuracyChanged(Sensor sensor, int accuracy) { @@ -220,13 +243,13 @@ public class @SYS_APPNAME@ extends Activity implements @ANDROID_JAVA_IMPLEMENTS@ } } - native void nativeInstanceInit(); + native void nativeInstanceInit(String packageCodePath, String filesDir); } class xGLSurfaceView extends GLSurfaceView { public xGLSurfaceView(Context context) { super(context); - setFocusable(true); + setFocusable(true); setFocusableInTouchMode(true); renderer = new myRenderer(); setRenderer(renderer); @@ -241,23 +264,23 @@ class xGLSurfaceView extends GLSurfaceView { case MotionEvent.ACTION_UP: t=4; break; case MotionEvent.ACTION_POINTER_UP: t=4; break; } - if (t>0) { + if (t>0) { final int n=event.getPointerCount(); final int t0=t; final int id0=event.getPointerId(0); final int x0=(int)event.getX(0); final int y0=(int)event.getY(0); if (n>1) { // MultiTouch - queueEvent(new Runnable(){ public void run() { renderer.pointerEvent(18,id0,0); }}); + queueEvent(new Runnable(){ public void run() { renderer.pointerEvent(18,id0,0); }}); } - queueEvent(new Runnable(){ public void run() { renderer.pointerEvent(t0,x0,y0); }}); + queueEvent(new Runnable(){ public void run() { renderer.pointerEvent(t0,x0,y0); }}); if (n>1) { // MultiTouch final int id1=event.getPointerId(1); final int x1=(int)event.getX(1); final int y1=(int)event.getY(1); - queueEvent(new Runnable(){ public void run() { renderer.pointerEvent(18,id1,0); }}); - queueEvent(new Runnable(){ public void run() { renderer.pointerEvent(t0,x1,y1); }}); - } + queueEvent(new Runnable(){ public void run() { renderer.pointerEvent(18,id1,0); }}); + queueEvent(new Runnable(){ public void run() { renderer.pointerEvent(t0,x1,y1); }}); + } } return true; } @@ -295,7 +318,7 @@ class xGLSurfaceView extends GLSurfaceView { } if (t>0) { queueEvent(new Runnable(){ public void run() { - renderer.nativeEvent(t,x,y); }}); + renderer.nativeEvent(t,x,y); }}); } return true; } @@ -311,15 +334,15 @@ class xGLSurfaceView extends GLSurfaceView { myRenderer renderer; } class myRenderer implements GLSurfaceView.Renderer { - public void onSurfaceCreated(GL10 gl, EGLConfig config) { + public void onSurfaceCreated(GL10 gl, EGLConfig config) { } public void onSurfaceChanged(GL10 gl, int w, int h) { gl.glViewport(0, 0, w, h); width=(float)w; height=(float)h; nativeEvent(127,w,h); // EVENT_INIT } - public void onDrawFrame(GL10 gl) { - nativeEvent(15,0,0); // EVENT_REDRAW + public void onDrawFrame(GL10 gl) { + nativeEvent(15,0,0); // EVENT_REDRAW } public void pointerEvent(int t, int x, int y) { nativeEvent(t,x,(int)height-y); } public float width,height; diff --git a/modules/config/config.scm b/modules/config/config.scm index 6880f1da..044232f1 100644 --- a/modules/config/config.scm +++ b/modules/config/config.scm @@ -94,4 +94,18 @@ end-of-c-declare (gambit-c (if (string=? (system-platform) "android") (##heartbeat-interval-set! -1.))) (else (if (string=? (system-platform) "android") (##set-heartbeat-interval! -1.)))) +(cond-expand + (android + (c-declare #< Date: Mon, 2 Nov 2020 12:00:15 +0100 Subject: [PATCH 02/26] LNjSCHEME: new module lnjscheme - call any Androi API without JNI Any not-so-time-critical Android API/Java Method - except those restricted Android itself may be called without adding JNI code. --- .gitignore | 3 +- LNCONFIG.h.in | 1 + modules/eventloop/eventloop.scm | 5 +- modules/lnjscheme/ANDROID_c_additions | 71 ++ .../lnjscheme/ANDROID_java_activityadditions | 160 ++++ modules/lnjscheme/ANDROID_java_additions | 16 + modules/lnjscheme/ANDROID_java_oncreate | 126 ++++ modules/lnjscheme/LNjScheme/Closure.java | 28 + modules/lnjscheme/LNjScheme/Continuation.java | 17 + modules/lnjscheme/LNjScheme/Environment.java | 99 +++ modules/lnjscheme/LNjScheme/InputPort.java | 210 ++++++ modules/lnjscheme/LNjScheme/JavaMethod.java | 251 ++++++ modules/lnjscheme/LNjScheme/Macro.java | 33 + modules/lnjscheme/LNjScheme/Pair.java | 64 ++ modules/lnjscheme/LNjScheme/Primitive.java | 714 ++++++++++++++++++ modules/lnjscheme/LNjScheme/Procedure.java | 20 + modules/lnjscheme/LNjScheme/Scheme.java | 150 ++++ .../lnjscheme/LNjScheme/SchemePrimitives.java | 158 ++++ modules/lnjscheme/LNjScheme/SchemeUtils.java | 314 ++++++++ modules/lnjscheme/LNjScheme/primitives.scm | 146 ++++ modules/lnjscheme/MODULES | 1 + modules/lnjscheme/Makefile | 8 + modules/lnjscheme/README.md | 69 ++ modules/lnjscheme/lnjscheme.scm | 117 +++ 24 files changed, 2779 insertions(+), 2 deletions(-) create mode 100644 modules/lnjscheme/ANDROID_c_additions create mode 100644 modules/lnjscheme/ANDROID_java_activityadditions create mode 100644 modules/lnjscheme/ANDROID_java_additions create mode 100644 modules/lnjscheme/ANDROID_java_oncreate create mode 100644 modules/lnjscheme/LNjScheme/Closure.java create mode 100644 modules/lnjscheme/LNjScheme/Continuation.java create mode 100644 modules/lnjscheme/LNjScheme/Environment.java create mode 100644 modules/lnjscheme/LNjScheme/InputPort.java create mode 100644 modules/lnjscheme/LNjScheme/JavaMethod.java create mode 100644 modules/lnjscheme/LNjScheme/Macro.java create mode 100644 modules/lnjscheme/LNjScheme/Pair.java create mode 100644 modules/lnjscheme/LNjScheme/Primitive.java create mode 100644 modules/lnjscheme/LNjScheme/Procedure.java create mode 100644 modules/lnjscheme/LNjScheme/Scheme.java create mode 100644 modules/lnjscheme/LNjScheme/SchemePrimitives.java create mode 100644 modules/lnjscheme/LNjScheme/SchemeUtils.java create mode 100644 modules/lnjscheme/LNjScheme/primitives.scm create mode 100644 modules/lnjscheme/MODULES create mode 100644 modules/lnjscheme/Makefile create mode 100644 modules/lnjscheme/README.md create mode 100644 modules/lnjscheme/lnjscheme.scm diff --git a/.gitignore b/.gitignore index 7d8dce2b..2465be5c 100644 --- a/.gitignore +++ b/.gitignore @@ -7,11 +7,12 @@ Thumbs.db tmp.* *.core *.o +*.class +*.jar *.o2 *.a *.old* *.bak* -*.org* *.orig* xx_* SETUP diff --git a/LNCONFIG.h.in b/LNCONFIG.h.in index f853b537..0ca7c34e 100644 --- a/LNCONFIG.h.in +++ b/LNCONFIG.h.in @@ -64,6 +64,7 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define EVENT_DEBUG 64 +#define EVENT_JSCM_RESULT 126 #define EVENT_INIT 127 #define EVENT_TERMINATE 128 diff --git a/modules/eventloop/eventloop.scm b/modules/eventloop/eventloop.scm index ae7f28cf..bd3c9bbf 100644 --- a/modules/eventloop/eventloop.scm +++ b/modules/eventloop/eventloop.scm @@ -75,6 +75,7 @@ end-of-c-declare (define EVENT_BUTTON3DOWN ((c-lambda () int "___result = EVENT_BUTTON3DOWN;"))) (define EVENT_CLOSE ((c-lambda () int "___result = EVENT_CLOSE;"))) (define EVENT_REDRAW ((c-lambda () int "___result = EVENT_REDRAW;"))) +(define EVENT_JSCM_RESULT ((c-lambda () int "___result = EVENT_JSCM_RESULT;"))) (define EVENT_INIT ((c-lambda () int "___result = EVENT_INIT;"))) (define EVENT_TERMINATE ((c-lambda () int "___result = EVENT_TERMINATE;"))) (define EVENT_BATTERY ((c-lambda () int "___result = EVENT_BATTERY;"))) @@ -179,7 +180,9 @@ end-of-c-declare ;; handle potential scaling (running stretched on a device) (hook:event t (if app:scale? (fix (* app:xscale x)) x) (if app:scale? (fix (* app:yscale y)) y)) - ) + ) + ((fx= t EVENT_JSCM_RESULT) + (if (function-exists? LNjScheme-result) (LNjScheme-result))) ((fx= t EVENT_INIT) ;; prevent multiple inits (if app:mustinit (begin diff --git a/modules/lnjscheme/ANDROID_c_additions b/modules/lnjscheme/ANDROID_c_additions new file mode 100644 index 00000000..b846a90f --- /dev/null +++ b/modules/lnjscheme/ANDROID_c_additions @@ -0,0 +1,71 @@ +/* -*-C-*- */ + +const char* android_app_class() { return "@SYS_PACKAGE_DOT@.@SYS_APPNAME@"; } // for jscheme + +/* lnjscheme_eval + * + * Evaluate input and return result. Due to Android limitations + * wrt. thread and evaluation context, calls might fail. E.g., Views + * may only be changed by the Java thread which created them. Use the + * asynchronous version in those cases. + */ +const char* lnjscheme_eval(const char* input) +{ + static const char *str = NULL; + static jstring jstr = NULL; + JNIEnv *env = GetJNIEnv(); + if (env&&globalObj){ + jstring jin = (*env)->NewStringUTF(env,input); + jclass main_class = (*env)->FindClass(env, "@SYS_PACKAGE_SLASH@/@SYS_APPNAME@"); + jmethodID method = main_class ? (*env)->GetMethodID(env, main_class, "LNjSchemeCall", "(Ljava/lang/String;)Ljava/lang/String;") : NULL; + if(!method && JNI_forward_exception_to_gambit(env)) { + return "E \"JNI: method LNjSchemeCall not found\""; + } + if(jstr) { (*env)->ReleaseStringUTFChars(env, jstr, str); jstr = NULL; } // works? + jstr = (jstring) method ? (*env)->CallObjectMethod(env, globalObj, method, jin) : NULL; + // Is this required??? (*env)->ReleaseStringUTFChars(env, jin, NULL); + str = jstr ? (*env)->GetStringUTFChars(env, jstr, 0) : NULL; + // (*env)->ReleaseStringUTFChars(env, jstr, NULL); // we do it upon next call + } + return str; +} + +void lnjscheme_eval_send(const char* input) +{ + JNIEnv *env = GetJNIEnv(); + if (env&&globalObj){ + jclass main_class = (*env)->FindClass(env, "@SYS_PACKAGE_SLASH@/@SYS_APPNAME@"); + jmethodID method = main_class ? (*env)->GetMethodID(env, main_class, "LNjSchemeSend", "(Ljava/lang/String;)V") : NULL; + if(!method && JNI_forward_exception_to_gambit(env)) { + return; // "E \"JNI: method LNjSchemeSend not found\""; + } else { + jstring jin = (*env)->NewStringUTF(env,input); + (*env)->CallVoidMethod(env, globalObj, method, jin); + (*env)->ReleaseStringUTFChars(env, jin, NULL); + JNI_forward_exception_to_gambit(env); + } + } +} + +// There is likely a way to do this better using only a Java->C call +// to deposit the result in a global variable. I just don't know yet +// how to do this. +const char* lnjscheme_eval_receive_result() +{ + static const char *str = NULL; + static jstring jstr = NULL; + JNIEnv *env = GetJNIEnv(); + if (env&&globalObj){ + if(jstr) { (*env)->ReleaseStringUTFChars(env, jstr, str); jstr = NULL; } // works? + jclass main_class = (*env)->FindClass(env, "@SYS_PACKAGE_SLASH@/@SYS_APPNAME@"); + jmethodID method = main_class ? (*env)->GetMethodID(env, main_class, "LNjSchemeResult", "()Ljava/lang/String;") : NULL; + if(!method && JNI_forward_exception_to_gambit(env)) { + return "E \"JNI: method LNjSchemeResult not found\""; + } else { + jstr = (jstring) method ? (*env)->CallObjectMethod(env, globalObj, method) : NULL; + str = jstr ? (*env)->GetStringUTFChars(env, jstr, 0) : NULL; + // (*env)->ReleaseStringUTFChars(env, jstr, NULL); // we do it upon next call + } + } + return str; +} diff --git a/modules/lnjscheme/ANDROID_java_activityadditions b/modules/lnjscheme/ANDROID_java_activityadditions new file mode 100644 index 00000000..d8a64863 --- /dev/null +++ b/modules/lnjscheme/ANDROID_java_activityadditions @@ -0,0 +1,160 @@ +/* LNjScheme -*- mode: java; c-basic-offset: 2; -*- */ + +/* # Helper methods */ + +java.text.SimpleDateFormat ln_log_date_formatter = new java.text.SimpleDateFormat("yyyy-MM-dd HH:mm:ss "); + +String TAG = "@SYS_APPNAME@"; + +public void ln_log(String msg) { + String m = ln_log_date_formatter.format(new java.util.Date()) + msg; + System.err.println(TAG + ": " + m); + Log.d(TAG, m); +} + +private Object onBackPressedHandler = null; + +@Override +public void onBackPressed() { + if(onBackPressedHandler!=null) { + LNjSchemeEvaluate(LNjScheme.Scheme.list(onBackPressedHandler)); + } + else { super.onBackPressed(); } +} + + +/* LNjScheme_Set_OnClickListener: register a LNjScheme lambda to be called when the View is clicked. + * + * LNjScheme can not (yet) declare annonymous derived classes. (Or at + * least I don't know how that could be done.) + * + * For the time being we get along with a little Java. + */ +private android.view.View.OnClickListener LNjScheme_OnClickListener(final Object proc) { + return new android.view.View.OnClickListener() { + public void onClick(android.view.View v) { + LNjSchemeEvaluate(new LNjScheme.Pair(proc, new LNjScheme.Pair(v, null))); + } + }; +} +public void LNjScheme_Set_OnClickListener(android.view.View v, Object expr) { + v.setOnClickListener(LNjScheme_OnClickListener(expr)); +} + +/* # LNjScheme core */ + +private static LNjScheme.Scheme LNjSchemeSession = null; + +private Object LNjSchemeEvaluateNoSync(Object expr) { + // NOT synchronized, be careful where to use it! + if(LNjSchemeSession != null) { + return LNjSchemeSession.eval(expr); + } else return null; +} + +public Object LNjSchemeEvaluate(Object expr) { + // sync with the one and only evaluator supported so far. + if(LNjSchemeSession != null) { + synchronized(LNjSchemeSession) { + return LNjSchemeSession.eval(expr); + } + } else return null; +} + +/* jschemeCall: evaluate `msg` in any Java thread and return result + * + * FIXME TBD CHECK: This was the initial implementation, but might be broken now. + */ +public String LNjSchemeCall(String msg) { + // BEWARE: Operations not safe to be called asynchronously from + // any thread, not safe to be called from various contexts (e.g., + // within "onDrawFrame" which amounts to "while reacting to + // EVENT_REDRAW"), etc. MAY HANG here. + // + // If you need fast execution and know the call is safe use this + // one. Otherwise use the two-phased version using + // `LNjSchemeSend` followed by a `LNjSchemeResult to dispatch the + // evaluation to `runOnUiThread` and wait for it to be eventually + // evaluated in a more-or-less safe context. + try { + LNjScheme.InputPort in = new LNjScheme.InputPort(new java.io.ByteArrayInputStream(msg.getBytes(java.nio.charset.Charset.forName("UTF-8")))); + Object expr = in.read(); + if(in.isEOF(expr)) return "E\n\"invalid input\""; + Object result = LNjSchemeEvaluate(expr); + java.io.StringWriter buf = new java.io.StringWriter(); + java.io.PrintWriter port = new java.io.PrintWriter(buf); + port.println("D"); + LNjScheme.SchemeUtils.write(result, port, true); + return buf.toString(); + } catch (Exception e) { + java.io.StringWriter buf = new java.io.StringWriter(); + java.io.PrintWriter port = new java.io.PrintWriter(buf); + port.println("E"); + LNjScheme.SchemeUtils.write(("" + e).toCharArray(), port, true); + return buf.toString(); + } +} + +/* LNjSchemeSend: send string for evaluation to Java app main thread. + * + * LNjSchemeResult: receive evaluation result from Java app main thread. + */ + +private java.util.concurrent.FutureTask LNjSchemeJob = null; + +public void LNjSchemeSend(String msg) { + final LNjScheme.InputPort in = new LNjScheme.InputPort(new java.io.ByteArrayInputStream(msg.getBytes(java.nio.charset.Charset.forName("UTF-8")))); + final Object expr = in.read(); + // Object result = LNjSchemeEvaluate(expr); + java.util.concurrent.FutureTask job = new java.util.concurrent.FutureTask + (new java.util.concurrent.Callable() { + @Override + public Object call() throws Exception { + // ln_log("invocation of " + this + " evaluating."); + if(in.isEOF(expr)) throw new Exception("invalid input"); + return LNjSchemeEvaluate(expr); } + }); + // ln_log("Sending to UI: " + job + " for: " + expr); + LNjSchemeJob = job; + new Thread() { + @Override + public void run() { + // ln_log("LNjScheme waiting for completion"); + try { + LNjSchemeJob.get(); + } catch (Exception e) { // InterruptedException java.util.concurrent.ExecutionException + // FIXME: Do something sensible here! + } + // ln_log("LNjScheme notifying result"); + nativeEvent(126,0,0); + } + }.start(); + runOnUiThread(job); +} + +public String LNjSchemeResult() { + try { + Object result = LNjSchemeJob != null ? LNjSchemeJob.get() : null; + LNjSchemeJob = null; + // ln_log("got result from UI"); + java.io.StringWriter buf = new java.io.StringWriter(); + java.io.PrintWriter port = new java.io.PrintWriter(buf); + port.println("D"); + LNjScheme.SchemeUtils.write(result, port, true); + return buf.toString(); + } catch (java.util.concurrent.ExecutionException e) { + // ln_log("got error from call"); + java.io.StringWriter buf = new java.io.StringWriter(); + java.io.PrintWriter port = new java.io.PrintWriter(buf); + port.println("E"); + LNjScheme.SchemeUtils.write(("" + e.getCause()).toCharArray(), port, true); + return buf.toString(); + } catch (Exception e) { + // ln_log("got exception from call"); + java.io.StringWriter buf = new java.io.StringWriter(); + java.io.PrintWriter port = new java.io.PrintWriter(buf); + port.println("E"); + LNjScheme.SchemeUtils.write(("LNjScheme unexpected exception: " + e).toCharArray(), port, true); + return buf.toString(); + } +} diff --git a/modules/lnjscheme/ANDROID_java_additions b/modules/lnjscheme/ANDROID_java_additions new file mode 100644 index 00000000..5dbaa8b7 --- /dev/null +++ b/modules/lnjscheme/ANDROID_java_additions @@ -0,0 +1,16 @@ +/*-*-java -*-*/ +class LNMethod extends LNjScheme.Procedure { + + String name = null; + + /** Make a method from an exported wrapper, body, and environment. **/ + public LNMethod (String sym) { + name = sym; + } + + + /** Apply to a list of arguments. **/ + public Object apply(LNjScheme.Scheme interpreter, Object args) { + return null; // return interpreter.eval(body, new Environment(parms, args, env)); + } +} diff --git a/modules/lnjscheme/ANDROID_java_oncreate b/modules/lnjscheme/ANDROID_java_oncreate new file mode 100644 index 00000000..ce901cb4 --- /dev/null +++ b/modules/lnjscheme/ANDROID_java_oncreate @@ -0,0 +1,126 @@ +/* LNjScheme -*- mode: java; c-basic-offset: 2; -*- */ + +LNjSchemeSession = new LNjScheme.Scheme + (new String[0]) + { + String TAG = "calculator"; + + public void ln_log(String msg) { + String m = ln_log_date_formatter.format(new java.util.Date()) + msg; + System.err.println(TAG + ": " + m); + Log.d(TAG, m); + } + }; + +LNjSchemeEvaluateNoSync + (LNjScheme.Scheme.cons + (LNjScheme.Scheme.sym("define"), + LNjScheme.Scheme.list + (LNjScheme.Scheme.sym("ln-this"), + this + ))); + +LNjSchemeEvaluateNoSync + (LNjScheme.Scheme.cons + (LNjScheme.Scheme.sym("define"), + LNjScheme.Scheme.list + (LNjScheme.Scheme.sym("ln-mglview"), + mGLView + ))); + +LNjSchemeEvaluateNoSync + (LNjScheme.Scheme.cons + (LNjScheme.Scheme.sym("define"), + LNjScheme.Scheme.list + (LNjScheme.Scheme.sym("log-message"), + new LNMethod("log-message") { + public Object apply(LNjScheme.Scheme interpreter, Object args) { + String str = null; + if(args instanceof LNjScheme.Pair) { + Object a1 = null; + a1 = LNjScheme.Scheme.first(args); + if(a1 instanceof String) { str = (String)a1; } + else if(a1 instanceof char[]) { str = new String((char[])a1); } + else { str = "log-message: message not convertible"; } + } else { + str = "log-message: args not a list"; + } + ln_log(str); + return null; + }} + ))); + +LNjSchemeEvaluateNoSync + (LNjScheme.Scheme.cons + (LNjScheme.Scheme.sym("define"), + LNjScheme.Scheme.list + (LNjScheme.Scheme.sym("bound?"), + new LNMethod("bound?") { + public Object apply(LNjScheme.Scheme interpreter, Object args) { + if(args instanceof LNjScheme.Pair) { + Object a1 = null; + a1 = LNjScheme.Scheme.first(args); + if(a1 instanceof String) { + String sym = (String)a1; + try { + Object val = interpreter.eval(sym); + return true; + } catch (RuntimeException e) { return false; } + } else { + return LNjScheme.Scheme.error("bound? : not a symbol " + a1); + } + } else { + return LNjScheme.Scheme.error("bound? : missing argument"); + } + }} + ))); + +LNjSchemeEvaluateNoSync + (LNjScheme.Scheme.cons + (LNjScheme.Scheme.sym("define"), + LNjScheme.Scheme.list + (LNjScheme.Scheme.sym("send-event!"), + new LNMethod("send-event!") { + public Object apply(LNjScheme.Scheme interpreter, Object args) { + String str = null; + if(args instanceof LNjScheme.Pair) { + Object a1 = null, a2 = null, a3 = null;; + a1 = LNjScheme.Scheme.first(args); + a2 = LNjScheme.Scheme.rest(args); + a3 = LNjScheme.Scheme.rest(a2); + a2 = LNjScheme.Scheme.first(a2); + a3 = LNjScheme.Scheme.first(a3); + // Maybe we should accept symbolic event names too? + int ia1 = (a1 instanceof Number) ? (int)LNjScheme.Scheme.num(a1) : 21; + int ia2 = (a2 instanceof Number) ? (int)LNjScheme.Scheme.num(a2) : 0; + int ia3 = (a3 instanceof Number) ? (int)LNjScheme.Scheme.num(a3) : 0; + nativeEvent(ia1, ia2, ia3); + return LNjScheme.Scheme.TRUE; + } else { + nativeEvent(64, 0, 0); // debug + return LNjScheme.Scheme.TRUE; + } + }} + ))); + +LNjSchemeEvaluateNoSync + (LNjScheme.Scheme.cons + (LNjScheme.Scheme.sym("define"), + LNjScheme.Scheme.list + (LNjScheme.Scheme.sym("on-back-pressed"), + new LNMethod("on-back-pressed") { + public Object apply(LNjScheme.Scheme interpreter, Object args) { + String str = null; + if(args instanceof LNjScheme.Pair) { + Object a1 = null; + a1 = LNjScheme.Scheme.first(args); + if(a1 instanceof LNjScheme.Procedure) { onBackPressedHandler = (LNjScheme.Procedure)a1; } + else if(!LNjScheme.Scheme.truth(a1)) { onBackPressedHandler = null; } + else { LNjScheme.Scheme.error("on-back-pressed: argument not a procedure or #f"); } + return LNjScheme.Scheme.TRUE; + } else { + if(onBackPressedHandler==null) { return LNjScheme.Scheme.FALSE; } + else { return onBackPressedHandler; } + } + }} + ))); diff --git a/modules/lnjscheme/LNjScheme/Closure.java b/modules/lnjscheme/LNjScheme/Closure.java new file mode 100644 index 00000000..eb99ffab --- /dev/null +++ b/modules/lnjscheme/LNjScheme/Closure.java @@ -0,0 +1,28 @@ +package LNjScheme; + +/** A closure is a user-defined procedure. It is "closed" over the + * environment in which it was created. To apply the procedure, bind + * the parameters to the passed in variables, and evaluate the body. + * @author Peter Norvig, peter@norvig.com http://www.norvig.com + * Copyright 1998 Peter Norvig, see http://www.norvig.com/license.html **/ + +public class Closure extends Procedure { + + Object parms; + Object body; + Environment env; + + /** Make a closure from a parameter list, body, and environment. **/ + public Closure (Object parms, Object body, Environment env) { + this.parms = parms; + this.env = env; + this.body = (body instanceof Pair && rest(body) == null) + ? first(body) + : cons("begin", body); + } + + /** Apply a closure to a list of arguments. **/ + public Object apply(Scheme interpreter, Object args) { + return interpreter.eval(body, new Environment(parms, args, env)); + } +} diff --git a/modules/lnjscheme/LNjScheme/Continuation.java b/modules/lnjscheme/LNjScheme/Continuation.java new file mode 100644 index 00000000..2705c557 --- /dev/null +++ b/modules/lnjscheme/LNjScheme/Continuation.java @@ -0,0 +1,17 @@ +package LNjScheme; + +/** @author Peter Norvig, peter@norvig.com http://www.norvig.com + * Copyright 1998 Peter Norvig, see http://www.norvig.com/license.html */ + +public class Continuation extends Procedure { + + RuntimeException cc = null; + public Object value = null; + + public Continuation(RuntimeException cc) { this.cc = cc; } + + public Object apply(Scheme interpreter, Object args) { + value = first(args); + throw cc; + } +} diff --git a/modules/lnjscheme/LNjScheme/Environment.java b/modules/lnjscheme/LNjScheme/Environment.java new file mode 100644 index 00000000..4d78c227 --- /dev/null +++ b/modules/lnjscheme/LNjScheme/Environment.java @@ -0,0 +1,99 @@ +package LNjScheme; + +/** Environments allow you to look up the value of a variable, given + * its name. Keep a list of variables and values, and a pointer to + * the parent environment. If a variable list ends in a symbol rather + * than null, it means that symbol is bound to the remainder of the + * values list. + * @author Peter Norvig, peter@norvig.com http://www.norvig.com + * Copyright 1998 Peter Norvig, see http://www.norvig.com/license.html */ + +public class Environment extends SchemeUtils { + public Object vars; + public Object vals; + public Environment parent; + + /** A constructor to extend an environment with var/val pairs. */ + public Environment(Object vars, Object vals, Environment parent) { + this.vars = vars; + this.vals = vals; + this.parent = parent; + if (!numberArgsOK(vars, vals)) + warn("wrong number of arguments: expected " + vars + + " got " + vals); + } + + /** Construct an empty environment: no bindings. **/ + public Environment() {} + + /** Find the value of a symbol, in this environment or a parent. */ + public Object lookup (String symbol) { + Object varList = vars, valList = vals; + // See if the symbol is bound locally + while (varList != null) { + if (first(varList) == symbol) { + return first(valList); + } else if (varList == symbol) { + return valList; + } else { + varList = rest(varList); + valList = rest(valList); + } + } + // If not, try to look for the parent + if (parent != null) return parent.lookup(symbol); + else return error("Unbound variable: " + symbol); + } + + /** Add a new variable,value pair to this environment. */ + public Object define(Object var, Object val) { + vars = cons(var, vars); + vals = cons(val, vals); + if (val instanceof Procedure + && ((Procedure)val).name.equals("anonymous procedure")) + ((Procedure)val).name = var.toString(); + return var; + } + + /** Set the value of an existing variable **/ + public Object set(Object var, Object val) { + if (!(var instanceof String)) + return error("Attempt to set a non-symbol: " + + stringify(var));; + String symbol = (String) var; + Object varList = vars, valList = vals; + // See if the symbol is bound locally + while (varList != null) { + if (first(varList) == symbol) { + return setFirst(valList, val); + } else if (rest(varList) == symbol) { + return setRest(valList, val); + } else { + varList = rest(varList); + valList = rest(valList); + } + } + // If not, try to look for the parent + if (parent != null) return parent.set(symbol, val); + else return error("Unbound variable: " + symbol); + } + + public Environment defPrim(String name, int id, int minArgs) { + define(name, new Primitive(id, minArgs, minArgs)); + return this; + } + + public Environment defPrim(String name, int id, int minArgs, int maxArgs) { + define(name, new Primitive(id, minArgs, maxArgs)); + return this; + } + + /** See if there is an appropriate number of vals for these vars. **/ + boolean numberArgsOK(Object vars, Object vals) { + return ((vars == null && vals == null) + || (vars instanceof String) + || (vars instanceof Pair && vals instanceof Pair + && numberArgsOK(((Pair)vars).rest, ((Pair)vals).rest))); + } + +} diff --git a/modules/lnjscheme/LNjScheme/InputPort.java b/modules/lnjscheme/LNjScheme/InputPort.java new file mode 100644 index 00000000..1b4c4a8d --- /dev/null +++ b/modules/lnjscheme/LNjScheme/InputPort.java @@ -0,0 +1,210 @@ +package LNjScheme; +import java.io.*; + +/** InputPort is to Scheme as InputStream is to Java. + * @author Peter Norvig, peter@norvig.com http://www.norvig.com + * Copyright 1998 Peter Norvig, see http://www.norvig.com/license.html **/ + +public class InputPort extends SchemeUtils { + + static String EOF = "#!EOF"; + boolean isPushedToken = false; + boolean isPushedChar = false; + Object pushedToken = null; + int pushedChar = -1; + Reader in; + StringBuffer buff = new StringBuffer(); + + /** Construct an InputPort from an InputStream. **/ + public InputPort(InputStream in) { this.in = new InputStreamReader(in);} + + /** Construct an InputPort from a Reader. **/ + public InputPort(Reader in) { this.in = in;} + + /** Read and return a Scheme character or EOF. **/ + public Object readChar() { + try { + if (isPushedChar) { + isPushedChar = false; + if (pushedChar == -1) return EOF; else return chr((char)pushedChar); + } else { + int ch = in.read(); + if (ch == -1) return EOF; else return chr((char)ch); + } + } catch (IOException e) { + warn("On input, exception: " + e); + return EOF; + } + } + + /** Peek at and return the next Scheme character (or EOF). + * However, don't consume the character. **/ + public Object peekChar() { + int p = peekCh(); + if (p == -1) return EOF; else return chr((char)p); + } + + /** Push a character back to be re-used later. **/ + int pushChar(int ch) { + isPushedChar = true; + return pushedChar = ch; + } + + /** Pop off the previously pushed character. **/ + int popChar() { + isPushedChar = false; + return pushedChar; + } + + /** Peek at and return the next Scheme character as an int, -1 for EOF. + * However, don't consume the character. **/ + public int peekCh() { + try { return isPushedChar ? pushedChar : pushChar(in.read()); } + catch (IOException e) { + warn("On input, exception: " + e); + return -1; + } + } + + /** Read and return a Scheme expression, or EOF. **/ + public Object read() { + try { + Object token = nextToken(); + if (token == "(") + return readTail(false); + else if (token == ")") + { warn("Extra ) ignored."); return read(); } + else if (token == ".") + { warn("Extra . ignored."); return read(); } + else if (token == "'") + return list("quote", read()); + else if (token == "`") + return list("quasiquote", read()); + else if (token == ",") + return list("unquote", read()); + else if (token == ",@") + return list("unquote-splicing", read()); + else + return token; + } catch (IOException e) { + warn("On input, exception: " + e); + return EOF; + } + } + + /** Close the port. Return TRUE if ok. **/ + public Object close() { + try { this.in.close(); return TRUE; } + catch (IOException e) { return error("IOException: " + e); } + } + + /** Is the argument the EOF object? **/ + public static boolean isEOF(Object x) { return x == EOF; } + + Object readTail(boolean dotOK) throws IOException { + Object token = nextToken(); + if (token == EOF) + return error("EOF during read."); + else if (token == ")") + return null; + else if (token == ".") { + Object result = read(); + token = nextToken(); + if (token != ")") warn("Where's the ')'? Got " + + token + " after ."); + return result; + } else { + isPushedToken = true; + pushedToken = token; + return cons(read(), readTail(true)); + } + } + + Object nextToken() throws IOException { + int ch; + + // See if we should re-use a pushed char or token + if (isPushedToken) { + isPushedToken = false; + return pushedToken; + } else if (isPushedChar) { + ch = popChar(); + } else { + ch = in.read(); + } + + // Skip whitespace + while (Character.isWhitespace((char)ch)) ch = in.read(); + + // See what kind of non-white character we got + switch(ch) { + case -1: return EOF; + case '(' : return "("; + case ')': return ")"; + case '\'': return "'"; + case '`': return "`"; + case ',': + ch = in.read(); + if (ch == '@') return ",@"; + else { pushChar(ch); return ","; } + case ';': + // Comment: skip to end of line and then read next token + while(ch != -1 && ch != '\n' && ch != '\r') ch = in.read(); + return nextToken(); + case '"': + // Strings are represented as char[] + buff.setLength(0); + while ((ch = in.read()) != '"' && ch != -1) { + buff.append((char) ((ch == '\\') ? in.read() : ch)); + } + if (ch == -1) warn("EOF inside of a string."); + return buff.toString().toCharArray(); + case '#': + switch (ch = in.read()) { + case 't': case 'T': return TRUE; + case 'f': case 'F': return FALSE; + case '(': + pushChar('('); + return listToVector(read()); + case '\\': + ch = in.read(); + if (ch == 's' || ch == 'S' || ch == 'n' || ch == 'N') { + pushChar(ch); + Object token = nextToken(); + if (token == "space") return chr(' '); + else if (token == "newline") return chr('\n'); + else { + isPushedToken = true; + pushedToken = token; + return chr((char)ch); + } + } else { + return chr((char)ch); + } + case 'e': case 'i': case 'd': return nextToken(); + case 'b': case 'o': case 'x': + warn("#" + ((char)ch) + " not implemented, ignored."); + return nextToken(); + default: + warn("#" + ((char)ch) + " not recognized, ignored."); + return nextToken(); + } + default: + buff.setLength(0); + int c = ch; + do { + buff.append((char)ch); + ch = in.read(); + } while (!Character.isWhitespace((char)ch) && ch != -1 && + ch != '(' && ch != ')' && ch != '\'' && ch != ';' + && ch != '"' && ch != ',' && ch != '`'); + pushChar(ch); + // Try potential numbers, but catch any format errors. + if (c == '.' || c == '+' || c == '-' || (c >= '0' && c <= '9')) { + try { return new Double(buff.toString()); } + catch (NumberFormatException e) { ; } + } + return buff.toString().toLowerCase().intern(); + } + } +} diff --git a/modules/lnjscheme/LNjScheme/JavaMethod.java b/modules/lnjscheme/LNjScheme/JavaMethod.java new file mode 100644 index 00000000..e0644964 --- /dev/null +++ b/modules/lnjscheme/LNjScheme/JavaMethod.java @@ -0,0 +1,251 @@ +package LNjScheme; +import java.lang.reflect.*; + +/** @author Peter Norvig, peter@norvig.com http://www.norvig.com + * Copyright 1998 Peter Norvig, see http://www.norvig.com/license.html */ + +public class JavaMethod extends Procedure { + + Class[] argClasses; + Method method; + boolean isStatic; + + public JavaMethod(String methodName, Object targetClassName, + Object argClassNames) { + this.name = targetClassName + "." + methodName; + try { + argClasses = classArray(argClassNames); + method = toClass(targetClassName).getMethod(methodName, argClasses); + isStatic = Modifier.isStatic(method.getModifiers()); + } catch (ClassNotFoundException e) { + error("Bad class, can't get method " + name); + } catch (NoSuchMethodException e) { + error("Can't get method " + name); + } + + } + + private Object raiseJavaMethodError(String msg, Throwable e, Object args) { + return error(msg + " " + e + " on " + this + stringify(args) + ";"); + } + + /** Apply the method to a list of arguments. **/ + public Object apply(Scheme interpreter, Object args) { + try { + if (isStatic) return method.invoke(null, toArray(args)); + else return method.invoke(first(args), toArray(rest(args))); + } + catch (IllegalAccessException e) + { raiseJavaMethodError("Bad Java Method application:", e, args); } + catch (IllegalArgumentException e) + { raiseJavaMethodError("Bad Java Method application:", e, args); } + catch (InvocationTargetException e) { + Throwable e1 = e.getCause(); + raiseJavaMethodError("Bad Java Method application: " + method, e1, args); + } catch (NullPointerException e) + { raiseJavaMethodError("Bad Java Method application:", e, args); } + catch (Exception e) + { raiseJavaMethodError("Bad Java Method application:", e, args); } + return null; /* unreached */ + } + + public static Class toClass(Object arg) throws ClassNotFoundException { + if (arg instanceof Class) return (Class)arg; + arg = stringify(arg, false); + + if (arg.equals("void")) return java.lang.Void.TYPE; + else if (arg.equals("boolean")) return java.lang.Boolean.TYPE; + else if (arg.equals("char")) return java.lang.Character.TYPE; + else if (arg.equals("byte")) return java.lang.Byte.TYPE; + else if (arg.equals("short")) return java.lang.Short.TYPE; + else if (arg.equals("int")) return java.lang.Integer.TYPE; + else if (arg.equals("long")) return java.lang.Long.TYPE; + else if (arg.equals("float")) return java.lang.Float.TYPE; + else if (arg.equals("double")) return java.lang.Double.TYPE; + else return Class.forName((String)arg); + } + + /** Convert a list of Objects into an array. Peek at the argClasses + * array to see what's expected. That enables us to convert between + * Double and Integer, something Java won't do automatically. **/ + public Object[] toArray(Object args) { + int n = length(args); + int diff = n - argClasses.length; + if (diff != 0) + error(Math.abs(diff) + " too " + ((diff>0) ? "many" : "few") + + " args to " + name); + Object[] array = new Object[n]; + for(int i = 0; i < n && i < argClasses.length; i++) { + if (argClasses[i] == java.lang.Integer.TYPE) + array[i] = new Integer((int)num(first(args))); + else + array[i] = first(args); + args = rest(args); + } + return array; + } + + /** Convert a list of class names into an array of Classes. **/ + public static Class[] classArray(Object args) throws ClassNotFoundException { + int n = length(args); + Class[] array = new Class[n]; + for(int i = 0; i < n; i++) { + array[i] = toClass(first(args)); + args = rest(args); + } + return array; + } + + /*** Backported ***/ + /*** The following functionality is inspired and pratially stolen + * from the community version, which extented the original + * jscheme. I'd rather strip down jscheme for use as embedded + * language (e.g., this use case does often not need quasiquote + * and macro expansion) than use and digest the bloat of a jscheme + * 7.2 or alike. + * + * However: I need constructors with arguments. ***/ + + /** Each bucket in an method table contains a Class[] of + parameterTypes and the corresponding method or constructor. **/ + private static final int BUCKET_SIZE = 2; + private static Class[] getParameterTypes(Object m) { + return (m instanceof Method) ? ((Method) m).getParameterTypes() : + ((Constructor) m).getParameterTypes(); + } + + /** Returns Object[] of parameterType, method pairs. **/ + private static Object[] methodArray(Object[] v) { + Object[] result = new Object[v.length*BUCKET_SIZE]; + for(int i = 0; i < v.length; i++) { + result[i*BUCKET_SIZE] = getParameterTypes(v[i]); + result[i*BUCKET_SIZE+1] = v[i]; + } + return result; + } + /* */ + private static Object findMethod(Object[] methods, Object[] args) { + int best = -1; + /* + System.err.println("Found " + (methods.length/2) + " constructors: " + methods); + System.err.println("Checking against " + args.length + " args, these:"); + for(int i=0; i", GT, 2, n) + .defPrim(">=", GE, 2, n) + .defPrim("abs", ABS, 1) + .defPrim("acos", ACOS, 1) + .defPrim("append", APPEND, 0, n) + .defPrim("apply", APPLY, 2, n) + .defPrim("asin", ASIN, 1) + .defPrim("assoc", ASSOC, 2) + .defPrim("assq", ASSQ, 2) + .defPrim("assv", ASSV, 2) + .defPrim("atan", ATAN, 1) + .defPrim("boolean?", BOOLEANQ, 1) + .defPrim("caaaar", CXR, 1) + .defPrim("caaadr", CXR, 1) + .defPrim("caaar", CXR, 1) + .defPrim("caadar", CXR, 1) + .defPrim("caaddr", CXR, 1) + .defPrim("caadr", CXR, 1) + .defPrim("caar", CXR, 1) + .defPrim("cadaar", CXR, 1) + .defPrim("cadadr", CXR, 1) + .defPrim("cadar", CXR, 1) + .defPrim("caddar", CXR, 1) + .defPrim("cadddr", CXR, 1) + .defPrim("caddr", THIRD, 1) + .defPrim("cadr", SECOND, 1) + .defPrim("call-with-current-continuation", CALLCC, 1) + .defPrim("call-with-input-file", CALLWITHINPUTFILE, 2) + .defPrim("call-with-output-file", CALLWITHOUTPUTFILE, 2) + .defPrim("car", CAR, 1) + .defPrim("cdaaar", CXR, 1) + .defPrim("cdaadr", CXR, 1) + .defPrim("cdaar", CXR, 1) + .defPrim("cdadar", CXR, 1) + .defPrim("cdaddr", CXR, 1) + .defPrim("cdadr", CXR, 1) + .defPrim("cdar", CXR, 1) + .defPrim("cddaar", CXR, 1) + .defPrim("cddadr", CXR, 1) + .defPrim("cddar", CXR, 1) + .defPrim("cdddar", CXR, 1) + .defPrim("cddddr", CXR, 1) + .defPrim("cdddr", CXR, 1) + .defPrim("cddr", CXR, 1) + .defPrim("cdr", CDR, 1) + .defPrim("char->integer", CHARTOINTEGER, 1) + .defPrim("char-alphabetic?",CHARALPHABETICQ, 1) + .defPrim("char-ci<=?", CHARCICMP+LE, 2) + .defPrim("char-ci=?", CHARCICMP+GE, 2) + .defPrim("char-ci>?" , CHARCICMP+GT, 2) + .defPrim("char-downcase", CHARDOWNCASE, 1) + .defPrim("char-lower-case?",CHARLOWERCASEQ, 1) + .defPrim("char-numeric?", CHARNUMERICQ, 1) + .defPrim("char-upcase", CHARUPCASE, 1) + .defPrim("char-upper-case?",CHARUPPERCASEQ, 1) + .defPrim("char-whitespace?",CHARWHITESPACEQ, 1) + .defPrim("char<=?", CHARCMP+LE, 2) + .defPrim("char=?", CHARCMP+GE, 2) + .defPrim("char>?", CHARCMP+GT, 2) + .defPrim("char?", CHARQ, 1) + .defPrim("close-input-port", CLOSEINPUTPORT, 1) + .defPrim("close-output-port", CLOSEOUTPUTPORT, 1) + .defPrim("complex?", NUMBERQ, 1) + .defPrim("cons", CONS, 2) + .defPrim("cos", COS, 1) + .defPrim("current-input-port", CURRENTINPUTPORT, 0) + .defPrim("current-output-port", CURRENTOUTPUTPORT, 0) + .defPrim("display", DISPLAY, 1, 2) + .defPrim("eof-object?", EOFOBJECTQ, 1) + .defPrim("eq?", EQQ, 2) + .defPrim("equal?", EQUALQ, 2) + .defPrim("eqv?", EQVQ, 2) + .defPrim("eval", EVAL, 1, 2) + .defPrim("even?", EVENQ, 1) + .defPrim("exact?", INTEGERQ, 1) + .defPrim("exp", EXP, 1) + .defPrim("expt", EXPT, 2) + .defPrim("force", FORCE, 1) + .defPrim("for-each", FOREACH, 1, n) + .defPrim("gcd", GCD, 0, n) + .defPrim("inexact?", INEXACTQ, 1) + .defPrim("input-port?", INPUTPORTQ, 1) + .defPrim("integer->char", INTEGERTOCHAR, 1) + .defPrim("integer?", INTEGERQ, 1) + .defPrim("lcm", LCM, 0, n) + .defPrim("length", LENGTH, 1) + .defPrim("list", LIST, 0, n) + .defPrim("list->string", LISTTOSTRING, 1) + .defPrim("list->vector", LISTTOVECTOR, 1) + .defPrim("list-ref", LISTREF, 2) + .defPrim("list-tail", LISTTAIL, 2) + .defPrim("list?", LISTQ, 1) + .defPrim("load", LOAD, 1) + .defPrim("log", LOG, 1) + .defPrim("macro-expand", MACROEXPAND,1) + .defPrim("make-string", MAKESTRING,1, 2) + .defPrim("make-vector", MAKEVECTOR,1, 2) + .defPrim("map", MAP, 1, n) + .defPrim("max", MAX, 1, n) + .defPrim("member", MEMBER, 2) + .defPrim("memq", MEMQ, 2) + .defPrim("memv", MEMV, 2) + .defPrim("min", MIN, 1, n) + .defPrim("modulo", MODULO, 2) + .defPrim("negative?", NEGATIVEQ, 1) + .defPrim("newline", NEWLINE, 0, 1) + .defPrim("not", NOT, 1) + .defPrim("null?", NULLQ, 1) + .defPrim("number->string", NUMBERTOSTRING, 1, 2) + .defPrim("number?", NUMBERQ, 1) + .defPrim("odd?", ODDQ, 1) + .defPrim("open-input-file",OPENINPUTFILE, 1) + .defPrim("open-output-file", OPENOUTPUTFILE, 1) + .defPrim("output-port?", OUTPUTPORTQ, 1) + .defPrim("pair?", PAIRQ, 1) + .defPrim("peek-char", PEEKCHAR, 0, 1) + .defPrim("positive?", POSITIVEQ, 1) + .defPrim("procedure?", PROCEDUREQ,1) + .defPrim("quotient", QUOTIENT, 2) + .defPrim("rational?", INTEGERQ, 1) + .defPrim("read", READ, 0, 1) + .defPrim("read-char", READCHAR, 0, 1) + .defPrim("real?", NUMBERQ, 1) + .defPrim("remainder", REMAINDER, 2) + .defPrim("reverse", REVERSE, 1) + .defPrim("round", ROUND, 1) + .defPrim("set-car!", SETCAR, 2) + .defPrim("set-cdr!", SETCDR, 2) + .defPrim("sin", SIN, 1) + .defPrim("sqrt", SQRT, 1) + .defPrim("string", STRING, 0, n) + .defPrim("string->list", STRINGTOLIST, 1) + .defPrim("string->number", STRINGTONUMBER, 1, 2) + .defPrim("string->symbol", STRINGTOSYMBOL, 1) + .defPrim("string-append", STRINGAPPEND, 0, n) + .defPrim("string-ci<=?", STRINGCICMP+LE, 2) + .defPrim("string-ci=?", STRINGCICMP+GE, 2) + .defPrim("string-ci>?" , STRINGCICMP+GT, 2) + .defPrim("string-length", STRINGLENGTH, 1) + .defPrim("string-ref", STRINGREF, 2) + .defPrim("string-set!", STRINGSET, 3) + .defPrim("string<=?", STRINGCMP+LE, 2) + .defPrim("string=?", STRINGCMP+GE, 2) + .defPrim("string>?", STRINGCMP+GT, 2) + .defPrim("string?", STRINGQ, 1) + .defPrim("substring", SUBSTRING, 3) + .defPrim("symbol->string", SYMBOLTOSTRING, 1) + .defPrim("symbol?", SYMBOLQ, 1) + .defPrim("tan", TAN, 1) + .defPrim("vector", VECTOR, 0, n) + .defPrim("vector->list", VECTORTOLIST, 1) + .defPrim("vector-length", VECTORLENGTH, 1) + .defPrim("vector-ref", VECTORREF, 2) + .defPrim("vector-set!", VECTORSET, 3) + .defPrim("vector?", VECTORQ, 1) + .defPrim("write", WRITE, 1, 2) + .defPrim("write-char", DISPLAY, 1, 2) + .defPrim("zero?", ZEROQ, 1) + + ///////////// Extensions //////////////// + + .defPrim("new", NEW, 1, n) + .defPrim("class", CLASS, 1) + .defPrim("method", METHOD, 2, n) + .defPrim("exit", EXIT, 0, 1) + .defPrim("error", ERROR, 0, n) + .defPrim("time-call", TIMECALL, 1, 2) + .defPrim("_list*", LISTSTAR, 0, n) + ; + + return env; + } + + /** Apply a primitive to a list of arguments. **/ + public Object apply(Scheme interp, Object args) { + //First make sure there are the right number of arguments. + int nArgs = length(args); + if (nArgs < minArgs) + return error("too few args, " + nArgs + + ", for " + this.name + ": " + args); + else if (nArgs > maxArgs) + return error("too many args, " + nArgs + + ", for " + this.name + ": " + args); + + Object x = first(args); + Object y = second(args); + + switch (idNumber) { + + //////////////// SECTION 6.1 BOOLEANS + case NOT: return truth(x == FALSE); + case BOOLEANQ: return truth(x == TRUE || x == FALSE); + + //////////////// SECTION 6.2 EQUIVALENCE PREDICATES + case EQVQ: return truth(eqv(x, y)); + case EQQ: return truth(x == y); + case EQUALQ: return truth(equal(x,y)); + + //////////////// SECTION 6.3 LISTS AND PAIRS + case PAIRQ: return truth(x instanceof Pair); + case LISTQ: return truth(isList(x)); + case CXR: for (int i = name.length()-2; i >= 1; i--) + x = (name.charAt(i) == 'a') ? first(x) : rest(x); + return x; + case CONS: return cons(x, y); + case CAR: return first(x); + case CDR: return rest(x); + case SETCAR: return setFirst(x, y); + case SETCDR: return setRest(x, y); + case SECOND: return second(x); + case THIRD: return third(x); + case NULLQ: return truth(x == null); + case LIST: return args; + case LENGTH: return num(length(x)); + case APPEND: return (args == null) ? null : append(args); + case REVERSE: return reverse(x); + case LISTTAIL: for (int k = (int)num(y); k>0; k--) x = rest(x); + return x; + case LISTREF: for (int k = (int)num(y); k>0; k--) x = rest(x); + return first(x); + case MEMQ: return memberAssoc(x, y, 'm', 'q'); + case MEMV: return memberAssoc(x, y, 'm', 'v'); + case MEMBER: return memberAssoc(x, y, 'm', ' '); + case ASSQ: return memberAssoc(x, y, 'a', 'q'); + case ASSV: return memberAssoc(x, y, 'a', 'v'); + case ASSOC: return memberAssoc(x, y, 'a', ' '); + + //////////////// SECTION 6.4 SYMBOLS + case SYMBOLQ: return truth(x instanceof String); + case SYMBOLTOSTRING:return sym(x).toCharArray(); + case STRINGTOSYMBOL:return new String(str(x)).intern(); + + //////////////// SECTION 6.5 NUMBERS + case NUMBERQ: return truth(x instanceof Number); + case ODDQ: return truth(Math.abs(num(x)) % 2 != 0); + case EVENQ: return truth(Math.abs(num(x)) % 2 == 0); + case ZEROQ: return truth(num(x) == 0); + case POSITIVEQ: return truth(num(x) > 0); + case NEGATIVEQ: return truth(num(x) < 0); + case INTEGERQ: return truth(isExact(x)); + case INEXACTQ: return truth(!isExact(x)); + case LT: return numCompare(args, '<'); + case GT: return numCompare(args, '>'); + case EQ: return numCompare(args, '='); + case LE: return numCompare(args, 'L'); + case GE: return numCompare(args, 'G'); + case MAX: return numCompute(args, 'X', num(x)); + case MIN: return numCompute(args, 'N', num(x)); + case PLUS: return numCompute(args, '+', 0.0); + case MINUS: return numCompute(rest(args), '-', num(x)); + case TIMES: return numCompute(args, '*', 1.0); + case DIVIDE: return numCompute(rest(args), '/', num(x)); + case QUOTIENT: double d = num(x)/num(y); + return num(d > 0 ? Math.floor(d) : Math.ceil(d)); + case REMAINDER: return num((long)num(x) % (long)num(y)); + case MODULO: long xi = (long)num(x), yi = (long)num(y), m = xi % yi; + return num((xi*yi > 0 || m == 0) ? m : m + yi); + case ABS: return num(Math.abs(num(x))); + case FLOOR: return num(Math.floor(num(x))); + case CEILING: return num(Math.ceil(num(x))); + case TRUNCATE: d = num(x); + return num((d < 0.0) ? Math.ceil(d) : Math.floor(d)); + case ROUND: return num(Math.round(num(x))); + case EXP: return num(Math.exp(num(x))); + case LOG: return num(Math.log(num(x))); + case SIN: return num(Math.sin(num(x))); + case COS: return num(Math.cos(num(x))); + case TAN: return num(Math.tan(num(x))); + case ASIN: return num(Math.asin(num(x))); + case ACOS: return num(Math.acos(num(x))); + case ATAN: return num(Math.atan(num(x))); + case SQRT: return num(Math.sqrt(num(x))); + case EXPT: return num(Math.pow(num(x), num(y))); + case NUMBERTOSTRING:return numberToString(x, y); + case STRINGTONUMBER:return stringToNumber(x, y); + case GCD: return (args == null) ? ZERO : gcd(args); + case LCM: return (args == null) ? ONE : lcm(args); + + //////////////// SECTION 6.6 CHARACTERS + case CHARQ: return truth(x instanceof Character); + case CHARALPHABETICQ: return truth(Character.isLetter(chr(x))); + case CHARNUMERICQ: return truth(Character.isDigit(chr(x))); + case CHARWHITESPACEQ: return truth(Character.isWhitespace(chr(x))); + case CHARUPPERCASEQ: return truth(Character.isUpperCase(chr(x))); + case CHARLOWERCASEQ: return truth(Character.isLowerCase(chr(x))); + case CHARTOINTEGER: return new Double((double)chr(x)); + case INTEGERTOCHAR: return chr((char)(int)num(x)); + case CHARUPCASE: return chr(Character.toUpperCase(chr(x))); + case CHARDOWNCASE: return chr(Character.toLowerCase(chr(x))); + case CHARCMP+EQ: return truth(charCompare(x, y, false) == 0); + case CHARCMP+LT: return truth(charCompare(x, y, false) < 0); + case CHARCMP+GT: return truth(charCompare(x, y, false) > 0); + case CHARCMP+GE: return truth(charCompare(x, y, false) >= 0); + case CHARCMP+LE: return truth(charCompare(x, y, false) <= 0); + case CHARCICMP+EQ: return truth(charCompare(x, y, true) == 0); + case CHARCICMP+LT: return truth(charCompare(x, y, true) < 0); + case CHARCICMP+GT: return truth(charCompare(x, y, true) > 0); + case CHARCICMP+GE: return truth(charCompare(x, y, true) >= 0); + case CHARCICMP+LE: return truth(charCompare(x, y, true) <= 0); + + case ERROR: return error(stringify(args)); + + //////////////// SECTION 6.7 STRINGS + case STRINGQ: return truth(x instanceof char[]); + case MAKESTRING:char[] str = new char[(int)num(x)]; + if (y != null) { + char c = chr(y); + for (int i = str.length-1; i >= 0; i--) str[i] = c; + } + return str; + case STRING: return listToString(args); + case STRINGLENGTH: return num(str(x).length); + case STRINGREF: return chr(str(x)[(int)num(y)]); + case STRINGSET: Object z = third(args); str(x)[(int)num(y)] = chr(z); + return z; + case SUBSTRING: int start = (int)num(y), end = (int)num(third(args)); + return new String(str(x), start, end-start).toCharArray(); + case STRINGAPPEND: return stringAppend(args); + case STRINGTOLIST: Pair result = null; + char[] str2 = str(x); + for (int i = str2.length-1; i >= 0; i--) + result = cons(chr(str2[i]), result); + return result; + case LISTTOSTRING: return listToString(x); + case STRINGCMP+EQ: return truth(stringCompare(x, y, false) == 0); + case STRINGCMP+LT: return truth(stringCompare(x, y, false) < 0); + case STRINGCMP+GT: return truth(stringCompare(x, y, false) > 0); + case STRINGCMP+GE: return truth(stringCompare(x, y, false) >= 0); + case STRINGCMP+LE: return truth(stringCompare(x, y, false) <= 0); + case STRINGCICMP+EQ:return truth(stringCompare(x, y, true) == 0); + case STRINGCICMP+LT:return truth(stringCompare(x, y, true) < 0); + case STRINGCICMP+GT:return truth(stringCompare(x, y, true) > 0); + case STRINGCICMP+GE:return truth(stringCompare(x, y, true) >= 0); + case STRINGCICMP+LE:return truth(stringCompare(x, y, true) <= 0); + + //////////////// SECTION 6.8 VECTORS + case VECTORQ: return truth(x instanceof Object[]); + case MAKEVECTOR: Object[] vec = new Object[(int)num(x)]; + if (y != null) { + for (int i = 0; i < vec.length; i++) vec[i] = y; + } + return vec; + case VECTOR: return listToVector(args); + case VECTORLENGTH: return num(vec(x).length); + case VECTORREF: return vec(x)[(int)num(y)]; + case VECTORSET: return vec(x)[(int)num(y)] = third(args); + case VECTORTOLIST: return vectorToList(x); + case LISTTOVECTOR: return listToVector(x); + + //////////////// SECTION 6.9 CONTROL FEATURES + case EVAL: return interp.eval(x); + case FORCE: return (!(x instanceof Procedure)) ? x + : proc(x).apply(interp, null); + case MACROEXPAND: return Macro.macroExpand(interp, x); + case PROCEDUREQ: return truth(x instanceof Procedure); + case APPLY: return proc(x).apply(interp, listStar(rest(args))); + case MAP: return map(proc(x), rest(args), interp, list(null)); + case FOREACH: return map(proc(x), rest(args), interp, null); + case CALLCC: RuntimeException cc = new RuntimeException(); + Continuation proc = new Continuation(cc); + try { return proc(x).apply(interp, list(proc)); } + catch (RuntimeException e) { + if (e == cc) return proc.value; else throw e; + } + + //////////////// SECTION 6.10 INPUT AND OUPUT + case EOFOBJECTQ: return truth(x == InputPort.EOF); + case INPUTPORTQ: return truth(x instanceof InputPort); + case CURRENTINPUTPORT: return interp.input; + case OPENINPUTFILE: return openInputFile(x); + case CLOSEINPUTPORT: return inPort(x, interp).close(); + case OUTPUTPORTQ: return truth(x instanceof PrintWriter); + case CURRENTOUTPUTPORT: return interp.output; + case OPENOUTPUTFILE: return openOutputFile(x); + case CALLWITHOUTPUTFILE: PrintWriter p = null; + try { p = openOutputFile(x); + z = proc(y).apply(interp, list(p)); + } finally { if (p != null) p.close(); } + return z; + case CALLWITHINPUTFILE: InputPort p2 = null; + try { p2 = openInputFile(x); + z = proc(y).apply(interp, list(p2)); + } finally { if (p2 != null) p2.close(); } + return z; + case CLOSEOUTPUTPORT: outPort(x, interp).close(); return TRUE; + case READCHAR: return inPort(x, interp).readChar(); + case PEEKCHAR: return inPort(x, interp).peekChar(); + case LOAD: return interp.load(x); + case READ: return inPort(x, interp).read(); + case EOF_OBJECT: return truth(InputPort.isEOF(x)); + case WRITE: return write(x, outPort(y, interp), true); + case DISPLAY: return write(x, outPort(y, interp), false); + case NEWLINE: outPort(x, interp).println(); + outPort(x, interp).flush(); return TRUE; + + //////////////// EXTENSIONS + case CLASS: try { return Class.forName(stringify(x, false)); } + catch (ClassNotFoundException e) { return FALSE; } + case NEW: return JavaMethod.invokeConstructor(x, rest(args)); + case METHOD: return new JavaMethod(stringify(x, false), y, + rest(rest(args))); + case EXIT: System.exit((x == null) ? 0 : (int)num(x)); + case LISTSTAR: return listStar(args); + case TIMECALL: Runtime runtime = Runtime.getRuntime(); + runtime.gc(); + long startTime = System.currentTimeMillis(); + long startMem = runtime.freeMemory(); + Object ans = FALSE; + int nTimes = (y == null ? 1 : (int)num(y)); + for (int i = 0; i < nTimes; i++) { + ans = proc(x).apply(interp, null); + } + long time = System.currentTimeMillis() - startTime; + long mem = startMem - runtime.freeMemory(); + return cons(ans, list(list(num(time), "msec"), + list(num(mem), "bytes"))); + default: return error("internal error: unknown primitive: " + + this + " applied to " + args); + } + } + + public static char[] stringAppend(Object args) { + StringBuffer result = new StringBuffer(); + for(; args instanceof Pair; args = rest(args)) { + result.append(stringify(first(args), false)); + } + return result.toString().toCharArray(); + } + + public static Object memberAssoc(Object obj, Object list, char m, char eq) { + while (list instanceof Pair) { + Object target = (m == 'm') ? first(list) : first(first(list)); + boolean found; + switch (eq) { + case 'q': found = (target == obj); break; + case 'v': found = eqv(target, obj); break; + case ' ': found = equal(target, obj); break; + default: warn("Bad option to memberAssoc:" + eq); return FALSE; + } + if (found) return (m == 'm') ? list : first(list); + list = rest(list); + } + return FALSE; + } + + public static Object numCompare(Object args, char op) { + while (rest(args) instanceof Pair) { + double x = num(first(args)); args = rest(args); + double y = num(first(args)); + switch (op) { + case '>': if (!(x > y)) return FALSE; break; + case '<': if (!(x < y)) return FALSE; break; + case '=': if (!(x == y)) return FALSE; break; + case 'L': if (!(x <= y)) return FALSE; break; + case 'G': if (!(x >= y)) return FALSE; break; + default: error("internal error: unrecognized op: " + op); break; + } + } + return TRUE; + } + + public static Object numCompute(Object args, char op, double result) { + if (args == null) { + switch (op) { + case '-': return num(0 - result); + case '/': return num(1 / result); + default: return num(result); + } + } else { + while (args instanceof Pair) { + double x = num(first(args)); args = rest(args); + switch (op) { + case 'X': if (x > result) result = x; break; + case 'N': if (x < result) result = x; break; + case '+': result += x; break; + case '-': result -= x; break; + case '*': result *= x; break; + case '/': result /= x; break; + default: error("internal error: unrecognized op: " + op); break; + } + } + return num(result); + } + } + + /** Return the sign of the argument: +1, -1, or 0. **/ + static int sign(int x) { return (x > 0) ? +1 : (x < 0) ? -1 : 0; } + + /** Return <0 if x is alphabetically first, >0 if y is first, + * 0 if same. Case insensitive iff ci is true. Error if not both chars. **/ + public static int charCompare(Object x, Object y, boolean ci) { + char xc = chr(x), yc = chr(y); + if (ci) { xc = Character.toLowerCase(xc); yc = Character.toLowerCase(yc); } + return xc - yc; + } + + /** Return <0 if x is alphabetically first, >0 if y is first, + * 0 if same. Case insensitive iff ci is true. Error if not strings. **/ + public static int stringCompare(Object x, Object y, boolean ci) { + if (x instanceof char[] && y instanceof char[]) { + char[] xc = (char[])x, yc = (char[])y; + for (int i = 0; i < xc.length; i++) { + int diff = (!ci) ? xc[i] - yc[i] + : Character.toUpperCase(xc[i]) - Character.toUpperCase(yc[i]); + if (diff != 0) return diff; + } + return xc.length - yc.length; + } else { + error("expected two strings, got: " + stringify(list(x, y))); + return 0; + } + } + + static Object numberToString(Object x, Object y) { + int base = (y instanceof Number) ? (int)num(y) : 10; + if (base != 10 || num(x) == Math.round(num(x))) { + // An integer + return Long.toString((long)num(x), base).toCharArray(); + } else { + // A floating point number + return x.toString().toCharArray(); + } + } + + static Object stringToNumber(Object x, Object y) { + int base = (y instanceof Number) ? (int)num(y) : 10; + try { + return (base == 10) + ? Double.valueOf(stringify(x, false)) + : num(Long.parseLong(stringify(x, false), base)); + } catch (NumberFormatException e) { return FALSE; } + } + + static Object gcd(Object args) { + long gcd = 0; + while (args instanceof Pair) { + gcd = gcd2(Math.abs((long)num(first(args))), gcd); + args = rest(args); + } + return num(gcd); + } + + static long gcd2(long a, long b) { + if (b == 0) return a; + else return gcd2(b, a % b); + } + + static Object lcm(Object args) { + long L = 1, g = 1; + while (args instanceof Pair) { + long n = Math.abs((long)num(first(args))); + g = gcd2(n, L); + L = (g == 0) ? g : (n / g) * L; + args = rest(args); + } + return num(L); + } + + static boolean isExact(Object x) { + if (!(x instanceof Double)) return false; + double d = num(x); + return (d == Math.round(d) && Math.abs(d) < 102962884861573423.0); + } + + static PrintWriter openOutputFile(Object filename) { + try { + return new PrintWriter(new FileWriter(stringify(filename, false))); + } catch (FileNotFoundException e) { + return (PrintWriter)error("No such file: " + stringify(filename)); + } catch (IOException e) { + return (PrintWriter)error("IOException: " + e); + } + } + + static InputPort openInputFile(Object filename) { + try { + return new InputPort(new FileInputStream(stringify(filename, false))); + } catch (FileNotFoundException e) { + return (InputPort)error("No such file: " + stringify(filename)); + } catch (IOException e) { + return (InputPort)error("IOException: " + e); + } + } + + static boolean isList(Object x) { + Object slow = x, fast = x; + for(;;) { + if (fast == null) return true; + if (slow == rest(fast) || !(fast instanceof Pair) + || !(slow instanceof Pair)) return false; + slow = rest(slow); + fast = rest(fast); + if (fast == null) return true; + if (!(fast instanceof Pair)) return false; + fast = rest(fast); + } + } + + static Object append(Object args) { + if (rest(args) == null) return first(args); + else return append2(first(args), append(rest(args))); + } + + static Object append2(Object x, Object y) { + if (x instanceof Pair) return cons(first(x), append2(rest(x), y)); + else return y; + } + + /** Map proc over a list of lists of args, in the given interpreter. + * If result is non-null, accumulate the results of each call there + * and return that at the end. Otherwise, just return null. **/ + static Pair map(Procedure proc, Object args, Scheme interp, Pair result) { + Pair accum = result; + if (rest(args) == null) { + args = first(args); + while (args instanceof Pair) { + Object x = proc.apply(interp, list(first(args))); + if (accum != null) accum = (Pair) (accum.rest = list(x)); + args = rest(args); + } + } else { + Procedure car = proc(interp.eval("car")), cdr = proc(interp.eval("cdr")); + while (first(args) instanceof Pair) { + Object x = proc.apply(interp, map(car, list(args), interp, list(null))); + if (accum != null) accum = (Pair) (accum.rest = list(x)); + args = map(cdr, list(args), interp, list(null)); + } + } + return (Pair)rest(result); + } + +} diff --git a/modules/lnjscheme/LNjScheme/Procedure.java b/modules/lnjscheme/LNjScheme/Procedure.java new file mode 100644 index 00000000..8a21ecbf --- /dev/null +++ b/modules/lnjscheme/LNjScheme/Procedure.java @@ -0,0 +1,20 @@ +package LNjScheme; + +/** @author Peter Norvig, peter@norvig.com http://www.norvig.com + * Copyright 1998 Peter Norvig, see http://www.norvig.com/license.html **/ + +public abstract class Procedure extends SchemeUtils { + + String name = "anonymous procedure"; + + public String toString() { return "{" + name + "}"; } + + public abstract Object apply(Scheme interpreter, Object args); + + /** Coerces a Scheme object to a procedure. **/ + static Procedure proc(Object x) { + if (x instanceof Procedure) return (Procedure) x; + else return proc(error("Not a procedure: " + stringify(x))); + } + +} diff --git a/modules/lnjscheme/LNjScheme/Scheme.java b/modules/lnjscheme/LNjScheme/Scheme.java new file mode 100644 index 00000000..718971c7 --- /dev/null +++ b/modules/lnjscheme/LNjScheme/Scheme.java @@ -0,0 +1,150 @@ +package LNjScheme; +import java.io.*; + +/** This class represents a Scheme interpreter. + * See http://www.norvig.com/jscheme.html for more documentation. + * This is version 1.4. + * @author Peter Norvig, peter@norvig.com http://www.norvig.com + * Copyright 1998 Peter Norvig, see http://www.norvig.com/license.html **/ + +public class Scheme extends SchemeUtils { + + InputPort input = new InputPort(System.in); + PrintWriter output = new PrintWriter(System.out, true); + Environment globalEnvironment = new Environment(); + + /** Create a Scheme interpreter and load an array of files into it. + * Also load SchemePrimitives.CODE. **/ + public Scheme(String[] files) { + Primitive.installPrimitives(globalEnvironment); + try { + load(new InputPort(new StringReader(SchemePrimitives.CODE))); + for (int i = 0; i < (files == null ? 0 : files.length); i++) { + load(files[i]); + } + } catch (RuntimeException e) { ; } + } + + //////////////// Main Loop + + /** Create a new Scheme interpreter, passing in the command line args + * as files to load, and then enter a read eval write loop. **/ + public static void main(String[] files) { + new Scheme(files).readEvalWriteLoop(); + } + + /** Prompt, read, eval, and write the result. + * Also sets up a catch for any RuntimeExceptions encountered. **/ + public void readEvalWriteLoop() { + Object x; + for(;;) { + try { + output.print("> "); output.flush(); + if (input.isEOF(x = input.read())) return; + write(eval(x), output, true); + output.println(); output.flush(); + } catch (RuntimeException e) { ; } + } + } + + /** Eval all the expressions in a file. Calls load(InputPort). **/ + public Object load(Object fileName) { + String name = stringify(fileName, false); + try { return load(new InputPort(new FileInputStream(name))); } + catch (IOException e) { return error("can't load " + name); } + } + + /** Eval all the expressions coming from an InputPort. **/ + public Object load(InputPort in) { + Object x = null; + for(;;) { + if (in.isEOF(x = in.read())) return TRUE; + eval(x); + } + } + + //////////////// Evaluation + + /** Evaluate an object, x, in an environment. **/ + public Object eval(Object x, Environment env) { + // The purpose of the while loop is to allow tail recursion. + // The idea is that in a tail recursive position, we do "x = ..." + // and loop, rather than doing "return eval(...)". + while (true) { + if (x instanceof String) { // VARIABLE + return env.lookup((String)x); + } else if (!(x instanceof Pair)) { // CONSTANT + return x; + } else { + Object fn = first(x); + Object args = rest(x); + if (fn == "quote") { // QUOTE + return first(args); + } else if (fn == "begin") { // BEGIN + for (; rest(args) != null; args = rest(args)) { + eval(first(args), env); + } + x = first(args); + } else if (fn == "define") { // DEFINE + if (first(args) instanceof Pair) + return env.define(first(first(args)), + eval(cons("lambda", cons(rest(first(args)), rest(args))), env)); + else return env.define(first(args), eval(second(args), env)); + } else if (fn == "set!") { // SET! + return env.set(first(args), eval(second(args), env)); + } else if (fn == "if") { // IF + x = (truth(eval(first(args), env))) ? second(args) : third(args); + } else if (fn == "cond") { // COND + x = reduceCond(args, env); + } else if (fn == "lambda") { // LAMBDA + return new Closure(first(args), rest(args), env); + } else if (fn == "macro") { // MACRO + return new Macro(first(args), rest(args), env); + } else { // PROCEDURE CALL: + fn = eval(fn, env); + if (fn instanceof Macro) { // (MACRO CALL) + x = ((Macro)fn).expand(this, (Pair)x, args); + } else if (fn instanceof Closure) { // (CLOSURE CALL) + Closure f = (Closure)fn; + x = f.body; + env = new Environment(f.parms, evalList(args, env), f.env); + } else { // (OTHER PROCEDURE CALL) + return Procedure.proc(fn).apply(this, evalList(args, env)); + } + } + } + } + } + + /** Eval in the global environment. **/ + public Object eval(Object x) { return eval(x, this.globalEnvironment); } + + /** Evaluate each of a list of expressions. **/ + Pair evalList(Object list, Environment env) { + if (list == null) + return null; + else if (!(list instanceof Pair)) { + error("Illegal arg list: " + list); + return null; + } else + return cons(eval(first(list), env), evalList(rest(list), env)); + } + + /** Reduce a cond expression to some code which, when evaluated, + * gives the value of the cond expression. We do it that way to + * maintain tail recursion. **/ + Object reduceCond(Object clauses, Environment env) { + Object result = null; + for (;;) { + if (clauses == null) return FALSE; + Object clause = first(clauses); clauses = rest(clauses); + if (first(clause) == "else" + || truth(result = eval(first(clause), env))) + if (rest(clause) == null) return list("quote", result); + else if (second(clause) == "=>") + return list(third(clause), list("quote", result)); + else return cons("begin", rest(clause)); + } + } + +} diff --git a/modules/lnjscheme/LNjScheme/SchemePrimitives.java b/modules/lnjscheme/LNjScheme/SchemePrimitives.java new file mode 100644 index 00000000..4c2889a0 --- /dev/null +++ b/modules/lnjscheme/LNjScheme/SchemePrimitives.java @@ -0,0 +1,158 @@ +package LNjScheme; + +/** Holds a string representation of some Scheme code in CODE. + * A string is better than a file because with no files, its easier to + * compress everything in the classes.jar file. For editing convenience, + * the following two perl convert from normal text to this Java quoted + * format and back again: + * 
+ * perl -pe 's/"/\\"/g; s/(\s*)(.*?)(\s*)$/\1"\2\\n" +\n/'
+ * perl -pe 's/\\"/"/g; s/^(\s*)"/\1/; s/\\n" [+]//'
+ *
+ * @author Peter Norvig, peter@norvig.com http://www.norvig.com + * Copyright 1998 Peter Norvig, see http://www.norvig.com/license.html **/ +public class SchemePrimitives { + + public static final String CODE = +"(define call/cc call-with-current-continuation)\n" + +"(define first car)\n" + +"(define second cadr)\n" + +"(define third caddr)\n" + +"(define rest cdr)\n" + +"(define set-first! set-car!)\n" + +"(define set-rest! set-cdr!)\n" + + +//;;;;;;;;;;;;;;;; Standard Scheme Macros + +"(define or\n" + + "(macro args\n" + + "(if (null? args)\n" + + "#f\n" + + "(cons 'cond (map list args)))))\n" + + +"(define and\n" + + "(macro args\n" + + "(cond ((null? args) #t)\n" + + "((null? (rest args)) (first args))\n" + + "(else (list 'if (first args) (cons 'and (rest args)) #f)))))\n" + + +"(define quasiquote\n" + + "(macro (x)\n" + + "(define (constant? exp)\n" + + "(if (pair? exp) (eq? (car exp) 'quote) (not (symbol? exp))))\n" + + "(define (combine-skeletons left right exp)\n" + + "(cond\n" + + "((and (constant? left) (constant? right))\n" + + "(if (and (eqv? (eval left) (car exp))\n" + + "(eqv? (eval right) (cdr exp)))\n" + + "(list 'quote exp)\n" + + "(list 'quote (cons (eval left) (eval right)))))\n" + + "((null? right) (list 'list left))\n" + + "((and (pair? right) (eq? (car right) 'list))\n" + + "(cons 'list (cons left (cdr right))))\n" + + "(else (list 'cons left right))))\n" + + "(define (expand-quasiquote exp nesting)\n" + + "(cond\n" + + "((vector? exp)\n" + + "(list 'apply 'vector (expand-quasiquote (vector->list exp) nesting)))\n" + + "((not (pair? exp))\n" + + "(if (constant? exp) exp (list 'quote exp)))\n" + + "((and (eq? (car exp) 'unquote) (= (length exp) 2))\n" + + "(if (= nesting 0)\n" + + "(second exp)\n" + + "(combine-skeletons ''unquote\n" + + "(expand-quasiquote (cdr exp) (- nesting 1))\n" + + "exp)))\n" + + "((and (eq? (car exp) 'quasiquote) (= (length exp) 2))\n" + + "(combine-skeletons ''quasiquote\n" + + "(expand-quasiquote (cdr exp) (+ nesting 1))\n" + + "exp))\n" + + "((and (pair? (car exp))\n" + + "(eq? (caar exp) 'unquote-splicing)\n" + + "(= (length (car exp)) 2))\n" + + "(if (= nesting 0)\n" + + "(list 'append (second (first exp))\n" + + "(expand-quasiquote (cdr exp) nesting))\n" + + "(combine-skeletons (expand-quasiquote (car exp) (- nesting 1))\n" + + "(expand-quasiquote (cdr exp) nesting)\n" + + "exp)))\n" + + "(else (combine-skeletons (expand-quasiquote (car exp) nesting)\n" + + "(expand-quasiquote (cdr exp) nesting)\n" + + "exp))))\n" + + "(expand-quasiquote x 0)))\n" + + +"\n" + +"(define let\n" + + "(macro (bindings . body)\n" + + "(define (named-let name bindings body)\n" + + "`(let ((,name #f))\n" + + "(set! ,name (lambda ,(map first bindings) . ,body))\n" + + "(,name . ,(map second bindings))))\n" + + "(if (symbol? bindings)\n" + + "(named-let bindings (first body) (rest body))\n" + + "`((lambda ,(map first bindings) . ,body) . ,(map second bindings)))))\n" + + +"(define let*\n" + + "(macro (bindings . body)\n" + + "(if (null? bindings) `((lambda () . ,body))\n" + + "`(let (,(first bindings))\n" + + "(let* ,(rest bindings) . ,body)))))\n" + + +"(define letrec\n" + + "(macro (bindings . body)\n" + + "(let ((vars (map first bindings))\n" + + "(vals (map second bindings)))\n" + + "`(let ,(map (lambda (var) `(,var #f)) vars)\n" + + ",@(map (lambda (var val) `(set! ,var ,val)) vars vals)\n" + + ". ,body))))\n" + + +"(define case\n" + + "(macro (exp . cases)\n" + + "(define (do-case case)\n" + + "(cond ((not (pair? case)) (error \"bad syntax in case\" case))\n" + + "((eq? (first case) 'else) case)\n" + + "(else `((member __exp__ ',(first case)) . ,(rest case)))))\n" + + "`(let ((__exp__ ,exp)) (cond . ,(map do-case cases)))))\n" + + +"(define do\n" + + "(macro (bindings test-and-result . body)\n" + + "(let ((variables (map first bindings))\n" + + "(inits (map second bindings))\n" + + "(steps (map (lambda (clause)\n" + + "(if (null? (cddr clause))\n" + + "(first clause)\n" + + "(third clause)))\n" + + "bindings))\n" + + "(test (first test-and-result))\n" + + "(result (rest test-and-result)))\n" + + "`(letrec ((__loop__\n" + + "(lambda ,variables\n" + + "(if ,test\n" + + "(begin . ,result)\n" + + "(begin\n" + + ",@body\n" + + "(__loop__ . ,steps))))))\n" + + "(__loop__ . ,inits)))))\n" + + +"(define delay\n" + + "(macro (exp)\n" + + "(define (make-promise proc)\n" + + "(let ((result-ready? #f)\n" + + "(result #f))\n" + + "(lambda ()\n" + + "(if result-ready?\n" + + "result\n" + + "(let ((x (proc)))\n" + + "(if result-ready?\n" + + "result\n" + + "(begin (set! result-ready? #t)\n" + + "(set! result x)\n" + + "result)))))))\n" + + "`(,make-promise (lambda () ,exp))))\n" + + +//;;;;;;;;;;;;;;;; Extensions + +"(define time\n" + + "(macro (exp . rest) `(time-call (lambda () ,exp) . ,rest)))\n" +; +} diff --git a/modules/lnjscheme/LNjScheme/SchemeUtils.java b/modules/lnjscheme/LNjScheme/SchemeUtils.java new file mode 100644 index 00000000..493d6f3d --- /dev/null +++ b/modules/lnjscheme/LNjScheme/SchemeUtils.java @@ -0,0 +1,314 @@ +package LNjScheme; + +/** @author Peter Norvig, peter@norvig.com http://www.norvig.com + * Copyright 1998 Peter Norvig, see http://www.norvig.com/license.html **/ + +import java.io.*; + +public abstract class SchemeUtils { + + /** Same as Boolean.TRUE. **/ + public static final Boolean TRUE = Boolean.TRUE; + /** Same as Boolean.FALSE. **/ + public static final Boolean FALSE = Boolean.FALSE; + + public static Double ZERO = new Double(0.0); + public static Double ONE = new Double(1.0); + //////////////// Conversion Routines //////////////// + + // The following convert or coerce objects to the right type. + + /** Convert boolean to Boolean. **/ + public static Boolean truth(boolean x) { return x ? TRUE : FALSE; } + + /** Convert Scheme object to boolean. Only #f is false, others are true. **/ + public static boolean truth(Object x) { return x != FALSE; } + + /** Convert double to Double. Caches 0 and 1; makes new for others. **/ + public static Double num(double x) { + return (x == 0.0) ? ZERO : (x == 1.0) ? ONE : new Double(x); } + + /** Converts a Scheme object to a double, or calls error. **/ + public static double num(Object x) { + if (x instanceof Number) return ((Number)x).doubleValue(); + else return num(error("expected a number, got: " + x)); + } + + /** Converts a Scheme object to a char, or calls error. **/ + public static char chr(Object x) { + if (x instanceof Character) return ((Character)x).charValue(); + else return chr(error("expected a char, got: " + x)); + } + + /** Converts a char to a Character. **/ + public static Character chr(char ch) { + return new Character(ch); + } + + /** Coerces a Scheme object to a Scheme string, which is a char[]. **/ + public static char[] str(Object x) { + if (x instanceof char[]) return (char[])x; + else return str(error("expected a string, got: " + x)); + } + + /** Coerces a Scheme object to a Scheme symbol, which is a string. **/ + public static String sym(Object x) { + if (x instanceof String) return (String)x; + else return sym(error("expected a symbol, got: " + x)); + } + + /** Coerces a Scheme object to a Scheme vector, which is a Object[]. **/ + public static Object[] vec(Object x) { + if (x instanceof Object[]) return (Object[])x; + else return vec(error("expected a vector, got: " + x)); + } + + /** Coerces a Scheme object to a Scheme input port, which is an InputPort. + * If the argument is null, returns interpreter.input. **/ + public static InputPort inPort(Object x, Scheme interp) { + if (x == null) return interp.input; + else if (x instanceof InputPort) return (InputPort)x; + else return inPort(error("expected an input port, got: " + x), interp); + } + + /** Coerces a Scheme object to a Scheme input port, which is a PrintWriter. + * If the argument is null, returns System.out. **/ + public static PrintWriter outPort(Object x, Scheme interp) { + if (x == null) return interp.output; + else if (x instanceof PrintWriter) return (PrintWriter)x; + else return outPort(error("expected an output port, got: " + x), interp); + } + + //////////////// Error Routines //////////////// + + /** A continuable error. Prints an error message and then prompts for + * a value to eval and return. **/ + public static Object error(String message) { + System.err.println("**** ERROR: " + message); + throw new RuntimeException(message); + } + + public static Object warn(String message) { + System.err.println("**** WARNING: " + message); + return ""; + } + + //////////////// Basic manipulation Routines //////////////// + + // The following are used throughout the code. + + /** Like Common Lisp first; car of a Pair, or null for anything else. **/ + public static Object first(Object x) { + return (x instanceof Pair) ? ((Pair)x).first : null; + } + + /** Like Common Lisp rest; car of a Pair, or null for anything else. **/ + public static Object rest(Object x) { + return (x instanceof Pair) ? ((Pair)x).rest : null; + } + + /** Like Common Lisp (setf (first ... **/ + public static Object setFirst(Object x, Object y) { + return (x instanceof Pair) ? ((Pair)x).first = y + : error("Attempt to set-car of a non-Pair:" + stringify(x)); + } + + /** Like Common Lisp (setf (rest ... **/ + public static Object setRest(Object x, Object y) { + return (x instanceof Pair) ? ((Pair)x).rest = y + : error("Attempt to set-cdr of a non-Pair:" + stringify(x)); + } + + /** Like Common Lisp second. **/ + public static Object second(Object x) { + return first(rest(x)); + } + + /** Like Common Lisp third. **/ + public static Object third(Object x) { + return first(rest(rest(x))); + } + + /** Creates a two element list. **/ + public static Pair list(Object a, Object b) { + return new Pair(a, new Pair(b, null)); + } + + /** Creates a one element list. **/ + public static Pair list(Object a) { + return new Pair(a, null); + } + + /** listStar(args) is like Common Lisp (apply #'list* args) **/ + public static Object listStar(Object args) { + if (rest(args) == null) return first(args); + else return cons(first(args), listStar(rest(args))); + } + + /** cons(x, y) is the same as new Pair(x, y). **/ + public static Pair cons(Object a, Object b) { + return new Pair(a, b); + } + + /** Reverse the elements of a list. **/ + public static Object reverse(Object x) { + Object result = null; + while (x instanceof Pair) { + result = cons(first(x), result); + x = rest(x); + } + return result; + } + + /** Check if two objects are equal. **/ + public static boolean equal(Object x, Object y) { + if (x == null || y == null) { + return x == y; + } else if (x instanceof char[]) { + if (!(y instanceof char[])) return false; + char[] xc = (char[])x, yc = (char[])y; + if (xc.length != yc.length) return false; + for (int i = xc.length - 1; i >= 0; i--) { + if (xc[i] != yc[i]) return false; + } + return true; + } else if (x instanceof Object[]) { + if (!(y instanceof Object[])) return false; + Object[] xo = (Object[])x, yo = (Object[])y; + if (xo.length != yo.length) return false; + for (int i = xo.length - 1; i >= 0; i--) { + if (!equal(xo[i],yo[i])) return false; + } + return true; + } else { + return x.equals(y); + } + } + + /** Check if two objects are == or are equal numbers or characters. **/ + public static boolean eqv(Object x, Object y) { + return x == y + || (x instanceof Double && x.equals(y)) + || (x instanceof Character && x.equals(y)); + } + + /** The length of a list, or zero for a non-list. **/ + public static int length(Object x) { + int len = 0; + while (x instanceof Pair) { + len++; + x = ((Pair)x).rest; + } + return len; + } + + /** Convert a list of characters to a Scheme string, which is a char[]. **/ + public static char[] listToString(Object chars) { + char[] str = new char[length(chars)]; + for (int i = 0; chars instanceof Pair; i++) { + str[i] = chr(first(chars)); + chars = rest(chars); + } + return str; + } + + /** Convert a list of Objects to a Scheme vector, which is a Object[]. **/ + public static Object[] listToVector(Object objs) { + Object[] vec = new Object[length(objs)]; + for (int i = 0; objs instanceof Pair; i++) { + vec[i] = first(objs); + objs = rest(objs); + } + return vec; + } + + /** Write the object to a port. If quoted is true, use "str" and #\c, + * otherwise use str and c. **/ + public static Object write(Object x, PrintWriter port, boolean quoted) { + port.print(stringify(x, quoted)); + port.flush(); + return x; + } + + /** Convert a vector to a List. **/ + public static Pair vectorToList(Object x) { + if (x instanceof Object[]) { + Object[] vec = (Object[])x; + Pair result = null; + for (int i = vec.length - 1; i >= 0; i--) + result = cons(vec[i], result); + return result; + } else { + error("expected a vector, got: " + x); + return null; + } + } + + /** Convert a Scheme object to its printed representation, as + * a java String (not a Scheme string). If quoted is true, use "str" and #\c, + * otherwise use str and c. You need to pass in a StringBuffer that is used + * to accumulate the results. (If the interface didn't work that way, the + * system would use lots of little internal StringBuffers. But note that + * you can still call stringify(x) and a new StringBuffer will + * be created for you. **/ + + static void stringify(Object x, boolean quoted, StringBuffer buf) { + if (x == null) + buf.append("()"); + else if (x instanceof Double) { + double d = ((Double)x).doubleValue(); + if (Math.round(d) == d) buf.append((long)d); else buf.append(d); + } else if (x instanceof Character) { + if (quoted) buf.append("#\\"); + buf.append(x); + } else if (x instanceof Pair) { + ((Pair)x).stringifyPair(quoted, buf); + } else if (x instanceof char[]) { + char[] chars = (char[])x; + if (quoted) buf.append('"'); + for (int i = 0; i < chars.length; i++) { + if (quoted && chars[i] == '"') buf.append('\\'); + buf.append(chars[i]); + } + if (quoted) buf.append('"'); + } else if (x instanceof Object[]) { + Object[] v = (Object[])x; + buf.append("#("); + for (int i=0; iquoted is true.. **/ + static String stringify(Object x, boolean quoted) { + StringBuffer buf = new StringBuffer(); + stringify(x, quoted, buf); + return buf.toString(); + } + + /** For debugging purposes, prints output. **/ + static Object p(Object x) { + System.out.println(stringify(x)); + return x; + } + + /** For debugging purposes, prints output. **/ + static Object p(String msg, Object x) { + System.out.println(msg + ": " + stringify(x)); + return x; + } +} diff --git a/modules/lnjscheme/LNjScheme/primitives.scm b/modules/lnjscheme/LNjScheme/primitives.scm new file mode 100644 index 00000000..30c81cac --- /dev/null +++ b/modules/lnjscheme/LNjScheme/primitives.scm @@ -0,0 +1,146 @@ +;; Scheme primitives implemented in Scheme. +;; The quasiquote, and a few others, are from Darius Bacon +;; (But then, he started with my PAIP code, and modified it.) +;; - Peter Norvig + +;;;;;;;;;;;;;;;; Extensions: new names for old procedures + +(define call/cc call-with-current-continuation) +(define first car) +(define second cadr) +(define third caddr) +(define rest cdr) +(define set-first! set-car!) +(define set-rest! set-cdr!) + +;;;;;;;;;;;;;;;; Standard Scheme Macros + +(define or + (macro args + (if (null? args) + #f + (cons 'cond (map list args))))) + +(define and + (macro args + (cond ((null? args) #t) + ((null? (rest args)) (first args)) + (else (list 'if (first args) (cons 'and (rest args)) #f))))) + +(define quasiquote + (macro (x) + (define (constant? exp) + (if (pair? exp) (eq? (car exp) 'quote) (not (symbol? exp)))) + (define (combine-skeletons left right exp) + (cond + ((and (constant? left) (constant? right)) + (if (and (eqv? (eval left) (car exp)) + (eqv? (eval right) (cdr exp))) + (list 'quote exp) + (list 'quote (cons (eval left) (eval right))))) + ((null? right) (list 'list left)) + ((and (pair? right) (eq? (car right) 'list)) + (cons 'list (cons left (cdr right)))) + (else (list 'cons left right)))) + (define (expand-quasiquote exp nesting) + (cond + ((vector? exp) + (list 'apply 'vector (expand-quasiquote (vector->list exp) nesting))) + ((not (pair? exp)) + (if (constant? exp) exp (list 'quote exp))) + ((and (eq? (car exp) 'unquote) (= (length exp) 2)) + (if (= nesting 0) + (second exp) + (combine-skeletons ''unquote + (expand-quasiquote (cdr exp) (- nesting 1)) + exp))) + ((and (eq? (car exp) 'quasiquote) (= (length exp) 2)) + (combine-skeletons ''quasiquote + (expand-quasiquote (cdr exp) (+ nesting 1)) + exp)) + ((and (pair? (car exp)) + (eq? (caar exp) 'unquote-splicing) + (= (length (car exp)) 2)) + (if (= nesting 0) + (list 'append (second (first exp)) + (expand-quasiquote (cdr exp) nesting)) + (combine-skeletons (expand-quasiquote (car exp) (- nesting 1)) + (expand-quasiquote (cdr exp) nesting) + exp))) + (else (combine-skeletons (expand-quasiquote (car exp) nesting) + (expand-quasiquote (cdr exp) nesting) + exp)))) + (expand-quasiquote x 0))) + +(define let + (macro (bindings . body) + (define (named-let name bindings body) + `(let ((,name #f)) + (set! ,name (lambda ,(map first bindings) . ,body)) + (,name . ,(map second bindings)))) + (if (symbol? bindings) + (named-let bindings (first body) (rest body)) + `((lambda ,(map first bindings) . ,body) . ,(map second bindings))))) + +(define let* + (macro (bindings . body) + (if (null? bindings) `((lambda () . ,body)) + `(let (,(first bindings)) + (let* ,(rest bindings) . ,body))))) + +(define letrec + (macro (bindings . body) + (let ((vars (map first bindings)) + (vals (map second bindings))) + `(let ,(map (lambda (var) `(,var #f)) vars) + ,@(map (lambda (var val) `(set! ,var ,val)) vars vals) + . ,body)))) + +(define case + (macro (exp . cases) + (define (do-case case) + (cond ((not (pair? case)) (error "bad syntax in case" case)) + ((eq? (first case) 'else) case) + (else `((member __exp__ ',(first case)) . ,(rest case))))) + `(let ((__exp__ ,exp)) (cond . ,(map do-case cases))))) + +(define do + (macro (bindings test-and-result . body) + (let ((variables (map first bindings)) + (inits (map second bindings)) + (steps (map (lambda (clause) + (if (null? (cddr clause)) + (first clause) + (third clause))) + bindings)) + (test (first test-and-result)) + (result (rest test-and-result))) + `(letrec ((__loop__ + (lambda ,variables + (if ,test + (begin . ,result) + (begin + ,@body + (__loop__ . ,steps)))))) + (__loop__ . ,inits))))) + +(define delay + (macro (exp) + (define (make-promise proc) + (let ((result-ready? #f) + (result #f)) + (lambda () + (if result-ready? + result + (let ((x (proc))) + (if result-ready? + result + (begin (set! result-ready? #t) + (set! result x) + result))))))) + `(,make-promise (lambda () ,exp)))) + +;;;;;;;;;;;;;;;; Extensions + +(define time + (macro (exp . rest) `(time-call (lambda () ,exp) . ,rest))) diff --git a/modules/lnjscheme/MODULES b/modules/lnjscheme/MODULES new file mode 100644 index 00000000..04204c7c --- /dev/null +++ b/modules/lnjscheme/MODULES @@ -0,0 +1 @@ +config diff --git a/modules/lnjscheme/Makefile b/modules/lnjscheme/Makefile new file mode 100644 index 00000000..deab01d2 --- /dev/null +++ b/modules/lnjscheme/Makefile @@ -0,0 +1,8 @@ + +NAME=LNjScheme + +android_jars/$(NAME).jar: $(NAME)/*.java + @-mkdir android_jars + rm -f $(NAME)/*.class + javac $(NAME)/Scheme.java + jar cf $@ $(NAME)/*.class diff --git a/modules/lnjscheme/README.md b/modules/lnjscheme/README.md new file mode 100644 index 00000000..7e429264 --- /dev/null +++ b/modules/lnjscheme/README.md @@ -0,0 +1,69 @@ +# LNjScheme + +This directory contains an app to demo how to use LNjScheme from LN. + +LNjScheme allows to call any Java/Android method from +lambdanative/gambit without additional JNI code. Either directly or +within the UI thread (dispatched asynchronously via `runOnUiThread`). + +## Build + +call `make -f Makefile` in this directory to create `android_jars/LNjScheme.jar`. + +# History + +LNjScheme is derived from the 1.4 version of +[Jscheme from Peter Norvig](http://norvig.com/jscheme.html). + +Jscheme version 1.4, the last version that I released (in April +1998). A mercilessly small, easily modifiable version. + +(NB: There is another thing going by the name Jscheme, which was +extented by a community until 2006. This version grew beyond the +features, complexity and size which make the Pter Norvigs version +interesting as a strating point.) + +Jscheme 1.4 however lacks a few features, notably the ability supply +arguments to constructors. Therefore a derivative was required for +LN. In accordance with the stated license for Jscheme it got a new +name. + +## Changes + +1. Baseline: unpacked the sources from `jscheme-source.jar` into + subdirectory `LNjScheme`. +2. Changed package name to + +LNjScheme and added Makefile. +3. Refined errors raised from application of Java methods. +4. Pulled some code from the community version to support constructors with arguments. +5. Copied glue code from experimental branch and rename identifiers. + +# Issues + +## Numbers + +jScheme uses `lang.java.Double` for all numbers. This does not play +nice with native Jave APIs. TBD: Teach it either about fixnums or +conversion; or both. + +## Missing + +Really missing is the ability to access arbitrary field values (as +apposed to calling methods) of any class. + +From +https://stackoverflow.com/questions/13400075/reflection-generic-get-field-value + + import java.lang.reflect.Field; + + Field chap = c.getDeclaredField("chapters"); + out.format(fmt, "before", "chapters", book.chapters); + chap.setLong(book, 12); + out.format(fmt, "after", "chapters", chap.getLong(book)); + + Field[] fields = c.getDeclaredFields(); + for (Field classField : fields) + { + result.add(classField); + } diff --git a/modules/lnjscheme/lnjscheme.scm b/modules/lnjscheme/lnjscheme.scm new file mode 100644 index 00000000..4b04184b --- /dev/null +++ b/modules/lnjscheme/lnjscheme.scm @@ -0,0 +1,117 @@ +(cond-expand + (android + (c-declare "extern const char* android_app_class();") + (define android-app-class (c-lambda () char-string "android_app_class"))) + (else (define (android-app-class) + (log-error "android-app-class: called in non-Android context") + "android-app-class"))) + +(define lnjscheme-eval + ;; Not sure that we need a mutex here. But what if the java side + ;; manages to call into gambit? + (let ((mutex (make-mutex 'lnjscheme))) + (define lnjscheme-invoke/s2s + (c-lambda (char-string) char-string " +#ifdef ANDROID +extern const char *lnjscheme_eval(const char *); +#endif +___result= +#ifdef ANDROID +(char*) lnjscheme_eval(___arg1); +#else +NULL; +#endif +")) + (define (lnjscheme-call obj) + (let* ((s (let ((req (object->string obj))) + (mutex-lock! mutex) + (cond-expand + (android (lnjscheme-invoke/s2s req)) + (else (error "lnjscheme-call: not availible on platform" (system-platform)))))) + (r0 (begin + (mutex-unlock! mutex) + (if (string? s) + (call-with-input-string s + (lambda (port) + (let* ((key (read port)) + (value + (with-exception-catcher + (lambda (exn) (raise (string-append "lnjscheme-call: unreadable result: " s))) + (lambda () (read port))))) + (case key + ((D) value) + ((E) (raise value)) + (else (error "lnjscheme-call: unexpected reply " s)))))) + (error "lnjscheme-call: unexpected reply " s))))) + (cond + ;; Numbers are always printed as inexacts by jscheme. + ((integer? r0) (inexact->exact r0)) + (else r0)))) + lnjscheme-call)) + +(define LNjScheme-result #f) + +(define lnjscheme-future + ;; Not sure that we need a mutex here. But what if the java side + ;; manages to call into gambit? + (let ((mutex (make-mutex 'LNjScheme))) + (define jscheme-send + (c-lambda (char-string) void " +#ifdef ANDROID +extern void lnjscheme_eval_send(const char *); +lnjscheme_eval_send(___arg1); +#endif +")) + (define jscheme-receive + (c-lambda () char-string " +#ifdef ANDROID +extern const char *lnjscheme_eval_receive_result(); +#endif +___result= +#ifdef ANDROID +(char*) lnjscheme_eval_receive_result(); +#else +NULL; +#endif +")) + (define (noresult) #f) + (define (reset!) (set! LNjScheme-result noresult)) + (define (jscheme-call obj) + (cond-expand + (android) + (else (error "jscheme-call: not availible on platform" (system-platform)))) + (mutex-lock! mutex) + (let ((resm (make-mutex obj))) + (mutex-lock! resm) + (set! LNjScheme-result + (lambda () + (reset!) + (mutex-specific-set! resm (jscheme-receive)) + (mutex-unlock! mutex) + (mutex-unlock! resm))) + (jscheme-send (object->string obj)) + (delay + (let* ((s (begin + (mutex-lock! resm #f #f) + (mutex-specific resm))) + (r0 (begin + (if (string? s) + (call-with-input-string + s + (lambda (port) + (let* ((key (read port)) + (value + (with-exception-catcher + (lambda (exn) (raise (string-append "jscheme-call: unreadable result: " s))) + (lambda () (read port))))) + (case key + ((D) value) + ((E) (raise value)) + (else (error "jscheme-call: unexpected reply " s)))))) + (error "jscheme-call: unexpected reply " s))))) + (cond + ;; Numbers are always printed as inexacts by jscheme. + ((integer? r0) (inexact->exact r0)) + (else r0)))))) + (reset!) + jscheme-call)) From f7f67e5e391ae9285c927d0ffa9d35c4e7733912 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=B6rg=20F=2E=20Wittenberger?= Date: Mon, 2 Nov 2020 12:13:31 +0100 Subject: [PATCH 03/26] ANDROID: actually use the new file information --- libraries/liblambdanative/system.c | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/libraries/liblambdanative/system.c b/libraries/liblambdanative/system.c index db646096..4a932b74 100644 --- a/libraries/liblambdanative/system.c +++ b/libraries/liblambdanative/system.c @@ -150,10 +150,25 @@ static void find_directories() #endif #if defined(ANDROID) // we put files on the sdcard, that's the only sane place (?) + extern char* android_getFilesDir(); char path[1024]; +#if 0 sprintf(path,"/sdcard/%s", SYS_APPNAME); sys_appdir=strdup(path); sys_dir=strdup(path); +#endif +#if 0 + sprintf(path,"%s/system", android_getFilesDir()); + sys_dir=strdup(path); + sprintf(path,"%s/data", android_getFilesDir()); + sys_appdir=strdup(path); +#endif +#if 1 + sprintf(path,"/sdcard/%s", SYS_APPNAME); + sys_dir=strdup(path); + sys_appdir=android_getFilesDir(); +#endif + #endif #if defined(BB10) || defined(PLAYBOOK) char path[1024], cwd[1024]; From f6dae46ec28e0de104d4abd0bbc0c4d235628118 Mon Sep 17 00:00:00 2001 From: 0-8-15 Date: Wed, 4 Nov 2020 09:29:17 +0100 Subject: [PATCH 04/26] CORE: log exceptions with context (#388) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Matthias Görges --- modules/ln_core/log.scm | 41 ++++++++--------------------------------- 1 file changed, 8 insertions(+), 33 deletions(-) diff --git a/modules/ln_core/log.scm b/modules/ln_core/log.scm index fd15ace2..a37b329b 100644 --- a/modules/ln_core/log.scm +++ b/modules/ln_core/log.scm @@ -119,31 +119,6 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (log:release!) ))) -;; try to output location of continuation -;; this only works if debug information is available -(define (trace:identify cont) - (let ((locat (##continuation-locat cont))) - (if locat - (let* ((container (##locat-container locat)) - (path (##container->path container))) - (if path - (let* ((filepos (##position->filepos (##locat-position locat))) - (line (fx+ (##filepos-line filepos) 1)) - (col (fx+ (##filepos-col filepos) 1))) - (log-error "trace: " path " line=" line " col=" col)) - #f)) - #f))) - -(define (log-trace thread) - (let* ((capture (##thread-continuation-capture thread))) - (let loop ((cont (##continuation-first-frame capture #f))(n 0)) - (if cont (begin - (if (> n 1) (trace:identify cont)) - (loop (##continuation-next-frame cont #f)(fx+ n 1)) - )) - ) - )) - (define (exception->string e) (let* ((str (with-output-to-string '() (lambda () (display-exception e (current-output-port))))) (tmp (string-split str #\newline))) @@ -151,14 +126,14 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (define (log:exception-handler e) (log-error "Thread \"" (thread-name (current-thread)) "\": " (exception->string e)) - (cond-expand - (gambit-c (log-trace (current-thread))) - (else - (unless (deadlock-exception? e) - ;; gambit ___cleanup(); re-enters with a deadlock-exception here - ;; while printing the trace - (log-trace (current-thread))) - )) + (log-error + (call-with-output-string + '() + (lambda (port) + (continuation-capture + (lambda (cont) + (display-exception-in-context e cont port) + (display-continuation-backtrace cont port)))))) (log-error "HALT pid " ((c-lambda () int "getpid"))) (exit 70)) From 9b3d9e3bc1387f8e7491adf3c67d5ae9c47e9b4b Mon Sep 17 00:00:00 2001 From: 0-8-15 Date: Sat, 7 Nov 2020 09:27:00 +0100 Subject: [PATCH 05/26] GLCORE: Performance optimizations (#385) Remove use of length, repeated list traversals and combinations of apply+append. --- modules/ln_glcore/glcore.scm | 216 ++++++++++++++++++++--------------- 1 file changed, 122 insertions(+), 94 deletions(-) diff --git a/modules/ln_glcore/glcore.scm b/modules/ln_glcore/glcore.scm index 60fd9d77..79c0e37a 100644 --- a/modules/ln_glcore/glcore.scm +++ b/modules/ln_glcore/glcore.scm @@ -1,6 +1,6 @@ #| LambdaNative - a cross-platform Scheme framework -Copyright (c) 2009-2013, University of British Columbia +Copyright (c) 2009-2020, University of British Columbia All rights reserved. Redistribution and use in source and binary forms, with or @@ -131,44 +131,54 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ) (define (glCoreVertex2f x0 y0 . xtra) - (let ((x (flo x0)) (y (flo y0)) - (tx (if (fx= (length xtra) 2) (flo (car xtra)) 0.5)) - (ty (if (fx= (length xtra) 2) (flo (cadr xtra)) 0.5))) - (f32vector-set! glCore:varray (fx+ glCore:vindex 0) x) - (f32vector-set! glCore:varray (fx+ glCore:vindex 1) y) - (set! glCore:vindex (fx+ glCore:vindex 2)) - (f32vector-set! glCore:tarray (fx+ glCore:tindex 0) tx) - (f32vector-set! glCore:tarray (fx+ glCore:tindex 1) ty) - (set! glCore:tindex (fx+ glCore:tindex 2)) - (u8vector-set! glCore:carray (fx+ glCore:cindex 0) glCore:red) - (u8vector-set! glCore:carray (fx+ glCore:cindex 1) glCore:green) - (u8vector-set! glCore:carray (fx+ glCore:cindex 2) glCore:blue) - (u8vector-set! glCore:carray (fx+ glCore:cindex 3) glCore:alpha) - (set! glCore:cindex (fx+ glCore:cindex 4)) - (set! glCore:use3D #f) - )) + (let* ((txx (pair? xtra)) + (tx (if txx (flo (car xtra)) 0.5)) + (ty (cond + ((not txx) 0.5) + ((let ((r (cdr xtra))) + (and (pair? r) (car r)))) + (else 0.5)))) + (let ((x (flo x0)) (y (flo y0))) + (f32vector-set! glCore:varray (fx+ glCore:vindex 0) x) + (f32vector-set! glCore:varray (fx+ glCore:vindex 1) y) + (set! glCore:vindex (fx+ glCore:vindex 2)) + (f32vector-set! glCore:tarray (fx+ glCore:tindex 0) tx) + (f32vector-set! glCore:tarray (fx+ glCore:tindex 1) ty) + (set! glCore:tindex (fx+ glCore:tindex 2)) + (u8vector-set! glCore:carray (fx+ glCore:cindex 0) glCore:red) + (u8vector-set! glCore:carray (fx+ glCore:cindex 1) glCore:green) + (u8vector-set! glCore:carray (fx+ glCore:cindex 2) glCore:blue) + (u8vector-set! glCore:carray (fx+ glCore:cindex 3) glCore:alpha) + (set! glCore:cindex (fx+ glCore:cindex 4)) + (set! glCore:use3D #f) + ))) ;; ------------------------------------------ ;; 3D rendering (define (glCoreVertex3f x0 y0 z0 . xtra) - (let ((x (flo x0)) (y (flo y0)) (z (flo z0)) - (tx (if (fx= (length xtra) 2) (flo (car xtra)) 0.5)) - (ty (if (fx= (length xtra) 2) (flo (cadr xtra)) 0.5))) - (f32vector-set! glCore:varray3D (fx+ glCore:vindex 0) x) - (f32vector-set! glCore:varray3D (fx+ glCore:vindex 1) y) - (f32vector-set! glCore:varray3D (fx+ glCore:vindex 2) z) - (set! glCore:vindex (fx+ glCore:vindex 3)) - (f32vector-set! glCore:tarray (fx+ glCore:tindex 0) tx) - (f32vector-set! glCore:tarray (fx+ glCore:tindex 1) ty) - (set! glCore:tindex (fx+ glCore:tindex 2)) - (u8vector-set! glCore:carray (fx+ glCore:cindex 0) glCore:red) - (u8vector-set! glCore:carray (fx+ glCore:cindex 1) glCore:green) - (u8vector-set! glCore:carray (fx+ glCore:cindex 2) glCore:blue) - (u8vector-set! glCore:carray (fx+ glCore:cindex 3) glCore:alpha) - (set! glCore:cindex (fx+ glCore:cindex 4)) - (set! glCore:use3D #t) - )) + (let* ((txx (pair? xtra)) + (tx (if txx (flo (car xtra)) 0.5)) + (ty (cond + ((not txx) 0.5) + ((let ((r (cdr xtra))) + (and (pair? r) (car r)))) + (else 0.5)))) + (let ((x (flo x0)) (y (flo y0)) (z (flo z0))) + (f32vector-set! glCore:varray3D (fx+ glCore:vindex 0) x) + (f32vector-set! glCore:varray3D (fx+ glCore:vindex 1) y) + (f32vector-set! glCore:varray3D (fx+ glCore:vindex 2) z) + (set! glCore:vindex (fx+ glCore:vindex 3)) + (f32vector-set! glCore:tarray (fx+ glCore:tindex 0) tx) + (f32vector-set! glCore:tarray (fx+ glCore:tindex 1) ty) + (set! glCore:tindex (fx+ glCore:tindex 2)) + (u8vector-set! glCore:carray (fx+ glCore:cindex 0) glCore:red) + (u8vector-set! glCore:carray (fx+ glCore:cindex 1) glCore:green) + (u8vector-set! glCore:carray (fx+ glCore:cindex 2) glCore:blue) + (u8vector-set! glCore:carray (fx+ glCore:cindex 3) glCore:alpha) + (set! glCore:cindex (fx+ glCore:cindex 4)) + (set! glCore:use3D #t) + ))) ;; ---------------------------------- ;; textures @@ -180,18 +190,21 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (define (glCoreTextureCreate w h data . aux) (glcore:log 5 "glCoreTextureCreate") - (let ((idx glCore:tidx) - (pixeltype (cond - ((fx= (u8vector-length data) (* w h)) GL_ALPHA) - ((fx= (u8vector-length data) (* 3 w h)) GL_RGB) - ((fx= (u8vector-length data) (* 4 w h)) GL_RGBA) - (else (log-error "glCoreTextureCreate: Invalid data range") #f))) - (interpolation (if (>= (length aux) 1) (car aux) GL_LINEAR)) - (wrap (if (>= (length aux) 2) (cadr aux) GL_CLAMP))) - (table-set! glCore:textures idx (##still-copy - (vector #f (u32vector 0) w h (##still-copy data) pixeltype interpolation wrap))) - (set! glCore:tidx (fx+ glCore:tidx 1)) - idx)) + (let* ((o1x (pair? aux)) + (o2 (and o1x (cdr aux)))) + (let ((idx glCore:tidx) + (pixeltype + (cond + ((fx= (u8vector-length data) (* w h)) GL_ALPHA) + ((fx= (u8vector-length data) (* 3 w h)) GL_RGB) + ((fx= (u8vector-length data) (* 4 w h)) GL_RGBA) + (else (log-error "glCoreTextureCreate: Invalid data range") #f))) + (interpolation (if o1x (car aux) GL_LINEAR)) + (wrap (if (pair? o2) (car o2) GL_CLAMP))) + (table-set! glCore:textures idx + (##still-copy (vector #f (u32vector 0) w h (##still-copy data) pixeltype interpolation wrap))) + (set! glCore:tidx (fx+ glCore:tidx 1)) + idx))) ;; return texture width (define (glCoreTextureWidth t) @@ -226,19 +239,24 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ;; (glCoreClipPush x1 y1 x2 y2) (define (glCoreClipPush . coords) (let* ((oldlist glcore:cliplist) - (newcoords (if (fx= (length coords) 4) (map flo - (list (min (car coords) (caddr coords)) (min (cadr coords) (cadddr coords)) - (max (car coords) (caddr coords)) (max (cadr coords) (cadddr coords)))) #f)) - (newlist (if newcoords (append (list newcoords) oldlist) - (if (null? oldlist) oldlist (cdr oldlist))))) - (if (not (null? newlist)) (begin - (set! glcore:clipx1 (car (car newlist))) - (set! glcore:clipy1 (cadr (car newlist))) - (set! glcore:clipx2 (caddr (car newlist))) - (set! glcore:clipy2 (cadddr (car newlist))) - )) - (set! glcore:cliplist newlist) - )) + (newcoords + (if (fx= (length coords) 4) + (map flo + (list (min (car coords) (caddr coords)) + (min (cadr coords) (cadddr coords)) + (max (car coords) (caddr coords)) + (max (cadr coords) (cadddr coords)))) + #f)) + (newlist (if newcoords + (append (list newcoords) oldlist) + (if (null? oldlist) oldlist (cdr oldlist))))) + (if (not (null? newlist)) + (begin + (set! glcore:clipx1 (car (car newlist))) + (set! glcore:clipy1 (cadr (car newlist))) + (set! glcore:clipx2 (caddr (car newlist))) + (set! glcore:clipy2 (cadddr (car newlist))))) + (set! glcore:cliplist newlist))) (define glCoreClipPop glCoreClipPush) @@ -252,13 +270,20 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (if entry (let ((w (flo (if (fx= (fix w0) 0) (vector-ref entry 2) w0))) (h (flo (if (fx= (fix h0) 0) (vector-ref entry 3) h0)))) - (if (null? glcore:cliplist) - (apply glCore:TextureDrawUnClipped (append (list (flo x) (flo y) w h t (flo x1) (flo y1) (flo x2) (flo y2) (flo r)) - (if (null? colors) '() (car colors)))) - (apply glCore:TextureDrawClipped (append (list (flo x) (flo y) w h t (flo x1) (flo y1) (flo x2) (flo y2) (flo r)) - (if (null? colors) '() (car colors))))) - ) (log-error "glCoreTextureDraw: unbound index " t)) - )) + (if (null? glcore:cliplist) + (if (pair? colors) + (glCore:TextureDrawUnClipped + (flo x) (flo y) w h t (flo x1) (flo y1) (flo x2) (flo y2) (flo r) + (car colors)) + (glCore:TextureDrawUnClipped + (flo x) (flo y) w h t (flo x1) (flo y1) (flo x2) (flo y2) (flo r))) + (if (pair? colors) + (glCore:TextureDrawClipped + (flo x) (flo y) w h t (flo x1) (flo y1) (flo x2) (flo y2) (flo r) + (car colors)) + (glCore:TextureDrawClipped + (flo x) (flo y) w h t (flo x1) (flo y1) (flo x2) (flo y2) (flo r))))) + (log-error "glCoreTextureDraw: unbound index " t)))) (define (glCore:TextureDrawUnClipped x y w h t @x1 @y1 @x2 @y2 r . colors) (glcore:log 5 "glCoreTextureDrawUnclipped enter") @@ -309,22 +334,24 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (glRotatef r 0. 0. 1.) (_glCoreTextureBind t) (glCoreBegin GL_TRIANGLE_STRIP) - (if (null? colors) (begin - (glCoreVertex2f (fl- cw2) ch2 c@x1 c@y2) - (glCoreVertex2f cw2 ch2 c@x2 c@y2) - (glCoreVertex2f (fl- cw2) (fl- ch2) c@x1 c@y1) - (glCoreVertex2f cw2 (fl- ch2) c@x2 c@y1) - ) (begin - ;; TODO: color interpolation here! - (glCoreColor (car colors)) - (glCoreVertex2f (fl- cw2) ch2 c@x1 c@y2) - (glCoreColor (cadr colors)) - (glCoreVertex2f cw2 ch2 c@x2 c@y2) - (glCoreColor (caddr colors)) - (glCoreVertex2f (fl- cw2) (fl- ch2) c@x1 c@y1) - (glCoreColor (cadddr colors)) - (glCoreVertex2f cw2 (fl- ch2) c@x2 c@y1) - )) + (if (null? colors) + (begin + (glCoreVertex2f (fl- cw2) ch2 c@x1 c@y2) + (glCoreVertex2f cw2 ch2 c@x2 c@y2) + (glCoreVertex2f (fl- cw2) (fl- ch2) c@x1 c@y1) + (glCoreVertex2f cw2 (fl- ch2) c@x2 c@y1) + ) + (let ((colors (list->vector colors))) + ;; TODO: color interpolation here! + (glCoreColor (vector-ref colors 0)) + (glCoreVertex2f (fl- cw2) ch2 c@x1 c@y2) + (glCoreColor (vector-ref colors 1)) + (glCoreVertex2f cw2 ch2 c@x2 c@y2) + (glCoreColor (vector-ref colors 2)) + (glCoreVertex2f (fl- cw2) (fl- ch2) c@x1 c@y1) + (glCoreColor (vector-ref colors 3)) + (glCoreVertex2f cw2 (fl- ch2) c@x2 c@y1) + )) (glCoreEnd) (glPopMatrix) ))) @@ -338,24 +365,25 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (glcore:log 5 "glCoreTexturePolygonDraw") (let ((entry (table-ref glCore:textures t #f))) (if entry - (let* ((cx (flo _cx)) (cy (flo _cy)) - (r (flo _r))) + (let* ((cx (flo _cx)) (cy (flo _cy)) (r (flo _r))) (glPushMatrix) (glTranslatef cx cy 0.) (glRotatef r 0. 0. 1.) (_glCoreTextureBind t) (glCoreBegin GL_TRIANGLE_STRIP) - (for-each (lambda (p) - (let* ((x (fl- (car p) cx)) - (y (fl- (cadr p) cy)) - (tx (caddr p)) - (ty (cadddr p))) + (for-each + (lambda (p) + ;; TBD: should accept vectoralikes as point + (let* ((p (list->vector p)) + (x (fl- (vector-ref p 0) cx)) + (y (fl- (vector-ref p 1) cy)) + (tx (vector-ref p 2)) + (ty (vector-ref p 3))) (glCoreVertex2f x y tx ty))) - points) - (glCoreEnd) - (glPopMatrix) - ) (log-error "glCoreTexturePolygonDraw: unbound index " t)) - )) + points) + (glCoreEnd) + (glPopMatrix)) + (log-error "glCoreTexturePolygonDraw: unbound index " t)))) ;; update texture data (for dynamic textures) ;; to use this, first modify data returned with glCoreTextureData.. From 0527fb9c924850f014fd37235e83ac88a0c0182a Mon Sep 17 00:00:00 2001 From: Peter Lewis Date: Sat, 7 Nov 2020 00:36:31 -0800 Subject: [PATCH 06/26] CAMERA: use FileProvider on Android to read and write data (#380) Apps that use FileProvider to pass URIs to activities must include ANDROID_xml_services and xml/file_paths.xml. Also fixes build-binary to locate the support.v4 library needed for FileProvider. Finally, use onRequestPermissionsResult to bootstrap.java.in to fix permission requests hanging. --- apps/DemoCamera/ANDROID_xml_services | 11 ++++ apps/DemoCamera/xml/file_paths.xml | 4 ++ loaders/android/bootstrap.java.in | 11 ++++ modules/camera/ANDROID_java_activityadditions | 18 ++++++- modules/camera/ANDROID_java_imports | 2 + .../ANDROID_java_activityadditions | 8 ++- modules/videoplayer/ANDROID_java_imports | 2 + targets/android/build-binary | 50 ++++++++++++++++++- 8 files changed, 100 insertions(+), 6 deletions(-) create mode 100644 apps/DemoCamera/ANDROID_xml_services create mode 100644 apps/DemoCamera/xml/file_paths.xml diff --git a/apps/DemoCamera/ANDROID_xml_services b/apps/DemoCamera/ANDROID_xml_services new file mode 100644 index 00000000..3a31b7e4 --- /dev/null +++ b/apps/DemoCamera/ANDROID_xml_services @@ -0,0 +1,11 @@ + + + + + \ No newline at end of file diff --git a/apps/DemoCamera/xml/file_paths.xml b/apps/DemoCamera/xml/file_paths.xml new file mode 100644 index 00000000..fa172d14 --- /dev/null +++ b/apps/DemoCamera/xml/file_paths.xml @@ -0,0 +1,4 @@ + + + + \ No newline at end of file diff --git a/loaders/android/bootstrap.java.in b/loaders/android/bootstrap.java.in index dd99563d..b5b14661 100644 --- a/loaders/android/bootstrap.java.in +++ b/loaders/android/bootstrap.java.in @@ -106,6 +106,17 @@ public class @SYS_APPNAME@ extends Activity implements @ANDROID_JAVA_IMPLEMENTS@ return true; } + @IF_ANDROIDAPI_GT_22@ + @Override + public void onRequestPermissionsResult(int requestCode, String[] permissions, int[] grantResults) { + super.onRequestPermissionsResult(requestCode, permissions, grantResults); + //Must do something with results data or app will hang + int rc = requestCode; + String p = permissions[0]; + int gr = grantResults[0]; + } + /* end of IF_ANDROIDAPI_GT_22 */ + @Override public void startActivityForResult(Intent intent, int cont) { try { diff --git a/modules/camera/ANDROID_java_activityadditions b/modules/camera/ANDROID_java_activityadditions index 62d5242f..1e5f91de 100644 --- a/modules/camera/ANDROID_java_activityadditions +++ b/modules/camera/ANDROID_java_activityadditions @@ -14,7 +14,14 @@ private void startCamera(String fnl_name, String tmp_name) { Intent intent = new Intent(MediaStore.ACTION_IMAGE_CAPTURE); File f = new File(camera_tmp); if (f != null) { - intent.putExtra(MediaStore.EXTRA_OUTPUT, Uri.fromFile(f)); + Uri imageUri = FileProvider.getUriForFile(this, + "@SYS_PACKAGE_DOT@.provider", + f); + intent.putExtra(MediaStore.EXTRA_OUTPUT, imageUri); + if (@SYS_ANDROIDAPI@ <= 22) { + intent.setClipData(ClipData.newRawUri("", imageUri)); + intent.addFlags(Intent.FLAG_GRANT_WRITE_URI_PERMISSION|Intent.FLAG_GRANT_READ_URI_PERMISSION); + } // intent.putExtra(android.provider.MediaStore.EXTRA_SCREEN_ORIENTATION,ActivityInfo.SCREEN_ORIENTATION_LANDSCAPE); startActivityForResult(intent, REQUEST_IMAGE_CAPTURE); } @@ -26,7 +33,14 @@ private void startVidCamera(String fnl_name, String tmp_name, int maxlength) { Intent intent = new Intent(MediaStore.ACTION_VIDEO_CAPTURE); File f = new File(vid_tmp); if (f != null) { - intent.putExtra(MediaStore.EXTRA_OUTPUT, Uri.fromFile(f)); + Uri vidUri = FileProvider.getUriForFile(this, + "@SYS_PACKAGE_DOT@.provider", + f); + intent.putExtra(MediaStore.EXTRA_OUTPUT, vidUri); + if (@SYS_ANDROIDAPI@ <= 22) { + intent.setClipData(ClipData.newRawUri("", vidUri)); + intent.addFlags(Intent.FLAG_GRANT_WRITE_URI_PERMISSION|Intent.FLAG_GRANT_READ_URI_PERMISSION); + } if (maxlength > 0) { intent.putExtra(MediaStore.EXTRA_DURATION_LIMIT, maxlength); } diff --git a/modules/camera/ANDROID_java_imports b/modules/camera/ANDROID_java_imports index abfaef12..0712cc5c 100644 --- a/modules/camera/ANDROID_java_imports +++ b/modules/camera/ANDROID_java_imports @@ -10,4 +10,6 @@ import android.media.ExifInterface; import java.io.FileOutputStream; import java.io.IOException; +import android.support.v4.content.FileProvider; + diff --git a/modules/videoplayer/ANDROID_java_activityadditions b/modules/videoplayer/ANDROID_java_activityadditions index ac68f787..17f061a2 100644 --- a/modules/videoplayer/ANDROID_java_activityadditions +++ b/modules/videoplayer/ANDROID_java_activityadditions @@ -2,8 +2,12 @@ private void startVideoPlayer(String mov_name, int orientation) { File f = new File(mov_name); if (f != null) { - Intent intent = new Intent(Intent.ACTION_VIEW, Uri.fromFile(f)); - intent.setDataAndType(Uri.fromFile(f), "video/*"); + Uri vidUri = FileProvider.getUriForFile(this, + "@SYS_PACKAGE_DOT@.provider", + f); + Intent intent = new Intent(Intent.ACTION_VIEW, vidUri); + intent.setDataAndType(vidUri, "video/*"); + intent.setFlags(Intent.FLAG_GRANT_READ_URI_PERMISSION); if (orientation == 1) { orientation = ActivityInfo.SCREEN_ORIENTATION_PORTRAIT; } else if (orientation == 2) { diff --git a/modules/videoplayer/ANDROID_java_imports b/modules/videoplayer/ANDROID_java_imports index 784d4843..43bdfb35 100644 --- a/modules/videoplayer/ANDROID_java_imports +++ b/modules/videoplayer/ANDROID_java_imports @@ -1,3 +1,5 @@ import java.io.File; +import android.support.v4.content.FileProvider; + diff --git a/targets/android/build-binary b/targets/android/build-binary index 9c93e4a6..39c010af 100755 --- a/targets/android/build-binary +++ b/targets/android/build-binary @@ -144,8 +144,54 @@ else assert "### Gradle is not supported" fi +# try to include support.v4 library if [ -f $ANDROIDSDK/extras/android/support/v4/android-support-v4.jar ]; then cp -r $ANDROIDSDK/extras/android/support/v4/android-support-v4.jar $tmpdir/libs + echo " => support-v4 library loaded" +else + # look for support-v4 in alternate location + # special support for API 19 + if [ $SYS_ANDROIDAPI -eq "19" ]; then + if [ -f $ANDROIDSDK/extras/android/m2repository/com/android/support/support-v4/19.1.0/support-v4-19.1.0.jar ]; then + cp -r $ANDROIDSDK/extras/android/m2repository/com/android/support/support-v4/19.1.0/support-v4-19.1.0.jar $tmpdir/libs + echo " => support-v4 library loaded (version 19)" + fi + else + # Find the directory containing the support-v4 AAR file + # Only folders from 20 - 23 have the full AAR file needed + supportv4version=$SYS_ANDROIDAPI + if [ $supportv4version -gt 23 ]; then + supportv4version="23" + fi + v4dir="" + while [ $supportv4version -gt "19" ]; do + v4dir=`find $ANDROIDSDK/extras/android/m2repository/com/android/support/support-v4 -name "$supportv4version*" | grep -v -e "alpha" -e "beta" | sort | tail -1` + if [ ! "X$v4dir" = "X" ]; then + break + fi + supportv4version=`expr ${supportv4version} - 1` + done + # If a directory is found, check if classes.jar has already been extracted. If not, extract it from the AAR + if [ ! "X$v4dir" = "X" ]; then + v4file=`find $v4dir -name classes.jar` + if [ ! -s "$v4file" ]; then + v4aar=`find $v4dir -name support-v4*.aar` + if [ -s "$v4aar" ]; then + unzip $v4aar classes.jar -d $v4dir > /dev/null + v4file=`find $v4dir -name classes.jar` + fi + fi + # If a classes.jar file has been found, copy it to libs + if [ -s "$v4file" ]; then + cp -r $v4file $tmpdir/libs + echo " => support-v4 library loaded (version $supportv4version)" + else + echo " => warning: support-v4 library not found" + fi + else + echo " => warning: support-v4 library not found" + fi + fi fi if [ "$NEED_GCM" = "yes" ]; then @@ -185,7 +231,7 @@ if [ -d "$jarfilesdir" ]; then mkdir -p $tmpdir/libs/ for jar in $jarfiles; do locajar=`basename $jar | tr A-Z a-z` - vecho " => coping jar file - $locajar ..." + vecho " => copying jar file - $locajar ..." cp $jar $tmpdir/libs/ done fi @@ -197,7 +243,7 @@ if [ -d "$xmlfilesdir" ]; then mkdir -p $tmpdir/res/xml/ xmlfiles=`ls -1 $xmlfilesdir/*.xml 2> /dev/null` for xml in $xmlfiles; do - vecho " => coping xml file - $xml ..." + vecho " => copying xml file - $xml ..." cp $xml $tmpdir/res/xml/ done fi From eabcc499817e6993cdcb9eec44188e94fb08589e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Matthias=20G=C3=B6rges?= Date: Sun, 8 Nov 2020 10:19:37 -0800 Subject: [PATCH 07/26] LN_CORE: Fix implicit declaration of function 'getpid' for ios --- modules/ln_core/log.scm | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/modules/ln_core/log.scm b/modules/ln_core/log.scm index a37b329b..5e42f233 100644 --- a/modules/ln_core/log.scm +++ b/modules/ln_core/log.scm @@ -37,6 +37,11 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |# ;; logger +(c-declare #< +end-of-c-declare +) + ;; we are logging from different threads (define log:mutex (make-mutex 'log)) (define (log:grab!) (mutex-lock! log:mutex)) From fc596813e25ae4e1dc8cd370b63f7a5407a6bbee Mon Sep 17 00:00:00 2001 From: 0-8-15 Date: Mon, 9 Nov 2020 02:45:58 -0800 Subject: [PATCH 08/26] ANDROID: Add support to switch content view to Java and back #386 An upcoming module webview will need this. --- loaders/android/bootstrap.java.in | 42 +++++++++++++++++++++++++------ 1 file changed, 34 insertions(+), 8 deletions(-) diff --git a/loaders/android/bootstrap.java.in b/loaders/android/bootstrap.java.in index b5b14661..315db186 100644 --- a/loaders/android/bootstrap.java.in +++ b/loaders/android/bootstrap.java.in @@ -1,6 +1,6 @@ /* LambdaNative - a cross-platform Scheme framework -Copyright (c) 2009-2013, University of British Columbia +Copyright (c) 2009-2020, University of British Columbia All rights reserved. Redistribution and use in source and binary forms, with or @@ -71,6 +71,7 @@ import android.hardware.SensorManager; @ANDROID_JAVA_ADDITIONS@ public class @SYS_APPNAME@ extends Activity implements @ANDROID_JAVA_IMPLEMENTS@ SensorEventListener{ + private android.view.View current_ContentView = null; private SensorManager mSensorManager; //Variable declarations needed for modules, e.g. gps @ANDROID_JAVA_VARIABLES@ @@ -137,8 +138,30 @@ public class @SYS_APPNAME@ extends Activity implements @ANDROID_JAVA_IMPLEMENTS@ } } + @Override + public void setContentView(android.view.View view) { + if(current_ContentView != view) { + if(current_ContentView instanceof android.opengl.GLSurfaceView) { + ((android.opengl.GLSurfaceView)current_ContentView).onPause(); + } + android.view.ViewParent parent0 = view.getParent(); + if(parent0 instanceof android.view.ViewGroup) { + android.view.ViewGroup parent = (android.view.ViewGroup) parent0; + if(parent!=null) { + parent.removeView(current_ContentView); + } + } + current_ContentView = view; + super.setContentView(current_ContentView); + if(current_ContentView instanceof android.opengl.GLSurfaceView) { + ((android.opengl.GLSurfaceView)current_ContentView).onResume(); + } + } + } + @Override protected void onCreate(Bundle savedInstanceState) { + current_ContentView = null; super.onCreate(savedInstanceState); Thread.setDefaultUncaughtExceptionHandler( new Thread.UncaughtExceptionHandler() { @@ -158,21 +181,22 @@ public class @SYS_APPNAME@ extends Activity implements @ANDROID_JAVA_IMPLEMENTS@ // prevent sleep getWindow().addFlags(WindowManager.LayoutParams.FLAG_KEEP_SCREEN_ON); mGLView = new xGLSurfaceView(this); - setContentView(mGLView); - mSensorManager = (SensorManager)getSystemService(Context.SENSOR_SERVICE); + // This may better before other pieces + nativeInstanceInit(); + mSensorManager = (SensorManager)getSystemService(Context.SENSOR_SERVICE); checkOrRequestPermission(android.Manifest.permission.WRITE_EXTERNAL_STORAGE); + setContentView(mGLView); // MUST NOT run before nativeInstanceInit completed // Additions needed by modules, e.g. gps @ANDROID_JAVA_ONCREATE@ // start EVENT_IDLE if(idle_tmScheduleRate > 0) idle_tm.scheduleAtFixedRate(idle_task, 0, idle_tmScheduleRate); - - nativeInstanceInit(); } @Override protected void onDestroy() { + setContentView(mGLView); @ANDROID_JAVA_ONDESTROY@ nativeEvent(14,0,0); // EVENT_CLOSE nativeEvent(127,0,0); // EVENT_TERMINATE @@ -184,19 +208,21 @@ public class @SYS_APPNAME@ extends Activity implements @ANDROID_JAVA_IMPLEMENTS@ } @Override protected void onPause() { - super.onPause(); // Additions needed by modules, e.g. gps @ANDROID_JAVA_ONPAUSE@ - if (!isFinishing()) { + if (!isFinishing() && current_ContentView==mGLView) { mGLView.onPause(); } + super.onPause(); } @Override protected void onResume() { super.onResume(); + if(current_ContentView==mGLView) { + mGLView.onResume(); + } // Additions needed by modules, e.g. gps @ANDROID_JAVA_ONRESUME@ - mGLView.onResume(); } @Override public void onAccuracyChanged(Sensor sensor, int accuracy) { From 7312d92ab4ff53cf257b75e815d447c50ed7f849 Mon Sep 17 00:00:00 2001 From: 0-8-15 Date: Mon, 9 Nov 2020 03:16:47 -0800 Subject: [PATCH 09/26] ANDROID: change sys_appdir to use getFilesDir() #386 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Avoid some JNI calls and provide more information about the Java/Android environment to Scheme. Co-authored-by: Matthias Görges --- libraries/liblambdanative/system.c | 5 +++-- loaders/android/bootstrap.c.in | 19 ++++++++++++++++--- loaders/android/bootstrap.java.in | 4 ++-- modules/config/config.scm | 19 ++++++++++++++++++- 4 files changed, 39 insertions(+), 8 deletions(-) diff --git a/libraries/liblambdanative/system.c b/libraries/liblambdanative/system.c index db646096..58966403 100644 --- a/libraries/liblambdanative/system.c +++ b/libraries/liblambdanative/system.c @@ -1,6 +1,6 @@ /* LambdaNative - a cross-platform Scheme framework -Copyright (c) 2009-2015, University of British Columbia +Copyright (c) 2009-2020, University of British Columbia All rights reserved. Redistribution and use in source and binary forms, with or @@ -150,10 +150,11 @@ static void find_directories() #endif #if defined(ANDROID) // we put files on the sdcard, that's the only sane place (?) + extern char* android_getFilesDir(); char path[1024]; sprintf(path,"/sdcard/%s", SYS_APPNAME); - sys_appdir=strdup(path); sys_dir=strdup(path); + sys_appdir=android_getFilesDir(); #endif #if defined(BB10) || defined(PLAYBOOK) char path[1024], cwd[1024]; diff --git a/loaders/android/bootstrap.c.in b/loaders/android/bootstrap.c.in index 267670d3..c36746c1 100644 --- a/loaders/android/bootstrap.c.in +++ b/loaders/android/bootstrap.c.in @@ -1,6 +1,6 @@ /* LambdaNative - a cross-platform Scheme framework -Copyright (c) 2009-2013, University of British Columbia +Copyright (c) 2009-2020, University of British Columbia All rights reserved. Redistribution and use in source and binary forms, with or @@ -62,9 +62,22 @@ void Java_@SYS_PACKAGE_UNDERSCORE@_@SYS_APPNAME@_nativeEvent(JNIEnv* e, jobject // JNI Hooks and Global Objects static jobject globalObj=NULL; static JavaVM* s_vm = NULL; +static const char* app_directory_files = NULL; +static const char* app_code_path = NULL; + +void Java_@SYS_PACKAGE_UNDERSCORE@_@SYS_APPNAME@_nativeInstanceInit(JNIEnv* env, jobject thiz, jstring codePath, jstring directoryFiles){ + globalObj = (*env)->NewGlobalRef(env,thiz); + app_directory_files = strdup((*env)->GetStringUTFChars(env, directoryFiles, 0)); + (*env)->ReleaseStringUTFChars(env, directoryFiles, NULL); + app_code_path = strdup((*env)->GetStringUTFChars(env, codePath, 0)); + (*env)->ReleaseStringUTFChars(env, codePath, NULL); +} -void Java_@SYS_PACKAGE_UNDERSCORE@_@SYS_APPNAME@_nativeInstanceInit(JNIEnv* env, jobject thiz){ - globalObj = (*env)->NewGlobalRef(env,thiz); +char* android_getFilesDir() { + return (char*) app_directory_files; +} +char* android_getPackageCodePath() { + return (char*) app_code_path; } jint JNI_OnLoad(JavaVM* vm, void* reserved){ diff --git a/loaders/android/bootstrap.java.in b/loaders/android/bootstrap.java.in index 315db186..54f734c1 100644 --- a/loaders/android/bootstrap.java.in +++ b/loaders/android/bootstrap.java.in @@ -182,7 +182,7 @@ public class @SYS_APPNAME@ extends Activity implements @ANDROID_JAVA_IMPLEMENTS@ getWindow().addFlags(WindowManager.LayoutParams.FLAG_KEEP_SCREEN_ON); mGLView = new xGLSurfaceView(this); // This may better before other pieces - nativeInstanceInit(); + nativeInstanceInit(getApplicationContext().getPackageCodePath().toString(), getFilesDir().toString()); mSensorManager = (SensorManager)getSystemService(Context.SENSOR_SERVICE); checkOrRequestPermission(android.Manifest.permission.WRITE_EXTERNAL_STORAGE); @@ -257,7 +257,7 @@ public class @SYS_APPNAME@ extends Activity implements @ANDROID_JAVA_IMPLEMENTS@ } } - native void nativeInstanceInit(); + native void nativeInstanceInit(String packageCodePath, String filesDir); } class xGLSurfaceView extends GLSurfaceView { diff --git a/modules/config/config.scm b/modules/config/config.scm index 6880f1da..955d4ade 100644 --- a/modules/config/config.scm +++ b/modules/config/config.scm @@ -42,9 +42,22 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (c-declare #< Date: Mon, 9 Nov 2020 03:28:07 -0800 Subject: [PATCH 10/26] ANDROID: Additional error checking on JNI #386 1) Android 9/10 restricts access to JNI and Jave reflection API's. This adds additional checks. Commented out an possible optimization, which could be assumed to works, but does not for me so far. Please leave this comment in, so we recall before we wonder why and try over and over again. Once in a while we should ponder if it still does not work or why. 2) Clear Java exceptions. This enables to continue to run when an exception occured during a JNI call. (Future versions shall forward this as an exception in Gambit.) --- loaders/android/bootstrap.c.in | 28 +++++++++++++++++++++++----- 1 file changed, 23 insertions(+), 5 deletions(-) diff --git a/loaders/android/bootstrap.c.in b/loaders/android/bootstrap.c.in index c36746c1..6da97bdd 100644 --- a/loaders/android/bootstrap.c.in +++ b/loaders/android/bootstrap.c.in @@ -90,19 +90,37 @@ jint JNI_OnLoad(JavaVM* vm, void* reserved){ JNIEnv* GetJNIEnv(){ int error=0; JNIEnv* env = NULL; - if (s_vm) error=(*s_vm)->AttachCurrentThread(s_vm, &env, NULL); - if (!error&&(*env)->ExceptionCheck(env)) return NULL; + /* static `env` does NOT work! Once in a while we should ponder if + it still does not work or why. + + if(env) { + if((*env)->ExceptionCheck(env)) (*env)->ExceptionClear(env); + return env; + } + */ + if(s_vm) error=(*s_vm)->AttachCurrentThread(s_vm, &env, NULL); + if(!error) error = JNI_forward_exception_to_gambit(env); return (error?NULL:env); } +int JNI_forward_exception_to_gambit(JNIEnv*env) { + // TBD: actually forward, not only clear! + if((*env)->ExceptionCheck(env)) { + (*env)->ExceptionClear(env); + return 1; + } + return 0; +} + // url launcher ffi void android_launch_url(char* urlstring){ JNIEnv *env = GetJNIEnv(); - jstring jurlstring = (*env)->NewStringUTF(env,urlstring); if (env&&globalObj) { + jstring jurlstring = (*env)->NewStringUTF(env,urlstring); jclass cls = (*env)->FindClass(env, "@SYS_PACKAGE_SLASH@/@SYS_APPNAME@"); - jmethodID method = (*env)->GetMethodID(env, cls, "openURL", "(Ljava/lang/String;)V"); - (*env)->CallVoidMethod(env, globalObj, method, jurlstring); + jmethodID method = cls ? (*env)->GetMethodID(env, cls, "openURL", "(Ljava/lang/String;)V") : NULL; + if (method) (*env)->CallVoidMethod(env, globalObj, method, jurlstring); + JNI_forward_exception_to_gambit(env); } } From 7561c9a28036d5d7b92c4078fdd3ea1f924992d7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Matthias=20G=C3=B6rges?= Date: Mon, 9 Nov 2020 03:56:58 -0800 Subject: [PATCH 11/26] ANDROID: ReleaseStringUTFChars doesn't allow NULL as final arg --- loaders/android/bootstrap.c.in | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/loaders/android/bootstrap.c.in b/loaders/android/bootstrap.c.in index 6da97bdd..748c2cb3 100644 --- a/loaders/android/bootstrap.c.in +++ b/loaders/android/bootstrap.c.in @@ -67,10 +67,10 @@ static const char* app_code_path = NULL; void Java_@SYS_PACKAGE_UNDERSCORE@_@SYS_APPNAME@_nativeInstanceInit(JNIEnv* env, jobject thiz, jstring codePath, jstring directoryFiles){ globalObj = (*env)->NewGlobalRef(env,thiz); - app_directory_files = strdup((*env)->GetStringUTFChars(env, directoryFiles, 0)); - (*env)->ReleaseStringUTFChars(env, directoryFiles, NULL); + app_directory_files = strdup((*env)->GetStringUTFChars(env, directoryFiles, 0)); + (*env)->ReleaseStringUTFChars(env, directoryFiles, app_directory_files); app_code_path = strdup((*env)->GetStringUTFChars(env, codePath, 0)); - (*env)->ReleaseStringUTFChars(env, codePath, NULL); + (*env)->ReleaseStringUTFChars(env, codePath, app_code_path); } char* android_getFilesDir() { From cbea39ae461c053576c0f0392600e754bdabc41d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Matthias=20G=C3=B6rges?= Date: Thu, 12 Nov 2020 17:23:12 -0800 Subject: [PATCH 12/26] LN_GLCORE Fix bug introduced in 9b3d9e3 when using multiple colors Problem stems from conversion of apply to case-based approach which didn't consider that colors in glCore:TextureDrawUnClipped is now a list of lists. Also patched glCore:TextureDrawClipped --- modules/ln_glcore/glcore.scm | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/modules/ln_glcore/glcore.scm b/modules/ln_glcore/glcore.scm index 79c0e37a..4b030d89 100644 --- a/modules/ln_glcore/glcore.scm +++ b/modules/ln_glcore/glcore.scm @@ -298,15 +298,15 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (glCoreVertex2f w2 h2 @x2 @y2) (glCoreVertex2f (fl- w2) (fl- h2) @x1 @y1) (glCoreVertex2f w2 (fl- h2) @x2 @y1) - )(begin - (glCoreColor (car colors)) - (glCoreVertex2f (fl- w2) h2 @x1 @y2) - (glCoreColor (cadr colors)) - (glCoreVertex2f w2 h2 @x2 @y2) - (glCoreColor (caddr colors)) - (glCoreVertex2f (fl- w2) (fl- h2) @x1 @y1) - (glCoreColor (cadddr colors)) - (glCoreVertex2f w2 (fl- h2) @x2 @y1) + )(let ((colors (list->vector (car colors)))) + (glCoreColor (vector-ref colors 0)) + (glCoreVertex2f (fl- w2) h2 @x1 @y2) + (glCoreColor (vector-ref colors 1)) + (glCoreVertex2f w2 h2 @x2 @y2) + (glCoreColor (vector-ref colors 2)) + (glCoreVertex2f (fl- w2) (fl- h2) @x1 @y1) + (glCoreColor (vector-ref colors 3)) + (glCoreVertex2f w2 (fl- h2) @x2 @y1) )) (glCoreEnd) (glPopMatrix) @@ -341,7 +341,7 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (glCoreVertex2f (fl- cw2) (fl- ch2) c@x1 c@y1) (glCoreVertex2f cw2 (fl- ch2) c@x2 c@y1) ) - (let ((colors (list->vector colors))) + (let ((colors (list->vector (car colors)))) ;; TODO: color interpolation here! (glCoreColor (vector-ref colors 0)) (glCoreVertex2f (fl- cw2) ch2 c@x1 c@y2) From 1f656d14928cb489d2b6e2211f9d895a8d06a95a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Matthias=20G=C3=B6rges?= Date: Fri, 13 Nov 2020 10:25:06 -0800 Subject: [PATCH 13/26] SERIAL: Change Android methods calls as needed per c2585dc --- modules/serial/ANDROID_c_additions | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/modules/serial/ANDROID_c_additions b/modules/serial/ANDROID_c_additions index 608106a8..327dcd76 100644 --- a/modules/serial/ANDROID_c_additions +++ b/modules/serial/ANDROID_c_additions @@ -82,7 +82,7 @@ void serial_writechar(int dev, int val){ JNIEnv *env = GetJNIEnv(); if (env&&serial_object) { serial_timeout_set(0); - (*env)->CallIntMethod(env,serial_object, s_serial_writechar, dev, val); + (*env)->CallVoidMethod(env,serial_object, s_serial_writechar, dev, val); } } int serial_readchar(int dev){ @@ -115,7 +115,7 @@ void serial_flush(int dev){ } JNIEnv *env = GetJNIEnv(); if (env&&serial_object) { - (*env)->CallIntMethod(env,serial_object, s_serial_flush, dev); + (*env)->CallVoidMethod(env,serial_object, s_serial_flush, dev); } } int serial_getDTR(int dev){ @@ -136,7 +136,7 @@ void serial_setDTR(int dev, int val){ } JNIEnv *env = GetJNIEnv(); if (env&&serial_object) { - (*env)->CallIntMethod(env,serial_object, s_serial_setdtr, dev, val); + (*env)->CallVoidMethod(env,serial_object, s_serial_setdtr, dev, val); } } int serial_getRTS(int dev){ @@ -157,7 +157,7 @@ void serial_setRTS(int dev, int val){ } JNIEnv *env = GetJNIEnv(); if (env&&serial_object) { - (*env)->CallIntMethod(env,serial_object, s_serial_setrts, dev, val); + (*env)->CallVoidMethod(env,serial_object, s_serial_setrts, dev, val); } } int serial_openfile(char *filepath){ From 5b3e1ad1e47b32eaac8761cbc3b0bc904b7b9ff3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=B6rg=20F=2E=20Wittenberger?= Date: Mon, 2 Nov 2020 11:26:22 +0100 Subject: [PATCH 14/26] ANDROID: additional error checking on JNI an more 1.) Android 9/10 restricts access to JNI and Jave reflection API's. This adds additional checks. Commented out an possible optimization, which could be assumed to works, but does not for me so far. Please leave this comment in, so we recall before we wonder why and try over and over again. Once in a while we should ponder if it still does not work or why. 2.) Clear Java exceptions. This enables to continue to run when an exception occured during a JNI call. (Future versions shall forward this as an exception in Gambit.) 3.) Avoid some JNI calls and provide more information about the Java/Android environment to Scheme. This is required for (upcoming) tricks to still call embedded dynamic libraries as subprocesses. It also enables to figure out a sane path to store app-private data instead of the deprecated hard coding of the publicly accessible path `/sdcard`. 4.) Add support to switch the apps content view to Java and back. An upcoming module `webview` will need this. --- loaders/android/bootstrap.c.in | 26 +++++++------- loaders/android/bootstrap.java.in | 57 +++++++++++++++++++++---------- modules/config/config.scm | 1 + 3 files changed, 52 insertions(+), 32 deletions(-) diff --git a/loaders/android/bootstrap.c.in b/loaders/android/bootstrap.c.in index 748c2cb3..cec9df39 100644 --- a/loaders/android/bootstrap.c.in +++ b/loaders/android/bootstrap.c.in @@ -51,12 +51,12 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. // event hook void Java_@SYS_PACKAGE_UNDERSCORE@_myRenderer_nativeEvent(JNIEnv* e, jobject o, jint t, jint x, jint y){ if ((*e)->ExceptionCheck(e)) return; - ffi_event((int)t,(int)x,(int)y); + ffi_event((int)t,(int)x,(int)y); } void Java_@SYS_PACKAGE_UNDERSCORE@_@SYS_APPNAME@_nativeEvent(JNIEnv* e, jobject o, jint t, jint x, jint y){ if ((*e)->ExceptionCheck(e)) return; - ffi_event((int)t,(int)x,(int)y); + ffi_event((int)t,(int)x,(int)y); } // JNI Hooks and Global Objects @@ -66,19 +66,18 @@ static const char* app_directory_files = NULL; static const char* app_code_path = NULL; void Java_@SYS_PACKAGE_UNDERSCORE@_@SYS_APPNAME@_nativeInstanceInit(JNIEnv* env, jobject thiz, jstring codePath, jstring directoryFiles){ + globalObj = (*env)->NewGlobalRef(env,thiz); - app_directory_files = strdup((*env)->GetStringUTFChars(env, directoryFiles, 0)); - (*env)->ReleaseStringUTFChars(env, directoryFiles, app_directory_files); + app_directory_files = strdup((*env)->GetStringUTFChars(env, directoryFiles, 0)); + (*env)->ReleaseStringUTFChars(env, directoryFiles, NULL); app_code_path = strdup((*env)->GetStringUTFChars(env, codePath, 0)); - (*env)->ReleaseStringUTFChars(env, codePath, app_code_path); + (*env)->ReleaseStringUTFChars(env, codePath, NULL); } -char* android_getFilesDir() { - return (char*) app_directory_files; -} -char* android_getPackageCodePath() { - return (char*) app_code_path; -} +char* android_getFilesDir() { return (char*) app_directory_files; } +char* android_getPackageCodePath() { return (char*) app_code_path; } + +char* android_getFilesDir_info_get() { return android_getFilesDir(); } jint JNI_OnLoad(JavaVM* vm, void* reserved){ JNIEnv *env; @@ -116,14 +115,13 @@ int JNI_forward_exception_to_gambit(JNIEnv*env) { void android_launch_url(char* urlstring){ JNIEnv *env = GetJNIEnv(); if (env&&globalObj) { - jstring jurlstring = (*env)->NewStringUTF(env,urlstring); + jstring jurlstring = (*env)->NewStringUTF(env, urlstring); jclass cls = (*env)->FindClass(env, "@SYS_PACKAGE_SLASH@/@SYS_APPNAME@"); jmethodID method = cls ? (*env)->GetMethodID(env, cls, "openURL", "(Ljava/lang/String;)V") : NULL; - if (method) (*env)->CallVoidMethod(env, globalObj, method, jurlstring); + if(method) (*env)->CallVoidMethod(env, globalObj, method, jurlstring); JNI_forward_exception_to_gambit(env); } } // Add code here if needed for modules, such as GPS. @ANDROID_C_ADDITIONS@ - diff --git a/loaders/android/bootstrap.java.in b/loaders/android/bootstrap.java.in index 54f734c1..fa1c8cc5 100644 --- a/loaders/android/bootstrap.java.in +++ b/loaders/android/bootstrap.java.in @@ -138,6 +138,27 @@ public class @SYS_APPNAME@ extends Activity implements @ANDROID_JAVA_IMPLEMENTS@ } } + private android.view.View current_ContentView = null; + @Override + public void setContentView(android.view.View view) { + if(current_ContentView != view) { + // Note: this is a bit brain deas as it ONLY handles GLSurfaceView + if(current_ContentView instanceof android.opengl.GLSurfaceView) { + ((android.opengl.GLSurfaceView)current_ContentView).onPause(); + } + android.view.ViewParent parent0 = view.getParent(); + if(parent0 instanceof android.view.ViewGroup) { + android.view.ViewGroup parent = (android.view.ViewGroup) parent0; + if(parent!=null) { parent.removeView(current_ContentView); } + } + current_ContentView = view; + super.setContentView(current_ContentView); + if(current_ContentView instanceof android.opengl.GLSurfaceView) { + ((android.opengl.GLSurfaceView)current_ContentView).onResume(); + } + } + } + @Override public void setContentView(android.view.View view) { if(current_ContentView != view) { @@ -167,13 +188,13 @@ public class @SYS_APPNAME@ extends Activity implements @ANDROID_JAVA_IMPLEMENTS@ new Thread.UncaughtExceptionHandler() { public void uncaughtException(Thread t, Throwable e) { final String TAG = "@SYS_PACKAGE_DOT@"; - Log.e(TAG, e.toString()); + Log.e(TAG, e.toString()); try { Thread.sleep(1000); } catch (Exception ex) { } System.exit(1); } }); setRequestedOrientation(ActivityInfo.SCREEN_ORIENTATION_PORTRAIT); - this.requestWindowFeature(Window.FEATURE_NO_TITLE); + this.requestWindowFeature(Window.FEATURE_NO_TITLE); // make sure volume controls control media this.setVolumeControlStream(AudioManager.STREAM_MUSIC); getWindow().setFlags(WindowManager.LayoutParams.FLAG_FULLSCREEN, @@ -191,10 +212,12 @@ public class @SYS_APPNAME@ extends Activity implements @ANDROID_JAVA_IMPLEMENTS@ // Additions needed by modules, e.g. gps @ANDROID_JAVA_ONCREATE@ - // start EVENT_IDLE + nativeInstanceInit(getApplicationContext().getPackageCodePath().toString(), getFilesDir().toString()); + // start EVENT_IDLE + setContentView(mGLView); // MUST NOT run before nativeInstanceInit completed if(idle_tmScheduleRate > 0) idle_tm.scheduleAtFixedRate(idle_task, 0, idle_tmScheduleRate); } - @Override + @Override protected void onDestroy() { setContentView(mGLView); @ANDROID_JAVA_ONDESTROY@ @@ -218,9 +241,7 @@ public class @SYS_APPNAME@ extends Activity implements @ANDROID_JAVA_IMPLEMENTS@ @Override protected void onResume() { super.onResume(); - if(current_ContentView==mGLView) { - mGLView.onResume(); - } + if(current_ContentView==mGLView) { mGLView.onResume(); } // Additions needed by modules, e.g. gps @ANDROID_JAVA_ONRESUME@ } @@ -263,7 +284,7 @@ public class @SYS_APPNAME@ extends Activity implements @ANDROID_JAVA_IMPLEMENTS@ class xGLSurfaceView extends GLSurfaceView { public xGLSurfaceView(Context context) { super(context); - setFocusable(true); + setFocusable(true); setFocusableInTouchMode(true); renderer = new myRenderer(); setRenderer(renderer); @@ -278,23 +299,23 @@ class xGLSurfaceView extends GLSurfaceView { case MotionEvent.ACTION_UP: t=4; break; case MotionEvent.ACTION_POINTER_UP: t=4; break; } - if (t>0) { + if (t>0) { final int n=event.getPointerCount(); final int t0=t; final int id0=event.getPointerId(0); final int x0=(int)event.getX(0); final int y0=(int)event.getY(0); if (n>1) { // MultiTouch - queueEvent(new Runnable(){ public void run() { renderer.pointerEvent(18,id0,0); }}); + queueEvent(new Runnable(){ public void run() { renderer.pointerEvent(18,id0,0); }}); } - queueEvent(new Runnable(){ public void run() { renderer.pointerEvent(t0,x0,y0); }}); + queueEvent(new Runnable(){ public void run() { renderer.pointerEvent(t0,x0,y0); }}); if (n>1) { // MultiTouch final int id1=event.getPointerId(1); final int x1=(int)event.getX(1); final int y1=(int)event.getY(1); - queueEvent(new Runnable(){ public void run() { renderer.pointerEvent(18,id1,0); }}); - queueEvent(new Runnable(){ public void run() { renderer.pointerEvent(t0,x1,y1); }}); - } + queueEvent(new Runnable(){ public void run() { renderer.pointerEvent(18,id1,0); }}); + queueEvent(new Runnable(){ public void run() { renderer.pointerEvent(t0,x1,y1); }}); + } } return true; } @@ -332,7 +353,7 @@ class xGLSurfaceView extends GLSurfaceView { } if (t>0) { queueEvent(new Runnable(){ public void run() { - renderer.nativeEvent(t,x,y); }}); + renderer.nativeEvent(t,x,y); }}); } return true; } @@ -348,15 +369,15 @@ class xGLSurfaceView extends GLSurfaceView { myRenderer renderer; } class myRenderer implements GLSurfaceView.Renderer { - public void onSurfaceCreated(GL10 gl, EGLConfig config) { + public void onSurfaceCreated(GL10 gl, EGLConfig config) { } public void onSurfaceChanged(GL10 gl, int w, int h) { gl.glViewport(0, 0, w, h); width=(float)w; height=(float)h; nativeEvent(127,w,h); // EVENT_INIT } - public void onDrawFrame(GL10 gl) { - nativeEvent(15,0,0); // EVENT_REDRAW + public void onDrawFrame(GL10 gl) { + nativeEvent(15,0,0); // EVENT_REDRAW } public void pointerEvent(int t, int x, int y) { nativeEvent(t,x,(int)height-y); } public float width,height; diff --git a/modules/config/config.scm b/modules/config/config.scm index 955d4ade..8cdd2bc4 100644 --- a/modules/config/config.scm +++ b/modules/config/config.scm @@ -109,6 +109,7 @@ end-of-c-declare ;; Gain access to Android app_directory_files and app_code_path (define android-get-filesdir (c-lambda () char-string "android_getFilesDir")) +(c-declare "extern char* android_getPackageCodePath();") (define android-get-codepath (c-lambda () char-string "android_getPackageCodePath")) ;; eof From 4aeb1cc93bc57f9bf8c3d5d461a556c63862983d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=B6rg=20F=2E=20Wittenberger?= Date: Mon, 2 Nov 2020 12:00:15 +0100 Subject: [PATCH 15/26] LNjSCHEME: new module lnjscheme - call any Androi API without JNI Any not-so-time-critical Android API/Java Method - except those restricted Android itself may be called without adding JNI code. --- .gitignore | 3 +- LNCONFIG.h.in | 1 + modules/eventloop/eventloop.scm | 5 +- modules/lnjscheme/ANDROID_c_additions | 71 ++ .../lnjscheme/ANDROID_java_activityadditions | 160 ++++ modules/lnjscheme/ANDROID_java_additions | 16 + modules/lnjscheme/ANDROID_java_oncreate | 126 ++++ modules/lnjscheme/LNjScheme/Closure.java | 28 + modules/lnjscheme/LNjScheme/Continuation.java | 17 + modules/lnjscheme/LNjScheme/Environment.java | 99 +++ modules/lnjscheme/LNjScheme/InputPort.java | 210 ++++++ modules/lnjscheme/LNjScheme/JavaMethod.java | 251 ++++++ modules/lnjscheme/LNjScheme/Macro.java | 33 + modules/lnjscheme/LNjScheme/Pair.java | 64 ++ modules/lnjscheme/LNjScheme/Primitive.java | 714 ++++++++++++++++++ modules/lnjscheme/LNjScheme/Procedure.java | 20 + modules/lnjscheme/LNjScheme/Scheme.java | 150 ++++ .../lnjscheme/LNjScheme/SchemePrimitives.java | 158 ++++ modules/lnjscheme/LNjScheme/SchemeUtils.java | 314 ++++++++ modules/lnjscheme/LNjScheme/primitives.scm | 146 ++++ modules/lnjscheme/MODULES | 1 + modules/lnjscheme/Makefile | 8 + modules/lnjscheme/README.md | 69 ++ modules/lnjscheme/lnjscheme.scm | 117 +++ 24 files changed, 2779 insertions(+), 2 deletions(-) create mode 100644 modules/lnjscheme/ANDROID_c_additions create mode 100644 modules/lnjscheme/ANDROID_java_activityadditions create mode 100644 modules/lnjscheme/ANDROID_java_additions create mode 100644 modules/lnjscheme/ANDROID_java_oncreate create mode 100644 modules/lnjscheme/LNjScheme/Closure.java create mode 100644 modules/lnjscheme/LNjScheme/Continuation.java create mode 100644 modules/lnjscheme/LNjScheme/Environment.java create mode 100644 modules/lnjscheme/LNjScheme/InputPort.java create mode 100644 modules/lnjscheme/LNjScheme/JavaMethod.java create mode 100644 modules/lnjscheme/LNjScheme/Macro.java create mode 100644 modules/lnjscheme/LNjScheme/Pair.java create mode 100644 modules/lnjscheme/LNjScheme/Primitive.java create mode 100644 modules/lnjscheme/LNjScheme/Procedure.java create mode 100644 modules/lnjscheme/LNjScheme/Scheme.java create mode 100644 modules/lnjscheme/LNjScheme/SchemePrimitives.java create mode 100644 modules/lnjscheme/LNjScheme/SchemeUtils.java create mode 100644 modules/lnjscheme/LNjScheme/primitives.scm create mode 100644 modules/lnjscheme/MODULES create mode 100644 modules/lnjscheme/Makefile create mode 100644 modules/lnjscheme/README.md create mode 100644 modules/lnjscheme/lnjscheme.scm diff --git a/.gitignore b/.gitignore index 7d8dce2b..2465be5c 100644 --- a/.gitignore +++ b/.gitignore @@ -7,11 +7,12 @@ Thumbs.db tmp.* *.core *.o +*.class +*.jar *.o2 *.a *.old* *.bak* -*.org* *.orig* xx_* SETUP diff --git a/LNCONFIG.h.in b/LNCONFIG.h.in index f853b537..0ca7c34e 100644 --- a/LNCONFIG.h.in +++ b/LNCONFIG.h.in @@ -64,6 +64,7 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define EVENT_DEBUG 64 +#define EVENT_JSCM_RESULT 126 #define EVENT_INIT 127 #define EVENT_TERMINATE 128 diff --git a/modules/eventloop/eventloop.scm b/modules/eventloop/eventloop.scm index ae7f28cf..bd3c9bbf 100644 --- a/modules/eventloop/eventloop.scm +++ b/modules/eventloop/eventloop.scm @@ -75,6 +75,7 @@ end-of-c-declare (define EVENT_BUTTON3DOWN ((c-lambda () int "___result = EVENT_BUTTON3DOWN;"))) (define EVENT_CLOSE ((c-lambda () int "___result = EVENT_CLOSE;"))) (define EVENT_REDRAW ((c-lambda () int "___result = EVENT_REDRAW;"))) +(define EVENT_JSCM_RESULT ((c-lambda () int "___result = EVENT_JSCM_RESULT;"))) (define EVENT_INIT ((c-lambda () int "___result = EVENT_INIT;"))) (define EVENT_TERMINATE ((c-lambda () int "___result = EVENT_TERMINATE;"))) (define EVENT_BATTERY ((c-lambda () int "___result = EVENT_BATTERY;"))) @@ -179,7 +180,9 @@ end-of-c-declare ;; handle potential scaling (running stretched on a device) (hook:event t (if app:scale? (fix (* app:xscale x)) x) (if app:scale? (fix (* app:yscale y)) y)) - ) + ) + ((fx= t EVENT_JSCM_RESULT) + (if (function-exists? LNjScheme-result) (LNjScheme-result))) ((fx= t EVENT_INIT) ;; prevent multiple inits (if app:mustinit (begin diff --git a/modules/lnjscheme/ANDROID_c_additions b/modules/lnjscheme/ANDROID_c_additions new file mode 100644 index 00000000..b846a90f --- /dev/null +++ b/modules/lnjscheme/ANDROID_c_additions @@ -0,0 +1,71 @@ +/* -*-C-*- */ + +const char* android_app_class() { return "@SYS_PACKAGE_DOT@.@SYS_APPNAME@"; } // for jscheme + +/* lnjscheme_eval + * + * Evaluate input and return result. Due to Android limitations + * wrt. thread and evaluation context, calls might fail. E.g., Views + * may only be changed by the Java thread which created them. Use the + * asynchronous version in those cases. + */ +const char* lnjscheme_eval(const char* input) +{ + static const char *str = NULL; + static jstring jstr = NULL; + JNIEnv *env = GetJNIEnv(); + if (env&&globalObj){ + jstring jin = (*env)->NewStringUTF(env,input); + jclass main_class = (*env)->FindClass(env, "@SYS_PACKAGE_SLASH@/@SYS_APPNAME@"); + jmethodID method = main_class ? (*env)->GetMethodID(env, main_class, "LNjSchemeCall", "(Ljava/lang/String;)Ljava/lang/String;") : NULL; + if(!method && JNI_forward_exception_to_gambit(env)) { + return "E \"JNI: method LNjSchemeCall not found\""; + } + if(jstr) { (*env)->ReleaseStringUTFChars(env, jstr, str); jstr = NULL; } // works? + jstr = (jstring) method ? (*env)->CallObjectMethod(env, globalObj, method, jin) : NULL; + // Is this required??? (*env)->ReleaseStringUTFChars(env, jin, NULL); + str = jstr ? (*env)->GetStringUTFChars(env, jstr, 0) : NULL; + // (*env)->ReleaseStringUTFChars(env, jstr, NULL); // we do it upon next call + } + return str; +} + +void lnjscheme_eval_send(const char* input) +{ + JNIEnv *env = GetJNIEnv(); + if (env&&globalObj){ + jclass main_class = (*env)->FindClass(env, "@SYS_PACKAGE_SLASH@/@SYS_APPNAME@"); + jmethodID method = main_class ? (*env)->GetMethodID(env, main_class, "LNjSchemeSend", "(Ljava/lang/String;)V") : NULL; + if(!method && JNI_forward_exception_to_gambit(env)) { + return; // "E \"JNI: method LNjSchemeSend not found\""; + } else { + jstring jin = (*env)->NewStringUTF(env,input); + (*env)->CallVoidMethod(env, globalObj, method, jin); + (*env)->ReleaseStringUTFChars(env, jin, NULL); + JNI_forward_exception_to_gambit(env); + } + } +} + +// There is likely a way to do this better using only a Java->C call +// to deposit the result in a global variable. I just don't know yet +// how to do this. +const char* lnjscheme_eval_receive_result() +{ + static const char *str = NULL; + static jstring jstr = NULL; + JNIEnv *env = GetJNIEnv(); + if (env&&globalObj){ + if(jstr) { (*env)->ReleaseStringUTFChars(env, jstr, str); jstr = NULL; } // works? + jclass main_class = (*env)->FindClass(env, "@SYS_PACKAGE_SLASH@/@SYS_APPNAME@"); + jmethodID method = main_class ? (*env)->GetMethodID(env, main_class, "LNjSchemeResult", "()Ljava/lang/String;") : NULL; + if(!method && JNI_forward_exception_to_gambit(env)) { + return "E \"JNI: method LNjSchemeResult not found\""; + } else { + jstr = (jstring) method ? (*env)->CallObjectMethod(env, globalObj, method) : NULL; + str = jstr ? (*env)->GetStringUTFChars(env, jstr, 0) : NULL; + // (*env)->ReleaseStringUTFChars(env, jstr, NULL); // we do it upon next call + } + } + return str; +} diff --git a/modules/lnjscheme/ANDROID_java_activityadditions b/modules/lnjscheme/ANDROID_java_activityadditions new file mode 100644 index 00000000..d8a64863 --- /dev/null +++ b/modules/lnjscheme/ANDROID_java_activityadditions @@ -0,0 +1,160 @@ +/* LNjScheme -*- mode: java; c-basic-offset: 2; -*- */ + +/* # Helper methods */ + +java.text.SimpleDateFormat ln_log_date_formatter = new java.text.SimpleDateFormat("yyyy-MM-dd HH:mm:ss "); + +String TAG = "@SYS_APPNAME@"; + +public void ln_log(String msg) { + String m = ln_log_date_formatter.format(new java.util.Date()) + msg; + System.err.println(TAG + ": " + m); + Log.d(TAG, m); +} + +private Object onBackPressedHandler = null; + +@Override +public void onBackPressed() { + if(onBackPressedHandler!=null) { + LNjSchemeEvaluate(LNjScheme.Scheme.list(onBackPressedHandler)); + } + else { super.onBackPressed(); } +} + + +/* LNjScheme_Set_OnClickListener: register a LNjScheme lambda to be called when the View is clicked. + * + * LNjScheme can not (yet) declare annonymous derived classes. (Or at + * least I don't know how that could be done.) + * + * For the time being we get along with a little Java. + */ +private android.view.View.OnClickListener LNjScheme_OnClickListener(final Object proc) { + return new android.view.View.OnClickListener() { + public void onClick(android.view.View v) { + LNjSchemeEvaluate(new LNjScheme.Pair(proc, new LNjScheme.Pair(v, null))); + } + }; +} +public void LNjScheme_Set_OnClickListener(android.view.View v, Object expr) { + v.setOnClickListener(LNjScheme_OnClickListener(expr)); +} + +/* # LNjScheme core */ + +private static LNjScheme.Scheme LNjSchemeSession = null; + +private Object LNjSchemeEvaluateNoSync(Object expr) { + // NOT synchronized, be careful where to use it! + if(LNjSchemeSession != null) { + return LNjSchemeSession.eval(expr); + } else return null; +} + +public Object LNjSchemeEvaluate(Object expr) { + // sync with the one and only evaluator supported so far. + if(LNjSchemeSession != null) { + synchronized(LNjSchemeSession) { + return LNjSchemeSession.eval(expr); + } + } else return null; +} + +/* jschemeCall: evaluate `msg` in any Java thread and return result + * + * FIXME TBD CHECK: This was the initial implementation, but might be broken now. + */ +public String LNjSchemeCall(String msg) { + // BEWARE: Operations not safe to be called asynchronously from + // any thread, not safe to be called from various contexts (e.g., + // within "onDrawFrame" which amounts to "while reacting to + // EVENT_REDRAW"), etc. MAY HANG here. + // + // If you need fast execution and know the call is safe use this + // one. Otherwise use the two-phased version using + // `LNjSchemeSend` followed by a `LNjSchemeResult to dispatch the + // evaluation to `runOnUiThread` and wait for it to be eventually + // evaluated in a more-or-less safe context. + try { + LNjScheme.InputPort in = new LNjScheme.InputPort(new java.io.ByteArrayInputStream(msg.getBytes(java.nio.charset.Charset.forName("UTF-8")))); + Object expr = in.read(); + if(in.isEOF(expr)) return "E\n\"invalid input\""; + Object result = LNjSchemeEvaluate(expr); + java.io.StringWriter buf = new java.io.StringWriter(); + java.io.PrintWriter port = new java.io.PrintWriter(buf); + port.println("D"); + LNjScheme.SchemeUtils.write(result, port, true); + return buf.toString(); + } catch (Exception e) { + java.io.StringWriter buf = new java.io.StringWriter(); + java.io.PrintWriter port = new java.io.PrintWriter(buf); + port.println("E"); + LNjScheme.SchemeUtils.write(("" + e).toCharArray(), port, true); + return buf.toString(); + } +} + +/* LNjSchemeSend: send string for evaluation to Java app main thread. + * + * LNjSchemeResult: receive evaluation result from Java app main thread. + */ + +private java.util.concurrent.FutureTask LNjSchemeJob = null; + +public void LNjSchemeSend(String msg) { + final LNjScheme.InputPort in = new LNjScheme.InputPort(new java.io.ByteArrayInputStream(msg.getBytes(java.nio.charset.Charset.forName("UTF-8")))); + final Object expr = in.read(); + // Object result = LNjSchemeEvaluate(expr); + java.util.concurrent.FutureTask job = new java.util.concurrent.FutureTask + (new java.util.concurrent.Callable() { + @Override + public Object call() throws Exception { + // ln_log("invocation of " + this + " evaluating."); + if(in.isEOF(expr)) throw new Exception("invalid input"); + return LNjSchemeEvaluate(expr); } + }); + // ln_log("Sending to UI: " + job + " for: " + expr); + LNjSchemeJob = job; + new Thread() { + @Override + public void run() { + // ln_log("LNjScheme waiting for completion"); + try { + LNjSchemeJob.get(); + } catch (Exception e) { // InterruptedException java.util.concurrent.ExecutionException + // FIXME: Do something sensible here! + } + // ln_log("LNjScheme notifying result"); + nativeEvent(126,0,0); + } + }.start(); + runOnUiThread(job); +} + +public String LNjSchemeResult() { + try { + Object result = LNjSchemeJob != null ? LNjSchemeJob.get() : null; + LNjSchemeJob = null; + // ln_log("got result from UI"); + java.io.StringWriter buf = new java.io.StringWriter(); + java.io.PrintWriter port = new java.io.PrintWriter(buf); + port.println("D"); + LNjScheme.SchemeUtils.write(result, port, true); + return buf.toString(); + } catch (java.util.concurrent.ExecutionException e) { + // ln_log("got error from call"); + java.io.StringWriter buf = new java.io.StringWriter(); + java.io.PrintWriter port = new java.io.PrintWriter(buf); + port.println("E"); + LNjScheme.SchemeUtils.write(("" + e.getCause()).toCharArray(), port, true); + return buf.toString(); + } catch (Exception e) { + // ln_log("got exception from call"); + java.io.StringWriter buf = new java.io.StringWriter(); + java.io.PrintWriter port = new java.io.PrintWriter(buf); + port.println("E"); + LNjScheme.SchemeUtils.write(("LNjScheme unexpected exception: " + e).toCharArray(), port, true); + return buf.toString(); + } +} diff --git a/modules/lnjscheme/ANDROID_java_additions b/modules/lnjscheme/ANDROID_java_additions new file mode 100644 index 00000000..5dbaa8b7 --- /dev/null +++ b/modules/lnjscheme/ANDROID_java_additions @@ -0,0 +1,16 @@ +/*-*-java -*-*/ +class LNMethod extends LNjScheme.Procedure { + + String name = null; + + /** Make a method from an exported wrapper, body, and environment. **/ + public LNMethod (String sym) { + name = sym; + } + + + /** Apply to a list of arguments. **/ + public Object apply(LNjScheme.Scheme interpreter, Object args) { + return null; // return interpreter.eval(body, new Environment(parms, args, env)); + } +} diff --git a/modules/lnjscheme/ANDROID_java_oncreate b/modules/lnjscheme/ANDROID_java_oncreate new file mode 100644 index 00000000..ce901cb4 --- /dev/null +++ b/modules/lnjscheme/ANDROID_java_oncreate @@ -0,0 +1,126 @@ +/* LNjScheme -*- mode: java; c-basic-offset: 2; -*- */ + +LNjSchemeSession = new LNjScheme.Scheme + (new String[0]) + { + String TAG = "calculator"; + + public void ln_log(String msg) { + String m = ln_log_date_formatter.format(new java.util.Date()) + msg; + System.err.println(TAG + ": " + m); + Log.d(TAG, m); + } + }; + +LNjSchemeEvaluateNoSync + (LNjScheme.Scheme.cons + (LNjScheme.Scheme.sym("define"), + LNjScheme.Scheme.list + (LNjScheme.Scheme.sym("ln-this"), + this + ))); + +LNjSchemeEvaluateNoSync + (LNjScheme.Scheme.cons + (LNjScheme.Scheme.sym("define"), + LNjScheme.Scheme.list + (LNjScheme.Scheme.sym("ln-mglview"), + mGLView + ))); + +LNjSchemeEvaluateNoSync + (LNjScheme.Scheme.cons + (LNjScheme.Scheme.sym("define"), + LNjScheme.Scheme.list + (LNjScheme.Scheme.sym("log-message"), + new LNMethod("log-message") { + public Object apply(LNjScheme.Scheme interpreter, Object args) { + String str = null; + if(args instanceof LNjScheme.Pair) { + Object a1 = null; + a1 = LNjScheme.Scheme.first(args); + if(a1 instanceof String) { str = (String)a1; } + else if(a1 instanceof char[]) { str = new String((char[])a1); } + else { str = "log-message: message not convertible"; } + } else { + str = "log-message: args not a list"; + } + ln_log(str); + return null; + }} + ))); + +LNjSchemeEvaluateNoSync + (LNjScheme.Scheme.cons + (LNjScheme.Scheme.sym("define"), + LNjScheme.Scheme.list + (LNjScheme.Scheme.sym("bound?"), + new LNMethod("bound?") { + public Object apply(LNjScheme.Scheme interpreter, Object args) { + if(args instanceof LNjScheme.Pair) { + Object a1 = null; + a1 = LNjScheme.Scheme.first(args); + if(a1 instanceof String) { + String sym = (String)a1; + try { + Object val = interpreter.eval(sym); + return true; + } catch (RuntimeException e) { return false; } + } else { + return LNjScheme.Scheme.error("bound? : not a symbol " + a1); + } + } else { + return LNjScheme.Scheme.error("bound? : missing argument"); + } + }} + ))); + +LNjSchemeEvaluateNoSync + (LNjScheme.Scheme.cons + (LNjScheme.Scheme.sym("define"), + LNjScheme.Scheme.list + (LNjScheme.Scheme.sym("send-event!"), + new LNMethod("send-event!") { + public Object apply(LNjScheme.Scheme interpreter, Object args) { + String str = null; + if(args instanceof LNjScheme.Pair) { + Object a1 = null, a2 = null, a3 = null;; + a1 = LNjScheme.Scheme.first(args); + a2 = LNjScheme.Scheme.rest(args); + a3 = LNjScheme.Scheme.rest(a2); + a2 = LNjScheme.Scheme.first(a2); + a3 = LNjScheme.Scheme.first(a3); + // Maybe we should accept symbolic event names too? + int ia1 = (a1 instanceof Number) ? (int)LNjScheme.Scheme.num(a1) : 21; + int ia2 = (a2 instanceof Number) ? (int)LNjScheme.Scheme.num(a2) : 0; + int ia3 = (a3 instanceof Number) ? (int)LNjScheme.Scheme.num(a3) : 0; + nativeEvent(ia1, ia2, ia3); + return LNjScheme.Scheme.TRUE; + } else { + nativeEvent(64, 0, 0); // debug + return LNjScheme.Scheme.TRUE; + } + }} + ))); + +LNjSchemeEvaluateNoSync + (LNjScheme.Scheme.cons + (LNjScheme.Scheme.sym("define"), + LNjScheme.Scheme.list + (LNjScheme.Scheme.sym("on-back-pressed"), + new LNMethod("on-back-pressed") { + public Object apply(LNjScheme.Scheme interpreter, Object args) { + String str = null; + if(args instanceof LNjScheme.Pair) { + Object a1 = null; + a1 = LNjScheme.Scheme.first(args); + if(a1 instanceof LNjScheme.Procedure) { onBackPressedHandler = (LNjScheme.Procedure)a1; } + else if(!LNjScheme.Scheme.truth(a1)) { onBackPressedHandler = null; } + else { LNjScheme.Scheme.error("on-back-pressed: argument not a procedure or #f"); } + return LNjScheme.Scheme.TRUE; + } else { + if(onBackPressedHandler==null) { return LNjScheme.Scheme.FALSE; } + else { return onBackPressedHandler; } + } + }} + ))); diff --git a/modules/lnjscheme/LNjScheme/Closure.java b/modules/lnjscheme/LNjScheme/Closure.java new file mode 100644 index 00000000..eb99ffab --- /dev/null +++ b/modules/lnjscheme/LNjScheme/Closure.java @@ -0,0 +1,28 @@ +package LNjScheme; + +/** A closure is a user-defined procedure. It is "closed" over the + * environment in which it was created. To apply the procedure, bind + * the parameters to the passed in variables, and evaluate the body. + * @author Peter Norvig, peter@norvig.com http://www.norvig.com + * Copyright 1998 Peter Norvig, see http://www.norvig.com/license.html **/ + +public class Closure extends Procedure { + + Object parms; + Object body; + Environment env; + + /** Make a closure from a parameter list, body, and environment. **/ + public Closure (Object parms, Object body, Environment env) { + this.parms = parms; + this.env = env; + this.body = (body instanceof Pair && rest(body) == null) + ? first(body) + : cons("begin", body); + } + + /** Apply a closure to a list of arguments. **/ + public Object apply(Scheme interpreter, Object args) { + return interpreter.eval(body, new Environment(parms, args, env)); + } +} diff --git a/modules/lnjscheme/LNjScheme/Continuation.java b/modules/lnjscheme/LNjScheme/Continuation.java new file mode 100644 index 00000000..2705c557 --- /dev/null +++ b/modules/lnjscheme/LNjScheme/Continuation.java @@ -0,0 +1,17 @@ +package LNjScheme; + +/** @author Peter Norvig, peter@norvig.com http://www.norvig.com + * Copyright 1998 Peter Norvig, see http://www.norvig.com/license.html */ + +public class Continuation extends Procedure { + + RuntimeException cc = null; + public Object value = null; + + public Continuation(RuntimeException cc) { this.cc = cc; } + + public Object apply(Scheme interpreter, Object args) { + value = first(args); + throw cc; + } +} diff --git a/modules/lnjscheme/LNjScheme/Environment.java b/modules/lnjscheme/LNjScheme/Environment.java new file mode 100644 index 00000000..4d78c227 --- /dev/null +++ b/modules/lnjscheme/LNjScheme/Environment.java @@ -0,0 +1,99 @@ +package LNjScheme; + +/** Environments allow you to look up the value of a variable, given + * its name. Keep a list of variables and values, and a pointer to + * the parent environment. If a variable list ends in a symbol rather + * than null, it means that symbol is bound to the remainder of the + * values list. + * @author Peter Norvig, peter@norvig.com http://www.norvig.com + * Copyright 1998 Peter Norvig, see http://www.norvig.com/license.html */ + +public class Environment extends SchemeUtils { + public Object vars; + public Object vals; + public Environment parent; + + /** A constructor to extend an environment with var/val pairs. */ + public Environment(Object vars, Object vals, Environment parent) { + this.vars = vars; + this.vals = vals; + this.parent = parent; + if (!numberArgsOK(vars, vals)) + warn("wrong number of arguments: expected " + vars + + " got " + vals); + } + + /** Construct an empty environment: no bindings. **/ + public Environment() {} + + /** Find the value of a symbol, in this environment or a parent. */ + public Object lookup (String symbol) { + Object varList = vars, valList = vals; + // See if the symbol is bound locally + while (varList != null) { + if (first(varList) == symbol) { + return first(valList); + } else if (varList == symbol) { + return valList; + } else { + varList = rest(varList); + valList = rest(valList); + } + } + // If not, try to look for the parent + if (parent != null) return parent.lookup(symbol); + else return error("Unbound variable: " + symbol); + } + + /** Add a new variable,value pair to this environment. */ + public Object define(Object var, Object val) { + vars = cons(var, vars); + vals = cons(val, vals); + if (val instanceof Procedure + && ((Procedure)val).name.equals("anonymous procedure")) + ((Procedure)val).name = var.toString(); + return var; + } + + /** Set the value of an existing variable **/ + public Object set(Object var, Object val) { + if (!(var instanceof String)) + return error("Attempt to set a non-symbol: " + + stringify(var));; + String symbol = (String) var; + Object varList = vars, valList = vals; + // See if the symbol is bound locally + while (varList != null) { + if (first(varList) == symbol) { + return setFirst(valList, val); + } else if (rest(varList) == symbol) { + return setRest(valList, val); + } else { + varList = rest(varList); + valList = rest(valList); + } + } + // If not, try to look for the parent + if (parent != null) return parent.set(symbol, val); + else return error("Unbound variable: " + symbol); + } + + public Environment defPrim(String name, int id, int minArgs) { + define(name, new Primitive(id, minArgs, minArgs)); + return this; + } + + public Environment defPrim(String name, int id, int minArgs, int maxArgs) { + define(name, new Primitive(id, minArgs, maxArgs)); + return this; + } + + /** See if there is an appropriate number of vals for these vars. **/ + boolean numberArgsOK(Object vars, Object vals) { + return ((vars == null && vals == null) + || (vars instanceof String) + || (vars instanceof Pair && vals instanceof Pair + && numberArgsOK(((Pair)vars).rest, ((Pair)vals).rest))); + } + +} diff --git a/modules/lnjscheme/LNjScheme/InputPort.java b/modules/lnjscheme/LNjScheme/InputPort.java new file mode 100644 index 00000000..1b4c4a8d --- /dev/null +++ b/modules/lnjscheme/LNjScheme/InputPort.java @@ -0,0 +1,210 @@ +package LNjScheme; +import java.io.*; + +/** InputPort is to Scheme as InputStream is to Java. + * @author Peter Norvig, peter@norvig.com http://www.norvig.com + * Copyright 1998 Peter Norvig, see http://www.norvig.com/license.html **/ + +public class InputPort extends SchemeUtils { + + static String EOF = "#!EOF"; + boolean isPushedToken = false; + boolean isPushedChar = false; + Object pushedToken = null; + int pushedChar = -1; + Reader in; + StringBuffer buff = new StringBuffer(); + + /** Construct an InputPort from an InputStream. **/ + public InputPort(InputStream in) { this.in = new InputStreamReader(in);} + + /** Construct an InputPort from a Reader. **/ + public InputPort(Reader in) { this.in = in;} + + /** Read and return a Scheme character or EOF. **/ + public Object readChar() { + try { + if (isPushedChar) { + isPushedChar = false; + if (pushedChar == -1) return EOF; else return chr((char)pushedChar); + } else { + int ch = in.read(); + if (ch == -1) return EOF; else return chr((char)ch); + } + } catch (IOException e) { + warn("On input, exception: " + e); + return EOF; + } + } + + /** Peek at and return the next Scheme character (or EOF). + * However, don't consume the character. **/ + public Object peekChar() { + int p = peekCh(); + if (p == -1) return EOF; else return chr((char)p); + } + + /** Push a character back to be re-used later. **/ + int pushChar(int ch) { + isPushedChar = true; + return pushedChar = ch; + } + + /** Pop off the previously pushed character. **/ + int popChar() { + isPushedChar = false; + return pushedChar; + } + + /** Peek at and return the next Scheme character as an int, -1 for EOF. + * However, don't consume the character. **/ + public int peekCh() { + try { return isPushedChar ? pushedChar : pushChar(in.read()); } + catch (IOException e) { + warn("On input, exception: " + e); + return -1; + } + } + + /** Read and return a Scheme expression, or EOF. **/ + public Object read() { + try { + Object token = nextToken(); + if (token == "(") + return readTail(false); + else if (token == ")") + { warn("Extra ) ignored."); return read(); } + else if (token == ".") + { warn("Extra . ignored."); return read(); } + else if (token == "'") + return list("quote", read()); + else if (token == "`") + return list("quasiquote", read()); + else if (token == ",") + return list("unquote", read()); + else if (token == ",@") + return list("unquote-splicing", read()); + else + return token; + } catch (IOException e) { + warn("On input, exception: " + e); + return EOF; + } + } + + /** Close the port. Return TRUE if ok. **/ + public Object close() { + try { this.in.close(); return TRUE; } + catch (IOException e) { return error("IOException: " + e); } + } + + /** Is the argument the EOF object? **/ + public static boolean isEOF(Object x) { return x == EOF; } + + Object readTail(boolean dotOK) throws IOException { + Object token = nextToken(); + if (token == EOF) + return error("EOF during read."); + else if (token == ")") + return null; + else if (token == ".") { + Object result = read(); + token = nextToken(); + if (token != ")") warn("Where's the ')'? Got " + + token + " after ."); + return result; + } else { + isPushedToken = true; + pushedToken = token; + return cons(read(), readTail(true)); + } + } + + Object nextToken() throws IOException { + int ch; + + // See if we should re-use a pushed char or token + if (isPushedToken) { + isPushedToken = false; + return pushedToken; + } else if (isPushedChar) { + ch = popChar(); + } else { + ch = in.read(); + } + + // Skip whitespace + while (Character.isWhitespace((char)ch)) ch = in.read(); + + // See what kind of non-white character we got + switch(ch) { + case -1: return EOF; + case '(' : return "("; + case ')': return ")"; + case '\'': return "'"; + case '`': return "`"; + case ',': + ch = in.read(); + if (ch == '@') return ",@"; + else { pushChar(ch); return ","; } + case ';': + // Comment: skip to end of line and then read next token + while(ch != -1 && ch != '\n' && ch != '\r') ch = in.read(); + return nextToken(); + case '"': + // Strings are represented as char[] + buff.setLength(0); + while ((ch = in.read()) != '"' && ch != -1) { + buff.append((char) ((ch == '\\') ? in.read() : ch)); + } + if (ch == -1) warn("EOF inside of a string."); + return buff.toString().toCharArray(); + case '#': + switch (ch = in.read()) { + case 't': case 'T': return TRUE; + case 'f': case 'F': return FALSE; + case '(': + pushChar('('); + return listToVector(read()); + case '\\': + ch = in.read(); + if (ch == 's' || ch == 'S' || ch == 'n' || ch == 'N') { + pushChar(ch); + Object token = nextToken(); + if (token == "space") return chr(' '); + else if (token == "newline") return chr('\n'); + else { + isPushedToken = true; + pushedToken = token; + return chr((char)ch); + } + } else { + return chr((char)ch); + } + case 'e': case 'i': case 'd': return nextToken(); + case 'b': case 'o': case 'x': + warn("#" + ((char)ch) + " not implemented, ignored."); + return nextToken(); + default: + warn("#" + ((char)ch) + " not recognized, ignored."); + return nextToken(); + } + default: + buff.setLength(0); + int c = ch; + do { + buff.append((char)ch); + ch = in.read(); + } while (!Character.isWhitespace((char)ch) && ch != -1 && + ch != '(' && ch != ')' && ch != '\'' && ch != ';' + && ch != '"' && ch != ',' && ch != '`'); + pushChar(ch); + // Try potential numbers, but catch any format errors. + if (c == '.' || c == '+' || c == '-' || (c >= '0' && c <= '9')) { + try { return new Double(buff.toString()); } + catch (NumberFormatException e) { ; } + } + return buff.toString().toLowerCase().intern(); + } + } +} diff --git a/modules/lnjscheme/LNjScheme/JavaMethod.java b/modules/lnjscheme/LNjScheme/JavaMethod.java new file mode 100644 index 00000000..e0644964 --- /dev/null +++ b/modules/lnjscheme/LNjScheme/JavaMethod.java @@ -0,0 +1,251 @@ +package LNjScheme; +import java.lang.reflect.*; + +/** @author Peter Norvig, peter@norvig.com http://www.norvig.com + * Copyright 1998 Peter Norvig, see http://www.norvig.com/license.html */ + +public class JavaMethod extends Procedure { + + Class[] argClasses; + Method method; + boolean isStatic; + + public JavaMethod(String methodName, Object targetClassName, + Object argClassNames) { + this.name = targetClassName + "." + methodName; + try { + argClasses = classArray(argClassNames); + method = toClass(targetClassName).getMethod(methodName, argClasses); + isStatic = Modifier.isStatic(method.getModifiers()); + } catch (ClassNotFoundException e) { + error("Bad class, can't get method " + name); + } catch (NoSuchMethodException e) { + error("Can't get method " + name); + } + + } + + private Object raiseJavaMethodError(String msg, Throwable e, Object args) { + return error(msg + " " + e + " on " + this + stringify(args) + ";"); + } + + /** Apply the method to a list of arguments. **/ + public Object apply(Scheme interpreter, Object args) { + try { + if (isStatic) return method.invoke(null, toArray(args)); + else return method.invoke(first(args), toArray(rest(args))); + } + catch (IllegalAccessException e) + { raiseJavaMethodError("Bad Java Method application:", e, args); } + catch (IllegalArgumentException e) + { raiseJavaMethodError("Bad Java Method application:", e, args); } + catch (InvocationTargetException e) { + Throwable e1 = e.getCause(); + raiseJavaMethodError("Bad Java Method application: " + method, e1, args); + } catch (NullPointerException e) + { raiseJavaMethodError("Bad Java Method application:", e, args); } + catch (Exception e) + { raiseJavaMethodError("Bad Java Method application:", e, args); } + return null; /* unreached */ + } + + public static Class toClass(Object arg) throws ClassNotFoundException { + if (arg instanceof Class) return (Class)arg; + arg = stringify(arg, false); + + if (arg.equals("void")) return java.lang.Void.TYPE; + else if (arg.equals("boolean")) return java.lang.Boolean.TYPE; + else if (arg.equals("char")) return java.lang.Character.TYPE; + else if (arg.equals("byte")) return java.lang.Byte.TYPE; + else if (arg.equals("short")) return java.lang.Short.TYPE; + else if (arg.equals("int")) return java.lang.Integer.TYPE; + else if (arg.equals("long")) return java.lang.Long.TYPE; + else if (arg.equals("float")) return java.lang.Float.TYPE; + else if (arg.equals("double")) return java.lang.Double.TYPE; + else return Class.forName((String)arg); + } + + /** Convert a list of Objects into an array. Peek at the argClasses + * array to see what's expected. That enables us to convert between + * Double and Integer, something Java won't do automatically. **/ + public Object[] toArray(Object args) { + int n = length(args); + int diff = n - argClasses.length; + if (diff != 0) + error(Math.abs(diff) + " too " + ((diff>0) ? "many" : "few") + + " args to " + name); + Object[] array = new Object[n]; + for(int i = 0; i < n && i < argClasses.length; i++) { + if (argClasses[i] == java.lang.Integer.TYPE) + array[i] = new Integer((int)num(first(args))); + else + array[i] = first(args); + args = rest(args); + } + return array; + } + + /** Convert a list of class names into an array of Classes. **/ + public static Class[] classArray(Object args) throws ClassNotFoundException { + int n = length(args); + Class[] array = new Class[n]; + for(int i = 0; i < n; i++) { + array[i] = toClass(first(args)); + args = rest(args); + } + return array; + } + + /*** Backported ***/ + /*** The following functionality is inspired and pratially stolen + * from the community version, which extented the original + * jscheme. I'd rather strip down jscheme for use as embedded + * language (e.g., this use case does often not need quasiquote + * and macro expansion) than use and digest the bloat of a jscheme + * 7.2 or alike. + * + * However: I need constructors with arguments. ***/ + + /** Each bucket in an method table contains a Class[] of + parameterTypes and the corresponding method or constructor. **/ + private static final int BUCKET_SIZE = 2; + private static Class[] getParameterTypes(Object m) { + return (m instanceof Method) ? ((Method) m).getParameterTypes() : + ((Constructor) m).getParameterTypes(); + } + + /** Returns Object[] of parameterType, method pairs. **/ + private static Object[] methodArray(Object[] v) { + Object[] result = new Object[v.length*BUCKET_SIZE]; + for(int i = 0; i < v.length; i++) { + result[i*BUCKET_SIZE] = getParameterTypes(v[i]); + result[i*BUCKET_SIZE+1] = v[i]; + } + return result; + } + /* */ + private static Object findMethod(Object[] methods, Object[] args) { + int best = -1; + /* + System.err.println("Found " + (methods.length/2) + " constructors: " + methods); + System.err.println("Checking against " + args.length + " args, these:"); + for(int i=0; i", GT, 2, n) + .defPrim(">=", GE, 2, n) + .defPrim("abs", ABS, 1) + .defPrim("acos", ACOS, 1) + .defPrim("append", APPEND, 0, n) + .defPrim("apply", APPLY, 2, n) + .defPrim("asin", ASIN, 1) + .defPrim("assoc", ASSOC, 2) + .defPrim("assq", ASSQ, 2) + .defPrim("assv", ASSV, 2) + .defPrim("atan", ATAN, 1) + .defPrim("boolean?", BOOLEANQ, 1) + .defPrim("caaaar", CXR, 1) + .defPrim("caaadr", CXR, 1) + .defPrim("caaar", CXR, 1) + .defPrim("caadar", CXR, 1) + .defPrim("caaddr", CXR, 1) + .defPrim("caadr", CXR, 1) + .defPrim("caar", CXR, 1) + .defPrim("cadaar", CXR, 1) + .defPrim("cadadr", CXR, 1) + .defPrim("cadar", CXR, 1) + .defPrim("caddar", CXR, 1) + .defPrim("cadddr", CXR, 1) + .defPrim("caddr", THIRD, 1) + .defPrim("cadr", SECOND, 1) + .defPrim("call-with-current-continuation", CALLCC, 1) + .defPrim("call-with-input-file", CALLWITHINPUTFILE, 2) + .defPrim("call-with-output-file", CALLWITHOUTPUTFILE, 2) + .defPrim("car", CAR, 1) + .defPrim("cdaaar", CXR, 1) + .defPrim("cdaadr", CXR, 1) + .defPrim("cdaar", CXR, 1) + .defPrim("cdadar", CXR, 1) + .defPrim("cdaddr", CXR, 1) + .defPrim("cdadr", CXR, 1) + .defPrim("cdar", CXR, 1) + .defPrim("cddaar", CXR, 1) + .defPrim("cddadr", CXR, 1) + .defPrim("cddar", CXR, 1) + .defPrim("cdddar", CXR, 1) + .defPrim("cddddr", CXR, 1) + .defPrim("cdddr", CXR, 1) + .defPrim("cddr", CXR, 1) + .defPrim("cdr", CDR, 1) + .defPrim("char->integer", CHARTOINTEGER, 1) + .defPrim("char-alphabetic?",CHARALPHABETICQ, 1) + .defPrim("char-ci<=?", CHARCICMP+LE, 2) + .defPrim("char-ci=?", CHARCICMP+GE, 2) + .defPrim("char-ci>?" , CHARCICMP+GT, 2) + .defPrim("char-downcase", CHARDOWNCASE, 1) + .defPrim("char-lower-case?",CHARLOWERCASEQ, 1) + .defPrim("char-numeric?", CHARNUMERICQ, 1) + .defPrim("char-upcase", CHARUPCASE, 1) + .defPrim("char-upper-case?",CHARUPPERCASEQ, 1) + .defPrim("char-whitespace?",CHARWHITESPACEQ, 1) + .defPrim("char<=?", CHARCMP+LE, 2) + .defPrim("char=?", CHARCMP+GE, 2) + .defPrim("char>?", CHARCMP+GT, 2) + .defPrim("char?", CHARQ, 1) + .defPrim("close-input-port", CLOSEINPUTPORT, 1) + .defPrim("close-output-port", CLOSEOUTPUTPORT, 1) + .defPrim("complex?", NUMBERQ, 1) + .defPrim("cons", CONS, 2) + .defPrim("cos", COS, 1) + .defPrim("current-input-port", CURRENTINPUTPORT, 0) + .defPrim("current-output-port", CURRENTOUTPUTPORT, 0) + .defPrim("display", DISPLAY, 1, 2) + .defPrim("eof-object?", EOFOBJECTQ, 1) + .defPrim("eq?", EQQ, 2) + .defPrim("equal?", EQUALQ, 2) + .defPrim("eqv?", EQVQ, 2) + .defPrim("eval", EVAL, 1, 2) + .defPrim("even?", EVENQ, 1) + .defPrim("exact?", INTEGERQ, 1) + .defPrim("exp", EXP, 1) + .defPrim("expt", EXPT, 2) + .defPrim("force", FORCE, 1) + .defPrim("for-each", FOREACH, 1, n) + .defPrim("gcd", GCD, 0, n) + .defPrim("inexact?", INEXACTQ, 1) + .defPrim("input-port?", INPUTPORTQ, 1) + .defPrim("integer->char", INTEGERTOCHAR, 1) + .defPrim("integer?", INTEGERQ, 1) + .defPrim("lcm", LCM, 0, n) + .defPrim("length", LENGTH, 1) + .defPrim("list", LIST, 0, n) + .defPrim("list->string", LISTTOSTRING, 1) + .defPrim("list->vector", LISTTOVECTOR, 1) + .defPrim("list-ref", LISTREF, 2) + .defPrim("list-tail", LISTTAIL, 2) + .defPrim("list?", LISTQ, 1) + .defPrim("load", LOAD, 1) + .defPrim("log", LOG, 1) + .defPrim("macro-expand", MACROEXPAND,1) + .defPrim("make-string", MAKESTRING,1, 2) + .defPrim("make-vector", MAKEVECTOR,1, 2) + .defPrim("map", MAP, 1, n) + .defPrim("max", MAX, 1, n) + .defPrim("member", MEMBER, 2) + .defPrim("memq", MEMQ, 2) + .defPrim("memv", MEMV, 2) + .defPrim("min", MIN, 1, n) + .defPrim("modulo", MODULO, 2) + .defPrim("negative?", NEGATIVEQ, 1) + .defPrim("newline", NEWLINE, 0, 1) + .defPrim("not", NOT, 1) + .defPrim("null?", NULLQ, 1) + .defPrim("number->string", NUMBERTOSTRING, 1, 2) + .defPrim("number?", NUMBERQ, 1) + .defPrim("odd?", ODDQ, 1) + .defPrim("open-input-file",OPENINPUTFILE, 1) + .defPrim("open-output-file", OPENOUTPUTFILE, 1) + .defPrim("output-port?", OUTPUTPORTQ, 1) + .defPrim("pair?", PAIRQ, 1) + .defPrim("peek-char", PEEKCHAR, 0, 1) + .defPrim("positive?", POSITIVEQ, 1) + .defPrim("procedure?", PROCEDUREQ,1) + .defPrim("quotient", QUOTIENT, 2) + .defPrim("rational?", INTEGERQ, 1) + .defPrim("read", READ, 0, 1) + .defPrim("read-char", READCHAR, 0, 1) + .defPrim("real?", NUMBERQ, 1) + .defPrim("remainder", REMAINDER, 2) + .defPrim("reverse", REVERSE, 1) + .defPrim("round", ROUND, 1) + .defPrim("set-car!", SETCAR, 2) + .defPrim("set-cdr!", SETCDR, 2) + .defPrim("sin", SIN, 1) + .defPrim("sqrt", SQRT, 1) + .defPrim("string", STRING, 0, n) + .defPrim("string->list", STRINGTOLIST, 1) + .defPrim("string->number", STRINGTONUMBER, 1, 2) + .defPrim("string->symbol", STRINGTOSYMBOL, 1) + .defPrim("string-append", STRINGAPPEND, 0, n) + .defPrim("string-ci<=?", STRINGCICMP+LE, 2) + .defPrim("string-ci=?", STRINGCICMP+GE, 2) + .defPrim("string-ci>?" , STRINGCICMP+GT, 2) + .defPrim("string-length", STRINGLENGTH, 1) + .defPrim("string-ref", STRINGREF, 2) + .defPrim("string-set!", STRINGSET, 3) + .defPrim("string<=?", STRINGCMP+LE, 2) + .defPrim("string=?", STRINGCMP+GE, 2) + .defPrim("string>?", STRINGCMP+GT, 2) + .defPrim("string?", STRINGQ, 1) + .defPrim("substring", SUBSTRING, 3) + .defPrim("symbol->string", SYMBOLTOSTRING, 1) + .defPrim("symbol?", SYMBOLQ, 1) + .defPrim("tan", TAN, 1) + .defPrim("vector", VECTOR, 0, n) + .defPrim("vector->list", VECTORTOLIST, 1) + .defPrim("vector-length", VECTORLENGTH, 1) + .defPrim("vector-ref", VECTORREF, 2) + .defPrim("vector-set!", VECTORSET, 3) + .defPrim("vector?", VECTORQ, 1) + .defPrim("write", WRITE, 1, 2) + .defPrim("write-char", DISPLAY, 1, 2) + .defPrim("zero?", ZEROQ, 1) + + ///////////// Extensions //////////////// + + .defPrim("new", NEW, 1, n) + .defPrim("class", CLASS, 1) + .defPrim("method", METHOD, 2, n) + .defPrim("exit", EXIT, 0, 1) + .defPrim("error", ERROR, 0, n) + .defPrim("time-call", TIMECALL, 1, 2) + .defPrim("_list*", LISTSTAR, 0, n) + ; + + return env; + } + + /** Apply a primitive to a list of arguments. **/ + public Object apply(Scheme interp, Object args) { + //First make sure there are the right number of arguments. + int nArgs = length(args); + if (nArgs < minArgs) + return error("too few args, " + nArgs + + ", for " + this.name + ": " + args); + else if (nArgs > maxArgs) + return error("too many args, " + nArgs + + ", for " + this.name + ": " + args); + + Object x = first(args); + Object y = second(args); + + switch (idNumber) { + + //////////////// SECTION 6.1 BOOLEANS + case NOT: return truth(x == FALSE); + case BOOLEANQ: return truth(x == TRUE || x == FALSE); + + //////////////// SECTION 6.2 EQUIVALENCE PREDICATES + case EQVQ: return truth(eqv(x, y)); + case EQQ: return truth(x == y); + case EQUALQ: return truth(equal(x,y)); + + //////////////// SECTION 6.3 LISTS AND PAIRS + case PAIRQ: return truth(x instanceof Pair); + case LISTQ: return truth(isList(x)); + case CXR: for (int i = name.length()-2; i >= 1; i--) + x = (name.charAt(i) == 'a') ? first(x) : rest(x); + return x; + case CONS: return cons(x, y); + case CAR: return first(x); + case CDR: return rest(x); + case SETCAR: return setFirst(x, y); + case SETCDR: return setRest(x, y); + case SECOND: return second(x); + case THIRD: return third(x); + case NULLQ: return truth(x == null); + case LIST: return args; + case LENGTH: return num(length(x)); + case APPEND: return (args == null) ? null : append(args); + case REVERSE: return reverse(x); + case LISTTAIL: for (int k = (int)num(y); k>0; k--) x = rest(x); + return x; + case LISTREF: for (int k = (int)num(y); k>0; k--) x = rest(x); + return first(x); + case MEMQ: return memberAssoc(x, y, 'm', 'q'); + case MEMV: return memberAssoc(x, y, 'm', 'v'); + case MEMBER: return memberAssoc(x, y, 'm', ' '); + case ASSQ: return memberAssoc(x, y, 'a', 'q'); + case ASSV: return memberAssoc(x, y, 'a', 'v'); + case ASSOC: return memberAssoc(x, y, 'a', ' '); + + //////////////// SECTION 6.4 SYMBOLS + case SYMBOLQ: return truth(x instanceof String); + case SYMBOLTOSTRING:return sym(x).toCharArray(); + case STRINGTOSYMBOL:return new String(str(x)).intern(); + + //////////////// SECTION 6.5 NUMBERS + case NUMBERQ: return truth(x instanceof Number); + case ODDQ: return truth(Math.abs(num(x)) % 2 != 0); + case EVENQ: return truth(Math.abs(num(x)) % 2 == 0); + case ZEROQ: return truth(num(x) == 0); + case POSITIVEQ: return truth(num(x) > 0); + case NEGATIVEQ: return truth(num(x) < 0); + case INTEGERQ: return truth(isExact(x)); + case INEXACTQ: return truth(!isExact(x)); + case LT: return numCompare(args, '<'); + case GT: return numCompare(args, '>'); + case EQ: return numCompare(args, '='); + case LE: return numCompare(args, 'L'); + case GE: return numCompare(args, 'G'); + case MAX: return numCompute(args, 'X', num(x)); + case MIN: return numCompute(args, 'N', num(x)); + case PLUS: return numCompute(args, '+', 0.0); + case MINUS: return numCompute(rest(args), '-', num(x)); + case TIMES: return numCompute(args, '*', 1.0); + case DIVIDE: return numCompute(rest(args), '/', num(x)); + case QUOTIENT: double d = num(x)/num(y); + return num(d > 0 ? Math.floor(d) : Math.ceil(d)); + case REMAINDER: return num((long)num(x) % (long)num(y)); + case MODULO: long xi = (long)num(x), yi = (long)num(y), m = xi % yi; + return num((xi*yi > 0 || m == 0) ? m : m + yi); + case ABS: return num(Math.abs(num(x))); + case FLOOR: return num(Math.floor(num(x))); + case CEILING: return num(Math.ceil(num(x))); + case TRUNCATE: d = num(x); + return num((d < 0.0) ? Math.ceil(d) : Math.floor(d)); + case ROUND: return num(Math.round(num(x))); + case EXP: return num(Math.exp(num(x))); + case LOG: return num(Math.log(num(x))); + case SIN: return num(Math.sin(num(x))); + case COS: return num(Math.cos(num(x))); + case TAN: return num(Math.tan(num(x))); + case ASIN: return num(Math.asin(num(x))); + case ACOS: return num(Math.acos(num(x))); + case ATAN: return num(Math.atan(num(x))); + case SQRT: return num(Math.sqrt(num(x))); + case EXPT: return num(Math.pow(num(x), num(y))); + case NUMBERTOSTRING:return numberToString(x, y); + case STRINGTONUMBER:return stringToNumber(x, y); + case GCD: return (args == null) ? ZERO : gcd(args); + case LCM: return (args == null) ? ONE : lcm(args); + + //////////////// SECTION 6.6 CHARACTERS + case CHARQ: return truth(x instanceof Character); + case CHARALPHABETICQ: return truth(Character.isLetter(chr(x))); + case CHARNUMERICQ: return truth(Character.isDigit(chr(x))); + case CHARWHITESPACEQ: return truth(Character.isWhitespace(chr(x))); + case CHARUPPERCASEQ: return truth(Character.isUpperCase(chr(x))); + case CHARLOWERCASEQ: return truth(Character.isLowerCase(chr(x))); + case CHARTOINTEGER: return new Double((double)chr(x)); + case INTEGERTOCHAR: return chr((char)(int)num(x)); + case CHARUPCASE: return chr(Character.toUpperCase(chr(x))); + case CHARDOWNCASE: return chr(Character.toLowerCase(chr(x))); + case CHARCMP+EQ: return truth(charCompare(x, y, false) == 0); + case CHARCMP+LT: return truth(charCompare(x, y, false) < 0); + case CHARCMP+GT: return truth(charCompare(x, y, false) > 0); + case CHARCMP+GE: return truth(charCompare(x, y, false) >= 0); + case CHARCMP+LE: return truth(charCompare(x, y, false) <= 0); + case CHARCICMP+EQ: return truth(charCompare(x, y, true) == 0); + case CHARCICMP+LT: return truth(charCompare(x, y, true) < 0); + case CHARCICMP+GT: return truth(charCompare(x, y, true) > 0); + case CHARCICMP+GE: return truth(charCompare(x, y, true) >= 0); + case CHARCICMP+LE: return truth(charCompare(x, y, true) <= 0); + + case ERROR: return error(stringify(args)); + + //////////////// SECTION 6.7 STRINGS + case STRINGQ: return truth(x instanceof char[]); + case MAKESTRING:char[] str = new char[(int)num(x)]; + if (y != null) { + char c = chr(y); + for (int i = str.length-1; i >= 0; i--) str[i] = c; + } + return str; + case STRING: return listToString(args); + case STRINGLENGTH: return num(str(x).length); + case STRINGREF: return chr(str(x)[(int)num(y)]); + case STRINGSET: Object z = third(args); str(x)[(int)num(y)] = chr(z); + return z; + case SUBSTRING: int start = (int)num(y), end = (int)num(third(args)); + return new String(str(x), start, end-start).toCharArray(); + case STRINGAPPEND: return stringAppend(args); + case STRINGTOLIST: Pair result = null; + char[] str2 = str(x); + for (int i = str2.length-1; i >= 0; i--) + result = cons(chr(str2[i]), result); + return result; + case LISTTOSTRING: return listToString(x); + case STRINGCMP+EQ: return truth(stringCompare(x, y, false) == 0); + case STRINGCMP+LT: return truth(stringCompare(x, y, false) < 0); + case STRINGCMP+GT: return truth(stringCompare(x, y, false) > 0); + case STRINGCMP+GE: return truth(stringCompare(x, y, false) >= 0); + case STRINGCMP+LE: return truth(stringCompare(x, y, false) <= 0); + case STRINGCICMP+EQ:return truth(stringCompare(x, y, true) == 0); + case STRINGCICMP+LT:return truth(stringCompare(x, y, true) < 0); + case STRINGCICMP+GT:return truth(stringCompare(x, y, true) > 0); + case STRINGCICMP+GE:return truth(stringCompare(x, y, true) >= 0); + case STRINGCICMP+LE:return truth(stringCompare(x, y, true) <= 0); + + //////////////// SECTION 6.8 VECTORS + case VECTORQ: return truth(x instanceof Object[]); + case MAKEVECTOR: Object[] vec = new Object[(int)num(x)]; + if (y != null) { + for (int i = 0; i < vec.length; i++) vec[i] = y; + } + return vec; + case VECTOR: return listToVector(args); + case VECTORLENGTH: return num(vec(x).length); + case VECTORREF: return vec(x)[(int)num(y)]; + case VECTORSET: return vec(x)[(int)num(y)] = third(args); + case VECTORTOLIST: return vectorToList(x); + case LISTTOVECTOR: return listToVector(x); + + //////////////// SECTION 6.9 CONTROL FEATURES + case EVAL: return interp.eval(x); + case FORCE: return (!(x instanceof Procedure)) ? x + : proc(x).apply(interp, null); + case MACROEXPAND: return Macro.macroExpand(interp, x); + case PROCEDUREQ: return truth(x instanceof Procedure); + case APPLY: return proc(x).apply(interp, listStar(rest(args))); + case MAP: return map(proc(x), rest(args), interp, list(null)); + case FOREACH: return map(proc(x), rest(args), interp, null); + case CALLCC: RuntimeException cc = new RuntimeException(); + Continuation proc = new Continuation(cc); + try { return proc(x).apply(interp, list(proc)); } + catch (RuntimeException e) { + if (e == cc) return proc.value; else throw e; + } + + //////////////// SECTION 6.10 INPUT AND OUPUT + case EOFOBJECTQ: return truth(x == InputPort.EOF); + case INPUTPORTQ: return truth(x instanceof InputPort); + case CURRENTINPUTPORT: return interp.input; + case OPENINPUTFILE: return openInputFile(x); + case CLOSEINPUTPORT: return inPort(x, interp).close(); + case OUTPUTPORTQ: return truth(x instanceof PrintWriter); + case CURRENTOUTPUTPORT: return interp.output; + case OPENOUTPUTFILE: return openOutputFile(x); + case CALLWITHOUTPUTFILE: PrintWriter p = null; + try { p = openOutputFile(x); + z = proc(y).apply(interp, list(p)); + } finally { if (p != null) p.close(); } + return z; + case CALLWITHINPUTFILE: InputPort p2 = null; + try { p2 = openInputFile(x); + z = proc(y).apply(interp, list(p2)); + } finally { if (p2 != null) p2.close(); } + return z; + case CLOSEOUTPUTPORT: outPort(x, interp).close(); return TRUE; + case READCHAR: return inPort(x, interp).readChar(); + case PEEKCHAR: return inPort(x, interp).peekChar(); + case LOAD: return interp.load(x); + case READ: return inPort(x, interp).read(); + case EOF_OBJECT: return truth(InputPort.isEOF(x)); + case WRITE: return write(x, outPort(y, interp), true); + case DISPLAY: return write(x, outPort(y, interp), false); + case NEWLINE: outPort(x, interp).println(); + outPort(x, interp).flush(); return TRUE; + + //////////////// EXTENSIONS + case CLASS: try { return Class.forName(stringify(x, false)); } + catch (ClassNotFoundException e) { return FALSE; } + case NEW: return JavaMethod.invokeConstructor(x, rest(args)); + case METHOD: return new JavaMethod(stringify(x, false), y, + rest(rest(args))); + case EXIT: System.exit((x == null) ? 0 : (int)num(x)); + case LISTSTAR: return listStar(args); + case TIMECALL: Runtime runtime = Runtime.getRuntime(); + runtime.gc(); + long startTime = System.currentTimeMillis(); + long startMem = runtime.freeMemory(); + Object ans = FALSE; + int nTimes = (y == null ? 1 : (int)num(y)); + for (int i = 0; i < nTimes; i++) { + ans = proc(x).apply(interp, null); + } + long time = System.currentTimeMillis() - startTime; + long mem = startMem - runtime.freeMemory(); + return cons(ans, list(list(num(time), "msec"), + list(num(mem), "bytes"))); + default: return error("internal error: unknown primitive: " + + this + " applied to " + args); + } + } + + public static char[] stringAppend(Object args) { + StringBuffer result = new StringBuffer(); + for(; args instanceof Pair; args = rest(args)) { + result.append(stringify(first(args), false)); + } + return result.toString().toCharArray(); + } + + public static Object memberAssoc(Object obj, Object list, char m, char eq) { + while (list instanceof Pair) { + Object target = (m == 'm') ? first(list) : first(first(list)); + boolean found; + switch (eq) { + case 'q': found = (target == obj); break; + case 'v': found = eqv(target, obj); break; + case ' ': found = equal(target, obj); break; + default: warn("Bad option to memberAssoc:" + eq); return FALSE; + } + if (found) return (m == 'm') ? list : first(list); + list = rest(list); + } + return FALSE; + } + + public static Object numCompare(Object args, char op) { + while (rest(args) instanceof Pair) { + double x = num(first(args)); args = rest(args); + double y = num(first(args)); + switch (op) { + case '>': if (!(x > y)) return FALSE; break; + case '<': if (!(x < y)) return FALSE; break; + case '=': if (!(x == y)) return FALSE; break; + case 'L': if (!(x <= y)) return FALSE; break; + case 'G': if (!(x >= y)) return FALSE; break; + default: error("internal error: unrecognized op: " + op); break; + } + } + return TRUE; + } + + public static Object numCompute(Object args, char op, double result) { + if (args == null) { + switch (op) { + case '-': return num(0 - result); + case '/': return num(1 / result); + default: return num(result); + } + } else { + while (args instanceof Pair) { + double x = num(first(args)); args = rest(args); + switch (op) { + case 'X': if (x > result) result = x; break; + case 'N': if (x < result) result = x; break; + case '+': result += x; break; + case '-': result -= x; break; + case '*': result *= x; break; + case '/': result /= x; break; + default: error("internal error: unrecognized op: " + op); break; + } + } + return num(result); + } + } + + /** Return the sign of the argument: +1, -1, or 0. **/ + static int sign(int x) { return (x > 0) ? +1 : (x < 0) ? -1 : 0; } + + /** Return <0 if x is alphabetically first, >0 if y is first, + * 0 if same. Case insensitive iff ci is true. Error if not both chars. **/ + public static int charCompare(Object x, Object y, boolean ci) { + char xc = chr(x), yc = chr(y); + if (ci) { xc = Character.toLowerCase(xc); yc = Character.toLowerCase(yc); } + return xc - yc; + } + + /** Return <0 if x is alphabetically first, >0 if y is first, + * 0 if same. Case insensitive iff ci is true. Error if not strings. **/ + public static int stringCompare(Object x, Object y, boolean ci) { + if (x instanceof char[] && y instanceof char[]) { + char[] xc = (char[])x, yc = (char[])y; + for (int i = 0; i < xc.length; i++) { + int diff = (!ci) ? xc[i] - yc[i] + : Character.toUpperCase(xc[i]) - Character.toUpperCase(yc[i]); + if (diff != 0) return diff; + } + return xc.length - yc.length; + } else { + error("expected two strings, got: " + stringify(list(x, y))); + return 0; + } + } + + static Object numberToString(Object x, Object y) { + int base = (y instanceof Number) ? (int)num(y) : 10; + if (base != 10 || num(x) == Math.round(num(x))) { + // An integer + return Long.toString((long)num(x), base).toCharArray(); + } else { + // A floating point number + return x.toString().toCharArray(); + } + } + + static Object stringToNumber(Object x, Object y) { + int base = (y instanceof Number) ? (int)num(y) : 10; + try { + return (base == 10) + ? Double.valueOf(stringify(x, false)) + : num(Long.parseLong(stringify(x, false), base)); + } catch (NumberFormatException e) { return FALSE; } + } + + static Object gcd(Object args) { + long gcd = 0; + while (args instanceof Pair) { + gcd = gcd2(Math.abs((long)num(first(args))), gcd); + args = rest(args); + } + return num(gcd); + } + + static long gcd2(long a, long b) { + if (b == 0) return a; + else return gcd2(b, a % b); + } + + static Object lcm(Object args) { + long L = 1, g = 1; + while (args instanceof Pair) { + long n = Math.abs((long)num(first(args))); + g = gcd2(n, L); + L = (g == 0) ? g : (n / g) * L; + args = rest(args); + } + return num(L); + } + + static boolean isExact(Object x) { + if (!(x instanceof Double)) return false; + double d = num(x); + return (d == Math.round(d) && Math.abs(d) < 102962884861573423.0); + } + + static PrintWriter openOutputFile(Object filename) { + try { + return new PrintWriter(new FileWriter(stringify(filename, false))); + } catch (FileNotFoundException e) { + return (PrintWriter)error("No such file: " + stringify(filename)); + } catch (IOException e) { + return (PrintWriter)error("IOException: " + e); + } + } + + static InputPort openInputFile(Object filename) { + try { + return new InputPort(new FileInputStream(stringify(filename, false))); + } catch (FileNotFoundException e) { + return (InputPort)error("No such file: " + stringify(filename)); + } catch (IOException e) { + return (InputPort)error("IOException: " + e); + } + } + + static boolean isList(Object x) { + Object slow = x, fast = x; + for(;;) { + if (fast == null) return true; + if (slow == rest(fast) || !(fast instanceof Pair) + || !(slow instanceof Pair)) return false; + slow = rest(slow); + fast = rest(fast); + if (fast == null) return true; + if (!(fast instanceof Pair)) return false; + fast = rest(fast); + } + } + + static Object append(Object args) { + if (rest(args) == null) return first(args); + else return append2(first(args), append(rest(args))); + } + + static Object append2(Object x, Object y) { + if (x instanceof Pair) return cons(first(x), append2(rest(x), y)); + else return y; + } + + /** Map proc over a list of lists of args, in the given interpreter. + * If result is non-null, accumulate the results of each call there + * and return that at the end. Otherwise, just return null. **/ + static Pair map(Procedure proc, Object args, Scheme interp, Pair result) { + Pair accum = result; + if (rest(args) == null) { + args = first(args); + while (args instanceof Pair) { + Object x = proc.apply(interp, list(first(args))); + if (accum != null) accum = (Pair) (accum.rest = list(x)); + args = rest(args); + } + } else { + Procedure car = proc(interp.eval("car")), cdr = proc(interp.eval("cdr")); + while (first(args) instanceof Pair) { + Object x = proc.apply(interp, map(car, list(args), interp, list(null))); + if (accum != null) accum = (Pair) (accum.rest = list(x)); + args = map(cdr, list(args), interp, list(null)); + } + } + return (Pair)rest(result); + } + +} diff --git a/modules/lnjscheme/LNjScheme/Procedure.java b/modules/lnjscheme/LNjScheme/Procedure.java new file mode 100644 index 00000000..8a21ecbf --- /dev/null +++ b/modules/lnjscheme/LNjScheme/Procedure.java @@ -0,0 +1,20 @@ +package LNjScheme; + +/** @author Peter Norvig, peter@norvig.com http://www.norvig.com + * Copyright 1998 Peter Norvig, see http://www.norvig.com/license.html **/ + +public abstract class Procedure extends SchemeUtils { + + String name = "anonymous procedure"; + + public String toString() { return "{" + name + "}"; } + + public abstract Object apply(Scheme interpreter, Object args); + + /** Coerces a Scheme object to a procedure. **/ + static Procedure proc(Object x) { + if (x instanceof Procedure) return (Procedure) x; + else return proc(error("Not a procedure: " + stringify(x))); + } + +} diff --git a/modules/lnjscheme/LNjScheme/Scheme.java b/modules/lnjscheme/LNjScheme/Scheme.java new file mode 100644 index 00000000..718971c7 --- /dev/null +++ b/modules/lnjscheme/LNjScheme/Scheme.java @@ -0,0 +1,150 @@ +package LNjScheme; +import java.io.*; + +/** This class represents a Scheme interpreter. + * See http://www.norvig.com/jscheme.html for more documentation. + * This is version 1.4. + * @author Peter Norvig, peter@norvig.com http://www.norvig.com + * Copyright 1998 Peter Norvig, see http://www.norvig.com/license.html **/ + +public class Scheme extends SchemeUtils { + + InputPort input = new InputPort(System.in); + PrintWriter output = new PrintWriter(System.out, true); + Environment globalEnvironment = new Environment(); + + /** Create a Scheme interpreter and load an array of files into it. + * Also load SchemePrimitives.CODE. **/ + public Scheme(String[] files) { + Primitive.installPrimitives(globalEnvironment); + try { + load(new InputPort(new StringReader(SchemePrimitives.CODE))); + for (int i = 0; i < (files == null ? 0 : files.length); i++) { + load(files[i]); + } + } catch (RuntimeException e) { ; } + } + + //////////////// Main Loop + + /** Create a new Scheme interpreter, passing in the command line args + * as files to load, and then enter a read eval write loop. **/ + public static void main(String[] files) { + new Scheme(files).readEvalWriteLoop(); + } + + /** Prompt, read, eval, and write the result. + * Also sets up a catch for any RuntimeExceptions encountered. **/ + public void readEvalWriteLoop() { + Object x; + for(;;) { + try { + output.print("> "); output.flush(); + if (input.isEOF(x = input.read())) return; + write(eval(x), output, true); + output.println(); output.flush(); + } catch (RuntimeException e) { ; } + } + } + + /** Eval all the expressions in a file. Calls load(InputPort). **/ + public Object load(Object fileName) { + String name = stringify(fileName, false); + try { return load(new InputPort(new FileInputStream(name))); } + catch (IOException e) { return error("can't load " + name); } + } + + /** Eval all the expressions coming from an InputPort. **/ + public Object load(InputPort in) { + Object x = null; + for(;;) { + if (in.isEOF(x = in.read())) return TRUE; + eval(x); + } + } + + //////////////// Evaluation + + /** Evaluate an object, x, in an environment. **/ + public Object eval(Object x, Environment env) { + // The purpose of the while loop is to allow tail recursion. + // The idea is that in a tail recursive position, we do "x = ..." + // and loop, rather than doing "return eval(...)". + while (true) { + if (x instanceof String) { // VARIABLE + return env.lookup((String)x); + } else if (!(x instanceof Pair)) { // CONSTANT + return x; + } else { + Object fn = first(x); + Object args = rest(x); + if (fn == "quote") { // QUOTE + return first(args); + } else if (fn == "begin") { // BEGIN + for (; rest(args) != null; args = rest(args)) { + eval(first(args), env); + } + x = first(args); + } else if (fn == "define") { // DEFINE + if (first(args) instanceof Pair) + return env.define(first(first(args)), + eval(cons("lambda", cons(rest(first(args)), rest(args))), env)); + else return env.define(first(args), eval(second(args), env)); + } else if (fn == "set!") { // SET! + return env.set(first(args), eval(second(args), env)); + } else if (fn == "if") { // IF + x = (truth(eval(first(args), env))) ? second(args) : third(args); + } else if (fn == "cond") { // COND + x = reduceCond(args, env); + } else if (fn == "lambda") { // LAMBDA + return new Closure(first(args), rest(args), env); + } else if (fn == "macro") { // MACRO + return new Macro(first(args), rest(args), env); + } else { // PROCEDURE CALL: + fn = eval(fn, env); + if (fn instanceof Macro) { // (MACRO CALL) + x = ((Macro)fn).expand(this, (Pair)x, args); + } else if (fn instanceof Closure) { // (CLOSURE CALL) + Closure f = (Closure)fn; + x = f.body; + env = new Environment(f.parms, evalList(args, env), f.env); + } else { // (OTHER PROCEDURE CALL) + return Procedure.proc(fn).apply(this, evalList(args, env)); + } + } + } + } + } + + /** Eval in the global environment. **/ + public Object eval(Object x) { return eval(x, this.globalEnvironment); } + + /** Evaluate each of a list of expressions. **/ + Pair evalList(Object list, Environment env) { + if (list == null) + return null; + else if (!(list instanceof Pair)) { + error("Illegal arg list: " + list); + return null; + } else + return cons(eval(first(list), env), evalList(rest(list), env)); + } + + /** Reduce a cond expression to some code which, when evaluated, + * gives the value of the cond expression. We do it that way to + * maintain tail recursion. **/ + Object reduceCond(Object clauses, Environment env) { + Object result = null; + for (;;) { + if (clauses == null) return FALSE; + Object clause = first(clauses); clauses = rest(clauses); + if (first(clause) == "else" + || truth(result = eval(first(clause), env))) + if (rest(clause) == null) return list("quote", result); + else if (second(clause) == "=>") + return list(third(clause), list("quote", result)); + else return cons("begin", rest(clause)); + } + } + +} diff --git a/modules/lnjscheme/LNjScheme/SchemePrimitives.java b/modules/lnjscheme/LNjScheme/SchemePrimitives.java new file mode 100644 index 00000000..4c2889a0 --- /dev/null +++ b/modules/lnjscheme/LNjScheme/SchemePrimitives.java @@ -0,0 +1,158 @@ +package LNjScheme; + +/** Holds a string representation of some Scheme code in CODE. + * A string is better than a file because with no files, its easier to + * compress everything in the classes.jar file. For editing convenience, + * the following two perl convert from normal text to this Java quoted + * format and back again: + * 
+ * perl -pe 's/"/\\"/g; s/(\s*)(.*?)(\s*)$/\1"\2\\n" +\n/'
+ * perl -pe 's/\\"/"/g; s/^(\s*)"/\1/; s/\\n" [+]//'
+ *
+ * @author Peter Norvig, peter@norvig.com http://www.norvig.com + * Copyright 1998 Peter Norvig, see http://www.norvig.com/license.html **/ +public class SchemePrimitives { + + public static final String CODE = +"(define call/cc call-with-current-continuation)\n" + +"(define first car)\n" + +"(define second cadr)\n" + +"(define third caddr)\n" + +"(define rest cdr)\n" + +"(define set-first! set-car!)\n" + +"(define set-rest! set-cdr!)\n" + + +//;;;;;;;;;;;;;;;; Standard Scheme Macros + +"(define or\n" + + "(macro args\n" + + "(if (null? args)\n" + + "#f\n" + + "(cons 'cond (map list args)))))\n" + + +"(define and\n" + + "(macro args\n" + + "(cond ((null? args) #t)\n" + + "((null? (rest args)) (first args))\n" + + "(else (list 'if (first args) (cons 'and (rest args)) #f)))))\n" + + +"(define quasiquote\n" + + "(macro (x)\n" + + "(define (constant? exp)\n" + + "(if (pair? exp) (eq? (car exp) 'quote) (not (symbol? exp))))\n" + + "(define (combine-skeletons left right exp)\n" + + "(cond\n" + + "((and (constant? left) (constant? right))\n" + + "(if (and (eqv? (eval left) (car exp))\n" + + "(eqv? (eval right) (cdr exp)))\n" + + "(list 'quote exp)\n" + + "(list 'quote (cons (eval left) (eval right)))))\n" + + "((null? right) (list 'list left))\n" + + "((and (pair? right) (eq? (car right) 'list))\n" + + "(cons 'list (cons left (cdr right))))\n" + + "(else (list 'cons left right))))\n" + + "(define (expand-quasiquote exp nesting)\n" + + "(cond\n" + + "((vector? exp)\n" + + "(list 'apply 'vector (expand-quasiquote (vector->list exp) nesting)))\n" + + "((not (pair? exp))\n" + + "(if (constant? exp) exp (list 'quote exp)))\n" + + "((and (eq? (car exp) 'unquote) (= (length exp) 2))\n" + + "(if (= nesting 0)\n" + + "(second exp)\n" + + "(combine-skeletons ''unquote\n" + + "(expand-quasiquote (cdr exp) (- nesting 1))\n" + + "exp)))\n" + + "((and (eq? (car exp) 'quasiquote) (= (length exp) 2))\n" + + "(combine-skeletons ''quasiquote\n" + + "(expand-quasiquote (cdr exp) (+ nesting 1))\n" + + "exp))\n" + + "((and (pair? (car exp))\n" + + "(eq? (caar exp) 'unquote-splicing)\n" + + "(= (length (car exp)) 2))\n" + + "(if (= nesting 0)\n" + + "(list 'append (second (first exp))\n" + + "(expand-quasiquote (cdr exp) nesting))\n" + + "(combine-skeletons (expand-quasiquote (car exp) (- nesting 1))\n" + + "(expand-quasiquote (cdr exp) nesting)\n" + + "exp)))\n" + + "(else (combine-skeletons (expand-quasiquote (car exp) nesting)\n" + + "(expand-quasiquote (cdr exp) nesting)\n" + + "exp))))\n" + + "(expand-quasiquote x 0)))\n" + + +"\n" + +"(define let\n" + + "(macro (bindings . body)\n" + + "(define (named-let name bindings body)\n" + + "`(let ((,name #f))\n" + + "(set! ,name (lambda ,(map first bindings) . ,body))\n" + + "(,name . ,(map second bindings))))\n" + + "(if (symbol? bindings)\n" + + "(named-let bindings (first body) (rest body))\n" + + "`((lambda ,(map first bindings) . ,body) . ,(map second bindings)))))\n" + + +"(define let*\n" + + "(macro (bindings . body)\n" + + "(if (null? bindings) `((lambda () . ,body))\n" + + "`(let (,(first bindings))\n" + + "(let* ,(rest bindings) . ,body)))))\n" + + +"(define letrec\n" + + "(macro (bindings . body)\n" + + "(let ((vars (map first bindings))\n" + + "(vals (map second bindings)))\n" + + "`(let ,(map (lambda (var) `(,var #f)) vars)\n" + + ",@(map (lambda (var val) `(set! ,var ,val)) vars vals)\n" + + ". ,body))))\n" + + +"(define case\n" + + "(macro (exp . cases)\n" + + "(define (do-case case)\n" + + "(cond ((not (pair? case)) (error \"bad syntax in case\" case))\n" + + "((eq? (first case) 'else) case)\n" + + "(else `((member __exp__ ',(first case)) . ,(rest case)))))\n" + + "`(let ((__exp__ ,exp)) (cond . ,(map do-case cases)))))\n" + + +"(define do\n" + + "(macro (bindings test-and-result . body)\n" + + "(let ((variables (map first bindings))\n" + + "(inits (map second bindings))\n" + + "(steps (map (lambda (clause)\n" + + "(if (null? (cddr clause))\n" + + "(first clause)\n" + + "(third clause)))\n" + + "bindings))\n" + + "(test (first test-and-result))\n" + + "(result (rest test-and-result)))\n" + + "`(letrec ((__loop__\n" + + "(lambda ,variables\n" + + "(if ,test\n" + + "(begin . ,result)\n" + + "(begin\n" + + ",@body\n" + + "(__loop__ . ,steps))))))\n" + + "(__loop__ . ,inits)))))\n" + + +"(define delay\n" + + "(macro (exp)\n" + + "(define (make-promise proc)\n" + + "(let ((result-ready? #f)\n" + + "(result #f))\n" + + "(lambda ()\n" + + "(if result-ready?\n" + + "result\n" + + "(let ((x (proc)))\n" + + "(if result-ready?\n" + + "result\n" + + "(begin (set! result-ready? #t)\n" + + "(set! result x)\n" + + "result)))))))\n" + + "`(,make-promise (lambda () ,exp))))\n" + + +//;;;;;;;;;;;;;;;; Extensions + +"(define time\n" + + "(macro (exp . rest) `(time-call (lambda () ,exp) . ,rest)))\n" +; +} diff --git a/modules/lnjscheme/LNjScheme/SchemeUtils.java b/modules/lnjscheme/LNjScheme/SchemeUtils.java new file mode 100644 index 00000000..493d6f3d --- /dev/null +++ b/modules/lnjscheme/LNjScheme/SchemeUtils.java @@ -0,0 +1,314 @@ +package LNjScheme; + +/** @author Peter Norvig, peter@norvig.com http://www.norvig.com + * Copyright 1998 Peter Norvig, see http://www.norvig.com/license.html **/ + +import java.io.*; + +public abstract class SchemeUtils { + + /** Same as Boolean.TRUE. **/ + public static final Boolean TRUE = Boolean.TRUE; + /** Same as Boolean.FALSE. **/ + public static final Boolean FALSE = Boolean.FALSE; + + public static Double ZERO = new Double(0.0); + public static Double ONE = new Double(1.0); + //////////////// Conversion Routines //////////////// + + // The following convert or coerce objects to the right type. + + /** Convert boolean to Boolean. **/ + public static Boolean truth(boolean x) { return x ? TRUE : FALSE; } + + /** Convert Scheme object to boolean. Only #f is false, others are true. **/ + public static boolean truth(Object x) { return x != FALSE; } + + /** Convert double to Double. Caches 0 and 1; makes new for others. **/ + public static Double num(double x) { + return (x == 0.0) ? ZERO : (x == 1.0) ? ONE : new Double(x); } + + /** Converts a Scheme object to a double, or calls error. **/ + public static double num(Object x) { + if (x instanceof Number) return ((Number)x).doubleValue(); + else return num(error("expected a number, got: " + x)); + } + + /** Converts a Scheme object to a char, or calls error. **/ + public static char chr(Object x) { + if (x instanceof Character) return ((Character)x).charValue(); + else return chr(error("expected a char, got: " + x)); + } + + /** Converts a char to a Character. **/ + public static Character chr(char ch) { + return new Character(ch); + } + + /** Coerces a Scheme object to a Scheme string, which is a char[]. **/ + public static char[] str(Object x) { + if (x instanceof char[]) return (char[])x; + else return str(error("expected a string, got: " + x)); + } + + /** Coerces a Scheme object to a Scheme symbol, which is a string. **/ + public static String sym(Object x) { + if (x instanceof String) return (String)x; + else return sym(error("expected a symbol, got: " + x)); + } + + /** Coerces a Scheme object to a Scheme vector, which is a Object[]. **/ + public static Object[] vec(Object x) { + if (x instanceof Object[]) return (Object[])x; + else return vec(error("expected a vector, got: " + x)); + } + + /** Coerces a Scheme object to a Scheme input port, which is an InputPort. + * If the argument is null, returns interpreter.input. **/ + public static InputPort inPort(Object x, Scheme interp) { + if (x == null) return interp.input; + else if (x instanceof InputPort) return (InputPort)x; + else return inPort(error("expected an input port, got: " + x), interp); + } + + /** Coerces a Scheme object to a Scheme input port, which is a PrintWriter. + * If the argument is null, returns System.out. **/ + public static PrintWriter outPort(Object x, Scheme interp) { + if (x == null) return interp.output; + else if (x instanceof PrintWriter) return (PrintWriter)x; + else return outPort(error("expected an output port, got: " + x), interp); + } + + //////////////// Error Routines //////////////// + + /** A continuable error. Prints an error message and then prompts for + * a value to eval and return. **/ + public static Object error(String message) { + System.err.println("**** ERROR: " + message); + throw new RuntimeException(message); + } + + public static Object warn(String message) { + System.err.println("**** WARNING: " + message); + return ""; + } + + //////////////// Basic manipulation Routines //////////////// + + // The following are used throughout the code. + + /** Like Common Lisp first; car of a Pair, or null for anything else. **/ + public static Object first(Object x) { + return (x instanceof Pair) ? ((Pair)x).first : null; + } + + /** Like Common Lisp rest; car of a Pair, or null for anything else. **/ + public static Object rest(Object x) { + return (x instanceof Pair) ? ((Pair)x).rest : null; + } + + /** Like Common Lisp (setf (first ... **/ + public static Object setFirst(Object x, Object y) { + return (x instanceof Pair) ? ((Pair)x).first = y + : error("Attempt to set-car of a non-Pair:" + stringify(x)); + } + + /** Like Common Lisp (setf (rest ... **/ + public static Object setRest(Object x, Object y) { + return (x instanceof Pair) ? ((Pair)x).rest = y + : error("Attempt to set-cdr of a non-Pair:" + stringify(x)); + } + + /** Like Common Lisp second. **/ + public static Object second(Object x) { + return first(rest(x)); + } + + /** Like Common Lisp third. **/ + public static Object third(Object x) { + return first(rest(rest(x))); + } + + /** Creates a two element list. **/ + public static Pair list(Object a, Object b) { + return new Pair(a, new Pair(b, null)); + } + + /** Creates a one element list. **/ + public static Pair list(Object a) { + return new Pair(a, null); + } + + /** listStar(args) is like Common Lisp (apply #'list* args) **/ + public static Object listStar(Object args) { + if (rest(args) == null) return first(args); + else return cons(first(args), listStar(rest(args))); + } + + /** cons(x, y) is the same as new Pair(x, y). **/ + public static Pair cons(Object a, Object b) { + return new Pair(a, b); + } + + /** Reverse the elements of a list. **/ + public static Object reverse(Object x) { + Object result = null; + while (x instanceof Pair) { + result = cons(first(x), result); + x = rest(x); + } + return result; + } + + /** Check if two objects are equal. **/ + public static boolean equal(Object x, Object y) { + if (x == null || y == null) { + return x == y; + } else if (x instanceof char[]) { + if (!(y instanceof char[])) return false; + char[] xc = (char[])x, yc = (char[])y; + if (xc.length != yc.length) return false; + for (int i = xc.length - 1; i >= 0; i--) { + if (xc[i] != yc[i]) return false; + } + return true; + } else if (x instanceof Object[]) { + if (!(y instanceof Object[])) return false; + Object[] xo = (Object[])x, yo = (Object[])y; + if (xo.length != yo.length) return false; + for (int i = xo.length - 1; i >= 0; i--) { + if (!equal(xo[i],yo[i])) return false; + } + return true; + } else { + return x.equals(y); + } + } + + /** Check if two objects are == or are equal numbers or characters. **/ + public static boolean eqv(Object x, Object y) { + return x == y + || (x instanceof Double && x.equals(y)) + || (x instanceof Character && x.equals(y)); + } + + /** The length of a list, or zero for a non-list. **/ + public static int length(Object x) { + int len = 0; + while (x instanceof Pair) { + len++; + x = ((Pair)x).rest; + } + return len; + } + + /** Convert a list of characters to a Scheme string, which is a char[]. **/ + public static char[] listToString(Object chars) { + char[] str = new char[length(chars)]; + for (int i = 0; chars instanceof Pair; i++) { + str[i] = chr(first(chars)); + chars = rest(chars); + } + return str; + } + + /** Convert a list of Objects to a Scheme vector, which is a Object[]. **/ + public static Object[] listToVector(Object objs) { + Object[] vec = new Object[length(objs)]; + for (int i = 0; objs instanceof Pair; i++) { + vec[i] = first(objs); + objs = rest(objs); + } + return vec; + } + + /** Write the object to a port. If quoted is true, use "str" and #\c, + * otherwise use str and c. **/ + public static Object write(Object x, PrintWriter port, boolean quoted) { + port.print(stringify(x, quoted)); + port.flush(); + return x; + } + + /** Convert a vector to a List. **/ + public static Pair vectorToList(Object x) { + if (x instanceof Object[]) { + Object[] vec = (Object[])x; + Pair result = null; + for (int i = vec.length - 1; i >= 0; i--) + result = cons(vec[i], result); + return result; + } else { + error("expected a vector, got: " + x); + return null; + } + } + + /** Convert a Scheme object to its printed representation, as + * a java String (not a Scheme string). If quoted is true, use "str" and #\c, + * otherwise use str and c. You need to pass in a StringBuffer that is used + * to accumulate the results. (If the interface didn't work that way, the + * system would use lots of little internal StringBuffers. But note that + * you can still call stringify(x) and a new StringBuffer will + * be created for you. **/ + + static void stringify(Object x, boolean quoted, StringBuffer buf) { + if (x == null) + buf.append("()"); + else if (x instanceof Double) { + double d = ((Double)x).doubleValue(); + if (Math.round(d) == d) buf.append((long)d); else buf.append(d); + } else if (x instanceof Character) { + if (quoted) buf.append("#\\"); + buf.append(x); + } else if (x instanceof Pair) { + ((Pair)x).stringifyPair(quoted, buf); + } else if (x instanceof char[]) { + char[] chars = (char[])x; + if (quoted) buf.append('"'); + for (int i = 0; i < chars.length; i++) { + if (quoted && chars[i] == '"') buf.append('\\'); + buf.append(chars[i]); + } + if (quoted) buf.append('"'); + } else if (x instanceof Object[]) { + Object[] v = (Object[])x; + buf.append("#("); + for (int i=0; iquoted is true.. **/ + static String stringify(Object x, boolean quoted) { + StringBuffer buf = new StringBuffer(); + stringify(x, quoted, buf); + return buf.toString(); + } + + /** For debugging purposes, prints output. **/ + static Object p(Object x) { + System.out.println(stringify(x)); + return x; + } + + /** For debugging purposes, prints output. **/ + static Object p(String msg, Object x) { + System.out.println(msg + ": " + stringify(x)); + return x; + } +} diff --git a/modules/lnjscheme/LNjScheme/primitives.scm b/modules/lnjscheme/LNjScheme/primitives.scm new file mode 100644 index 00000000..30c81cac --- /dev/null +++ b/modules/lnjscheme/LNjScheme/primitives.scm @@ -0,0 +1,146 @@ +;; Scheme primitives implemented in Scheme. +;; The quasiquote, and a few others, are from Darius Bacon +;; (But then, he started with my PAIP code, and modified it.) +;; - Peter Norvig + +;;;;;;;;;;;;;;;; Extensions: new names for old procedures + +(define call/cc call-with-current-continuation) +(define first car) +(define second cadr) +(define third caddr) +(define rest cdr) +(define set-first! set-car!) +(define set-rest! set-cdr!) + +;;;;;;;;;;;;;;;; Standard Scheme Macros + +(define or + (macro args + (if (null? args) + #f + (cons 'cond (map list args))))) + +(define and + (macro args + (cond ((null? args) #t) + ((null? (rest args)) (first args)) + (else (list 'if (first args) (cons 'and (rest args)) #f))))) + +(define quasiquote + (macro (x) + (define (constant? exp) + (if (pair? exp) (eq? (car exp) 'quote) (not (symbol? exp)))) + (define (combine-skeletons left right exp) + (cond + ((and (constant? left) (constant? right)) + (if (and (eqv? (eval left) (car exp)) + (eqv? (eval right) (cdr exp))) + (list 'quote exp) + (list 'quote (cons (eval left) (eval right))))) + ((null? right) (list 'list left)) + ((and (pair? right) (eq? (car right) 'list)) + (cons 'list (cons left (cdr right)))) + (else (list 'cons left right)))) + (define (expand-quasiquote exp nesting) + (cond + ((vector? exp) + (list 'apply 'vector (expand-quasiquote (vector->list exp) nesting))) + ((not (pair? exp)) + (if (constant? exp) exp (list 'quote exp))) + ((and (eq? (car exp) 'unquote) (= (length exp) 2)) + (if (= nesting 0) + (second exp) + (combine-skeletons ''unquote + (expand-quasiquote (cdr exp) (- nesting 1)) + exp))) + ((and (eq? (car exp) 'quasiquote) (= (length exp) 2)) + (combine-skeletons ''quasiquote + (expand-quasiquote (cdr exp) (+ nesting 1)) + exp)) + ((and (pair? (car exp)) + (eq? (caar exp) 'unquote-splicing) + (= (length (car exp)) 2)) + (if (= nesting 0) + (list 'append (second (first exp)) + (expand-quasiquote (cdr exp) nesting)) + (combine-skeletons (expand-quasiquote (car exp) (- nesting 1)) + (expand-quasiquote (cdr exp) nesting) + exp))) + (else (combine-skeletons (expand-quasiquote (car exp) nesting) + (expand-quasiquote (cdr exp) nesting) + exp)))) + (expand-quasiquote x 0))) + +(define let + (macro (bindings . body) + (define (named-let name bindings body) + `(let ((,name #f)) + (set! ,name (lambda ,(map first bindings) . ,body)) + (,name . ,(map second bindings)))) + (if (symbol? bindings) + (named-let bindings (first body) (rest body)) + `((lambda ,(map first bindings) . ,body) . ,(map second bindings))))) + +(define let* + (macro (bindings . body) + (if (null? bindings) `((lambda () . ,body)) + `(let (,(first bindings)) + (let* ,(rest bindings) . ,body))))) + +(define letrec + (macro (bindings . body) + (let ((vars (map first bindings)) + (vals (map second bindings))) + `(let ,(map (lambda (var) `(,var #f)) vars) + ,@(map (lambda (var val) `(set! ,var ,val)) vars vals) + . ,body)))) + +(define case + (macro (exp . cases) + (define (do-case case) + (cond ((not (pair? case)) (error "bad syntax in case" case)) + ((eq? (first case) 'else) case) + (else `((member __exp__ ',(first case)) . ,(rest case))))) + `(let ((__exp__ ,exp)) (cond . ,(map do-case cases))))) + +(define do + (macro (bindings test-and-result . body) + (let ((variables (map first bindings)) + (inits (map second bindings)) + (steps (map (lambda (clause) + (if (null? (cddr clause)) + (first clause) + (third clause))) + bindings)) + (test (first test-and-result)) + (result (rest test-and-result))) + `(letrec ((__loop__ + (lambda ,variables + (if ,test + (begin . ,result) + (begin + ,@body + (__loop__ . ,steps)))))) + (__loop__ . ,inits))))) + +(define delay + (macro (exp) + (define (make-promise proc) + (let ((result-ready? #f) + (result #f)) + (lambda () + (if result-ready? + result + (let ((x (proc))) + (if result-ready? + result + (begin (set! result-ready? #t) + (set! result x) + result))))))) + `(,make-promise (lambda () ,exp)))) + +;;;;;;;;;;;;;;;; Extensions + +(define time + (macro (exp . rest) `(time-call (lambda () ,exp) . ,rest))) diff --git a/modules/lnjscheme/MODULES b/modules/lnjscheme/MODULES new file mode 100644 index 00000000..04204c7c --- /dev/null +++ b/modules/lnjscheme/MODULES @@ -0,0 +1 @@ +config diff --git a/modules/lnjscheme/Makefile b/modules/lnjscheme/Makefile new file mode 100644 index 00000000..deab01d2 --- /dev/null +++ b/modules/lnjscheme/Makefile @@ -0,0 +1,8 @@ + +NAME=LNjScheme + +android_jars/$(NAME).jar: $(NAME)/*.java + @-mkdir android_jars + rm -f $(NAME)/*.class + javac $(NAME)/Scheme.java + jar cf $@ $(NAME)/*.class diff --git a/modules/lnjscheme/README.md b/modules/lnjscheme/README.md new file mode 100644 index 00000000..7e429264 --- /dev/null +++ b/modules/lnjscheme/README.md @@ -0,0 +1,69 @@ +# LNjScheme + +This directory contains an app to demo how to use LNjScheme from LN. + +LNjScheme allows to call any Java/Android method from +lambdanative/gambit without additional JNI code. Either directly or +within the UI thread (dispatched asynchronously via `runOnUiThread`). + +## Build + +call `make -f Makefile` in this directory to create `android_jars/LNjScheme.jar`. + +# History + +LNjScheme is derived from the 1.4 version of +[Jscheme from Peter Norvig](http://norvig.com/jscheme.html). + +Jscheme version 1.4, the last version that I released (in April +1998). A mercilessly small, easily modifiable version. + +(NB: There is another thing going by the name Jscheme, which was +extented by a community until 2006. This version grew beyond the +features, complexity and size which make the Pter Norvigs version +interesting as a strating point.) + +Jscheme 1.4 however lacks a few features, notably the ability supply +arguments to constructors. Therefore a derivative was required for +LN. In accordance with the stated license for Jscheme it got a new +name. + +## Changes + +1. Baseline: unpacked the sources from `jscheme-source.jar` into + subdirectory `LNjScheme`. +2. Changed package name to + +LNjScheme and added Makefile. +3. Refined errors raised from application of Java methods. +4. Pulled some code from the community version to support constructors with arguments. +5. Copied glue code from experimental branch and rename identifiers. + +# Issues + +## Numbers + +jScheme uses `lang.java.Double` for all numbers. This does not play +nice with native Jave APIs. TBD: Teach it either about fixnums or +conversion; or both. + +## Missing + +Really missing is the ability to access arbitrary field values (as +apposed to calling methods) of any class. + +From +https://stackoverflow.com/questions/13400075/reflection-generic-get-field-value + + import java.lang.reflect.Field; + + Field chap = c.getDeclaredField("chapters"); + out.format(fmt, "before", "chapters", book.chapters); + chap.setLong(book, 12); + out.format(fmt, "after", "chapters", chap.getLong(book)); + + Field[] fields = c.getDeclaredFields(); + for (Field classField : fields) + { + result.add(classField); + } diff --git a/modules/lnjscheme/lnjscheme.scm b/modules/lnjscheme/lnjscheme.scm new file mode 100644 index 00000000..4b04184b --- /dev/null +++ b/modules/lnjscheme/lnjscheme.scm @@ -0,0 +1,117 @@ +(cond-expand + (android + (c-declare "extern const char* android_app_class();") + (define android-app-class (c-lambda () char-string "android_app_class"))) + (else (define (android-app-class) + (log-error "android-app-class: called in non-Android context") + "android-app-class"))) + +(define lnjscheme-eval + ;; Not sure that we need a mutex here. But what if the java side + ;; manages to call into gambit? + (let ((mutex (make-mutex 'lnjscheme))) + (define lnjscheme-invoke/s2s + (c-lambda (char-string) char-string " +#ifdef ANDROID +extern const char *lnjscheme_eval(const char *); +#endif +___result= +#ifdef ANDROID +(char*) lnjscheme_eval(___arg1); +#else +NULL; +#endif +")) + (define (lnjscheme-call obj) + (let* ((s (let ((req (object->string obj))) + (mutex-lock! mutex) + (cond-expand + (android (lnjscheme-invoke/s2s req)) + (else (error "lnjscheme-call: not availible on platform" (system-platform)))))) + (r0 (begin + (mutex-unlock! mutex) + (if (string? s) + (call-with-input-string s + (lambda (port) + (let* ((key (read port)) + (value + (with-exception-catcher + (lambda (exn) (raise (string-append "lnjscheme-call: unreadable result: " s))) + (lambda () (read port))))) + (case key + ((D) value) + ((E) (raise value)) + (else (error "lnjscheme-call: unexpected reply " s)))))) + (error "lnjscheme-call: unexpected reply " s))))) + (cond + ;; Numbers are always printed as inexacts by jscheme. + ((integer? r0) (inexact->exact r0)) + (else r0)))) + lnjscheme-call)) + +(define LNjScheme-result #f) + +(define lnjscheme-future + ;; Not sure that we need a mutex here. But what if the java side + ;; manages to call into gambit? + (let ((mutex (make-mutex 'LNjScheme))) + (define jscheme-send + (c-lambda (char-string) void " +#ifdef ANDROID +extern void lnjscheme_eval_send(const char *); +lnjscheme_eval_send(___arg1); +#endif +")) + (define jscheme-receive + (c-lambda () char-string " +#ifdef ANDROID +extern const char *lnjscheme_eval_receive_result(); +#endif +___result= +#ifdef ANDROID +(char*) lnjscheme_eval_receive_result(); +#else +NULL; +#endif +")) + (define (noresult) #f) + (define (reset!) (set! LNjScheme-result noresult)) + (define (jscheme-call obj) + (cond-expand + (android) + (else (error "jscheme-call: not availible on platform" (system-platform)))) + (mutex-lock! mutex) + (let ((resm (make-mutex obj))) + (mutex-lock! resm) + (set! LNjScheme-result + (lambda () + (reset!) + (mutex-specific-set! resm (jscheme-receive)) + (mutex-unlock! mutex) + (mutex-unlock! resm))) + (jscheme-send (object->string obj)) + (delay + (let* ((s (begin + (mutex-lock! resm #f #f) + (mutex-specific resm))) + (r0 (begin + (if (string? s) + (call-with-input-string + s + (lambda (port) + (let* ((key (read port)) + (value + (with-exception-catcher + (lambda (exn) (raise (string-append "jscheme-call: unreadable result: " s))) + (lambda () (read port))))) + (case key + ((D) value) + ((E) (raise value)) + (else (error "jscheme-call: unexpected reply " s)))))) + (error "jscheme-call: unexpected reply " s))))) + (cond + ;; Numbers are always printed as inexacts by jscheme. + ((integer? r0) (inexact->exact r0)) + (else r0)))))) + (reset!) + jscheme-call)) From da5726bea2f8af502306815c8c89b4d694660eac Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=B6rg=20F=2E=20Wittenberger?= Date: Mon, 2 Nov 2020 12:13:31 +0100 Subject: [PATCH 16/26] ANDROID: actually use the new file information --- libraries/liblambdanative/system.c | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/libraries/liblambdanative/system.c b/libraries/liblambdanative/system.c index 58966403..a63ba2c1 100644 --- a/libraries/liblambdanative/system.c +++ b/libraries/liblambdanative/system.c @@ -152,9 +152,23 @@ static void find_directories() // we put files on the sdcard, that's the only sane place (?) extern char* android_getFilesDir(); char path[1024]; +#if 0 sprintf(path,"/sdcard/%s", SYS_APPNAME); sys_dir=strdup(path); sys_appdir=android_getFilesDir(); +#endif +#if 0 + sprintf(path,"%s/system", android_getFilesDir()); + sys_dir=strdup(path); + sprintf(path,"%s/data", android_getFilesDir()); + sys_appdir=strdup(path); +#endif +#if 1 + sprintf(path,"/sdcard/%s", SYS_APPNAME); + sys_dir=strdup(path); + sys_appdir=android_getFilesDir(); +#endif + #endif #if defined(BB10) || defined(PLAYBOOK) char path[1024], cwd[1024]; From d689216452c3fe3cdbc679724d93b2f03ab124fc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=B6rg=20F=2E=20Wittenberger?= Date: Wed, 4 Nov 2020 10:11:22 +0100 Subject: [PATCH 17/26] LNjScheme: better integration with eventloop --- modules/eventloop/eventloop.scm | 29 +++- .../lnjscheme/ANDROID_java_activityadditions | 1 + modules/lnjscheme/MODULES | 2 +- modules/lnjscheme/lnjscheme.scm | 155 ++++++++---------- 4 files changed, 95 insertions(+), 92 deletions(-) diff --git a/modules/eventloop/eventloop.scm b/modules/eventloop/eventloop.scm index bd3c9bbf..cbc2a4ab 100644 --- a/modules/eventloop/eventloop.scm +++ b/modules/eventloop/eventloop.scm @@ -149,9 +149,29 @@ end-of-c-declare (define (event-push t x y) (set! event:fifo (append event:fifo (list (list t x y))))) (define (event-pop) - (if (fx> (length event:fifo) 0) - (let ((ret (car event:fifo))) - (set! event:fifo (cdr event:fifo)) ret) #f)) + (if (null? event:fifo) #f + (let ((ret (car event:fifo))) + (set! event:fifo (cdr event:fifo)) ret))) + +(define on-jscm-result + (let ((mux (make-mutex 'on-jscm-result))) + (mutex-specific-set! mux #f) + (lambda args + (cond + ((null? args) ;; return receiver procedure + (lambda (t x y) + (let ((proc (mutex-specific mux))) + (when proc + (mutex-specific-set! mux #f) + (proc t x y) + (mutex-unlock! mux))))) + ((let ((proc (car args))) (and (procedure? proc) proc)) => + ;; set `proc` as inner receiver + (lambda (proc) + (mutex-lock! mux) + (mutex-specific-set! mux proc) + #t)) + (else (log-error "illegal arguments" on-jscm-result args)))))) (define eventloop:mutex (make-mutex 'eventloop)) (define (eventloop:grab!) (mutex-lock! eventloop:mutex)) @@ -181,8 +201,7 @@ end-of-c-declare (hook:event t (if app:scale? (fix (* app:xscale x)) x) (if app:scale? (fix (* app:yscale y)) y)) ) - ((fx= t EVENT_JSCM_RESULT) - (if (function-exists? LNjScheme-result) (LNjScheme-result))) + ((fx= t EVENT_JSCM_RESULT) ((on-jscm-result) t x y)) ((fx= t EVENT_INIT) ;; prevent multiple inits (if app:mustinit (begin diff --git a/modules/lnjscheme/ANDROID_java_activityadditions b/modules/lnjscheme/ANDROID_java_activityadditions index d8a64863..f7e076ca 100644 --- a/modules/lnjscheme/ANDROID_java_activityadditions +++ b/modules/lnjscheme/ANDROID_java_activityadditions @@ -127,6 +127,7 @@ public void LNjSchemeSend(String msg) { } // ln_log("LNjScheme notifying result"); nativeEvent(126,0,0); + // ln_log("LNjScheme native event 126 done."); } }.start(); runOnUiThread(job); diff --git a/modules/lnjscheme/MODULES b/modules/lnjscheme/MODULES index 04204c7c..63d57220 100644 --- a/modules/lnjscheme/MODULES +++ b/modules/lnjscheme/MODULES @@ -1 +1 @@ -config +config eventloop diff --git a/modules/lnjscheme/lnjscheme.scm b/modules/lnjscheme/lnjscheme.scm index 4b04184b..2faddec0 100644 --- a/modules/lnjscheme/lnjscheme.scm +++ b/modules/lnjscheme/lnjscheme.scm @@ -6,55 +6,23 @@ (log-error "android-app-class: called in non-Android context") "android-app-class"))) -(define lnjscheme-eval - ;; Not sure that we need a mutex here. But what if the java side - ;; manages to call into gambit? - (let ((mutex (make-mutex 'lnjscheme))) - (define lnjscheme-invoke/s2s - (c-lambda (char-string) char-string " -#ifdef ANDROID -extern const char *lnjscheme_eval(const char *); -#endif -___result= -#ifdef ANDROID -(char*) lnjscheme_eval(___arg1); -#else -NULL; -#endif -")) - (define (lnjscheme-call obj) - (let* ((s (let ((req (object->string obj))) - (mutex-lock! mutex) - (cond-expand - (android (lnjscheme-invoke/s2s req)) - (else (error "lnjscheme-call: not availible on platform" (system-platform)))))) - (r0 (begin - (mutex-unlock! mutex) - (if (string? s) - (call-with-input-string s - (lambda (port) - (let* ((key (read port)) - (value - (with-exception-catcher - (lambda (exn) (raise (string-append "lnjscheme-call: unreadable result: " s))) - (lambda () (read port))))) - (case key - ((D) value) - ((E) (raise value)) - (else (error "lnjscheme-call: unexpected reply " s)))))) - (error "lnjscheme-call: unexpected reply " s))))) - (cond - ;; Numbers are always printed as inexacts by jscheme. - ((integer? r0) (inexact->exact r0)) - (else r0)))) - lnjscheme-call)) - -(define LNjScheme-result #f) - -(define lnjscheme-future - ;; Not sure that we need a mutex here. But what if the java side - ;; manages to call into gambit? - (let ((mutex (make-mutex 'LNjScheme))) +(define call-with-lnjscheme-result + ;; SIGNATURE (NAME S-EXPR #!optional (RECEIVER force)) + ;; + ;; S-EXPR: Scheme s-expression in JSCM dialect + ;; + ;; RECEIVER: 1-ary procedure signature copatible to `force` + ;; + ;; Note: On the RECEIVERs descrection the result could be `forced`ed + ;; with, e.g., exception handlers in place, another threads context. + ;; The default is to fail as early as possible: on the events + ;; reception. However delaying the failure into the RECEIVERs + ;; context has the advantage of more focused failure location while + ;; risking to mask failures in background processing. + ;; + ;; Ergo: fail immeditately when testing or in background. RECEIVER, + ;; if provided, may override. + (let () (define jscheme-send (c-lambda (char-string) void " #ifdef ANDROID @@ -74,44 +42,59 @@ ___result= NULL; #endif ")) - (define (noresult) #f) - (define (reset!) (set! LNjScheme-result noresult)) - (define (jscheme-call obj) + (define (jscheme-read-reply obj) + (if (string? obj) + (call-with-input-string + obj + (lambda (port) + (let* ((key (read port)) + (value + (with-exception-catcher + (lambda (exn) (raise (string-append "jscheme-call: unreadable result: " obj))) + (lambda () (read port))))) + (case key + ((D) value) + ((E) (raise value)) + (else (error "jscheme-call: unexpected reply " obj)))))) + (error "jscheme-call: unexpected reply " obj))) + (define (jscheme-refine-result obj) + (cond + ;; Numbers are always printed as inexacts by jscheme. + ((integer? obj) (inexact->exact obj)) + (else obj))) + (define (jscheme-call obj #!optional (receiver force)) (cond-expand (android) - (else (error "jscheme-call: not availible on platform" (system-platform)))) - (mutex-lock! mutex) - (let ((resm (make-mutex obj))) - (mutex-lock! resm) - (set! LNjScheme-result - (lambda () - (reset!) - (mutex-specific-set! resm (jscheme-receive)) - (mutex-unlock! mutex) - (mutex-unlock! resm))) + (else (log-error "jscheme-call: not availible on platform" (system-platform)))) + (on-jscm-result + (lambda (t x y) + (let* ((reply (jscheme-receive)) ;; extract the result from Java + ;; delay evalutation + (promise (delay (jscheme-refine-result (jscheme-read-reply reply))))) + ;; The optional receiver MAY either dispatch to + ;; asynchroneous forcing the promise catching exceptions + ;; etc. by default force it expection the application to + ;; abort on any exception. + (receiver promise)))) (jscheme-send (object->string obj)) - (delay - (let* ((s (begin - (mutex-lock! resm #f #f) - (mutex-specific resm))) - (r0 (begin - (if (string? s) - (call-with-input-string - s - (lambda (port) - (let* ((key (read port)) - (value - (with-exception-catcher - (lambda (exn) (raise (string-append "jscheme-call: unreadable result: " s))) - (lambda () (read port))))) - (case key - ((D) value) - ((E) (raise value)) - (else (error "jscheme-call: unexpected reply " s)))))) - (error "jscheme-call: unexpected reply " s))))) - (cond - ;; Numbers are always printed as inexacts by jscheme. - ((integer? r0) (inexact->exact r0)) - (else r0)))))) - (reset!) + (thread-yield!)) jscheme-call)) + +(define (lnjscheme-future obj) + ;; a promise waiting for the evaluation of OBJ + (let ((result (make-mutex obj))) + (mutex-lock! result #f #f) + (call-with-lnjscheme-result + obj + (lambda (promise) + (mutex-specific-set! result promise) + (mutex-unlock! result))) + (delay + (begin + (mutex-lock! result #f #f) + (force (mutex-specific result)))))) + +(define (lnjscheme-eval obj) + ;; BEWARE: This blocks the current thread. WILL deadlock NOT when + ;; run in event handler thread. + (force (lnjscheme-future obj))) From d842fa8113602199203df2fbdb9155952e5d39ab Mon Sep 17 00:00:00 2001 From: Peter Lewis Date: Thu, 19 Nov 2020 14:58:22 -0800 Subject: [PATCH 18/26] ANDROID: moved setContentView to after permissions Calling setContentView between permission requests would cause some apps to hang. This problem was previously addressed by adding a shell override function for onRequestPermissionResult, which is no longer needed and is removed in this commit --- loaders/android/bootstrap.java.in | 20 ++++---------------- 1 file changed, 4 insertions(+), 16 deletions(-) diff --git a/loaders/android/bootstrap.java.in b/loaders/android/bootstrap.java.in index 40771b9e..189ffdb7 100644 --- a/loaders/android/bootstrap.java.in +++ b/loaders/android/bootstrap.java.in @@ -108,17 +108,6 @@ public class @SYS_APPNAME@ extends Activity implements @ANDROID_JAVA_IMPLEMENTS@ return true; } - @IF_ANDROIDAPI_GT_22@ - @Override - public void onRequestPermissionsResult(int requestCode, String[] permissions, int[] grantResults) { - super.onRequestPermissionsResult(requestCode, permissions, grantResults); - //Must do something with results data or app will hang - int rc = requestCode; - String p = permissions[0]; - int gr = grantResults[0]; - } - /* end of IF_ANDROIDAPI_GT_22 */ - @Override public void startActivityForResult(Intent intent, int cont) { try { @@ -187,15 +176,14 @@ public class @SYS_APPNAME@ extends Activity implements @ANDROID_JAVA_IMPLEMENTS@ nativeInstanceInit(getApplicationContext().getPackageCodePath().toString(), getFilesDir().toString()); mSensorManager = (SensorManager)getSystemService(Context.SENSOR_SERVICE); - checkOrRequestPermission(android.Manifest.permission.WRITE_EXTERNAL_STORAGE); - setContentView(mGLView); // MUST NOT run before nativeInstanceInit completed - // Additions needed by modules, e.g. gps + checkOrRequestPermission(android.Manifest.permission.WRITE_EXTERNAL_STORAGE); + // Additions and permissions needed by modules, e.g. gps @ANDROID_JAVA_ONCREATE@ - nativeInstanceInit(getApplicationContext().getPackageCodePath().toString(), getFilesDir().toString()); - // start EVENT_IDLE setContentView(mGLView); // MUST NOT run before nativeInstanceInit completed + + // start EVENT_IDLE if(idle_tmScheduleRate > 0) idle_tm.scheduleAtFixedRate(idle_task, 0, idle_tmScheduleRate); } @Override From 5789272e7e0cfed33580a5edd31bb199195bf4bc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=B6rg=20F=2E=20Wittenberger?= Date: Fri, 20 Nov 2020 13:09:22 +0100 Subject: [PATCH 19/26] lnjscheme: incorporate upstream changes --- libraries/liblambdanative/system.c | 27 --------------------------- loaders/android/bootstrap.c.in | 17 +++++++++-------- loaders/android/bootstrap.java.in | 4 +++- modules/config/config.scm | 14 +++++--------- 4 files changed, 17 insertions(+), 45 deletions(-) diff --git a/libraries/liblambdanative/system.c b/libraries/liblambdanative/system.c index 55d15300..58966403 100644 --- a/libraries/liblambdanative/system.c +++ b/libraries/liblambdanative/system.c @@ -152,36 +152,9 @@ static void find_directories() // we put files on the sdcard, that's the only sane place (?) extern char* android_getFilesDir(); char path[1024]; -#if 0 sprintf(path,"/sdcard/%s", SYS_APPNAME); sys_dir=strdup(path); sys_appdir=android_getFilesDir(); -#endif -#if 0 - sprintf(path,"%s/system", android_getFilesDir()); - sys_dir=strdup(path); - sprintf(path,"%s/data", android_getFilesDir()); - sys_appdir=strdup(path); -#endif -#if 1 - sprintf(path,"/sdcard/%s", SYS_APPNAME); - sys_dir=strdup(path); - sys_appdir=android_getFilesDir(); -#endif - -#endif -#if 0 - sprintf(path,"%s/system", android_getFilesDir()); - sys_dir=strdup(path); - sprintf(path,"%s/data", android_getFilesDir()); - sys_appdir=strdup(path); -#endif -#if 1 - sprintf(path,"/sdcard/%s", SYS_APPNAME); - sys_dir=strdup(path); - sys_appdir=android_getFilesDir(); -#endif - #endif #if defined(BB10) || defined(PLAYBOOK) char path[1024], cwd[1024]; diff --git a/loaders/android/bootstrap.c.in b/loaders/android/bootstrap.c.in index cec9df39..4e32681e 100644 --- a/loaders/android/bootstrap.c.in +++ b/loaders/android/bootstrap.c.in @@ -66,18 +66,19 @@ static const char* app_directory_files = NULL; static const char* app_code_path = NULL; void Java_@SYS_PACKAGE_UNDERSCORE@_@SYS_APPNAME@_nativeInstanceInit(JNIEnv* env, jobject thiz, jstring codePath, jstring directoryFiles){ - globalObj = (*env)->NewGlobalRef(env,thiz); - app_directory_files = strdup((*env)->GetStringUTFChars(env, directoryFiles, 0)); - (*env)->ReleaseStringUTFChars(env, directoryFiles, NULL); + app_directory_files = strdup((*env)->GetStringUTFChars(env, directoryFiles, 0)); + (*env)->ReleaseStringUTFChars(env, directoryFiles, app_directory_files); app_code_path = strdup((*env)->GetStringUTFChars(env, codePath, 0)); - (*env)->ReleaseStringUTFChars(env, codePath, NULL); + (*env)->ReleaseStringUTFChars(env, codePath, app_code_path); } -char* android_getFilesDir() { return (char*) app_directory_files; } -char* android_getPackageCodePath() { return (char*) app_code_path; } - -char* android_getFilesDir_info_get() { return android_getFilesDir(); } +char* android_getFilesDir() { + return (char*) app_directory_files; +} +char* android_getPackageCodePath() { + return (char*) app_code_path; +} jint JNI_OnLoad(JavaVM* vm, void* reserved){ JNIEnv *env; diff --git a/loaders/android/bootstrap.java.in b/loaders/android/bootstrap.java.in index 189ffdb7..f1b77848 100644 --- a/loaders/android/bootstrap.java.in +++ b/loaders/android/bootstrap.java.in @@ -210,7 +210,9 @@ public class @SYS_APPNAME@ extends Activity implements @ANDROID_JAVA_IMPLEMENTS@ @Override protected void onResume() { super.onResume(); - if(current_ContentView==mGLView) { mGLView.onResume(); } + if(current_ContentView==mGLView) { + mGLView.onResume(); + } // Additions needed by modules, e.g. gps @ANDROID_JAVA_ONRESUME@ } diff --git a/modules/config/config.scm b/modules/config/config.scm index d35c29e9..9cd6eaea 100644 --- a/modules/config/config.scm +++ b/modules/config/config.scm @@ -109,16 +109,12 @@ end-of-c-declare (cond-expand (android - (c-declare #< Date: Fri, 20 Nov 2020 13:37:31 +0100 Subject: [PATCH 20/26] DEMO: use of lnjscheme and webview --- apps/DemoAndroidLNjScheme/.gitignore | 1 - apps/DemoAndroidLNjScheme/ANDROID_c_additions | 59 -- .../ANDROID_java_activityadditions | 151 ---- .../LNjScheme/Closure.java | 28 - .../LNjScheme/Continuation.java | 17 - .../LNjScheme/Environment.java | 99 --- .../LNjScheme/InputPort.java | 210 ------ .../LNjScheme/JavaMethod.java | 251 ------ .../DemoAndroidLNjScheme/LNjScheme/Macro.java | 33 - apps/DemoAndroidLNjScheme/LNjScheme/Pair.java | 64 -- .../LNjScheme/Primitive.java | 714 ------------------ .../LNjScheme/Procedure.java | 20 - .../LNjScheme/Scheme.java | 150 ---- .../LNjScheme/SchemePrimitives.java | 158 ---- .../LNjScheme/SchemeUtils.java | 314 -------- .../LNjScheme/primitives.scm | 146 ---- apps/DemoAndroidLNjScheme/MODULES | 2 +- apps/DemoAndroidLNjScheme/Makefile | 8 - apps/DemoAndroidLNjScheme/README.md | 104 --- apps/DemoAndroidLNjScheme/VERSION | 2 +- .../android_jars/LNjScheme.jar | Bin 32216 -> 0 bytes apps/DemoAndroidLNjScheme/lnjscheme.scm | 110 --- apps/DemoAndroidLNjScheme/lnjstest.scm | 67 +- apps/DemoAndroidLNjScheme/main.scm | 73 +- .../webview/ANDROID_application_attributes | 1 + modules/webview/ANDROID_java_additions | 158 ++++ modules/webview/ANDROID_java_oncreate | 42 ++ .../webview/ANDROID_java_public_ProxySettings | 187 +++++ modules/webview/MODULES | 1 + modules/webview/webview.scm | 159 ++++ 30 files changed, 583 insertions(+), 2746 deletions(-) delete mode 100644 apps/DemoAndroidLNjScheme/.gitignore delete mode 100644 apps/DemoAndroidLNjScheme/ANDROID_c_additions delete mode 100644 apps/DemoAndroidLNjScheme/ANDROID_java_activityadditions delete mode 100644 apps/DemoAndroidLNjScheme/LNjScheme/Closure.java delete mode 100644 apps/DemoAndroidLNjScheme/LNjScheme/Continuation.java delete mode 100644 apps/DemoAndroidLNjScheme/LNjScheme/Environment.java delete mode 100644 apps/DemoAndroidLNjScheme/LNjScheme/InputPort.java delete mode 100644 apps/DemoAndroidLNjScheme/LNjScheme/JavaMethod.java delete mode 100644 apps/DemoAndroidLNjScheme/LNjScheme/Macro.java delete mode 100644 apps/DemoAndroidLNjScheme/LNjScheme/Pair.java delete mode 100644 apps/DemoAndroidLNjScheme/LNjScheme/Primitive.java delete mode 100644 apps/DemoAndroidLNjScheme/LNjScheme/Procedure.java delete mode 100644 apps/DemoAndroidLNjScheme/LNjScheme/Scheme.java delete mode 100644 apps/DemoAndroidLNjScheme/LNjScheme/SchemePrimitives.java delete mode 100644 apps/DemoAndroidLNjScheme/LNjScheme/SchemeUtils.java delete mode 100644 apps/DemoAndroidLNjScheme/LNjScheme/primitives.scm delete mode 100644 apps/DemoAndroidLNjScheme/Makefile delete mode 100644 apps/DemoAndroidLNjScheme/README.md delete mode 100644 apps/DemoAndroidLNjScheme/android_jars/LNjScheme.jar delete mode 100644 apps/DemoAndroidLNjScheme/lnjscheme.scm create mode 100644 modules/webview/ANDROID_application_attributes create mode 100644 modules/webview/ANDROID_java_additions create mode 100644 modules/webview/ANDROID_java_oncreate create mode 100644 modules/webview/ANDROID_java_public_ProxySettings create mode 100644 modules/webview/MODULES create mode 100644 modules/webview/webview.scm diff --git a/apps/DemoAndroidLNjScheme/.gitignore b/apps/DemoAndroidLNjScheme/.gitignore deleted file mode 100644 index 6b468b62..00000000 --- a/apps/DemoAndroidLNjScheme/.gitignore +++ /dev/null @@ -1 +0,0 @@ -*.class diff --git a/apps/DemoAndroidLNjScheme/ANDROID_c_additions b/apps/DemoAndroidLNjScheme/ANDROID_c_additions deleted file mode 100644 index 98e5aae0..00000000 --- a/apps/DemoAndroidLNjScheme/ANDROID_c_additions +++ /dev/null @@ -1,59 +0,0 @@ -/* -*-C-*- */ - -const char *android_app_class() { return "@SYS_PACKAGE_DOT@.@SYS_APPNAME@"; } // for jscheme - -/* lnjscheme_eval - * - * Evaluate input and return result. Due to Android limitations - * wrt. thread and evaluation context, calls might fail. E.g., Views - * may only be changed by the Java thread which created them. Use the - * asyncrhonous version in those cases. - */ -const char *lnjscheme_eval(const char *input) -{ - static const char *str = NULL; - static jstring jstr = NULL; - JNIEnv *env = GetJNIEnv(); - if (env&&globalObj){ - jstring jin = (*env)->NewStringUTF(env,input); - jclass main_class = (*env)->FindClass(env, "@SYS_PACKAGE_SLASH@/@SYS_APPNAME@"); - jmethodID method = main_class ? (*env)->GetMethodID(env, main_class, "LNjSchemeCall", "(Ljava/lang/String;)Ljava/lang/String;") : NULL; - if(jstr) { (*env)->ReleaseStringUTFChars(env, jstr, str); jstr = NULL; } // works? - jstr = (jstring) method ? (*env)->CallObjectMethod(env, globalObj, method, jin) : NULL; - // Is this required??? (*env)->ReleaseStringUTFChars(env, jin, NULL); - str = jstr ? (*env)->GetStringUTFChars(env, jstr, 0) : NULL; - // (*env)->ReleaseStringUTFChars(env, jstr, NULL); // we do it upon next call - } - return str; -} - -void lnjscheme_eval_send(const char *input) -{ - JNIEnv *env = GetJNIEnv(); - if (env&&globalObj){ - jstring jin = (*env)->NewStringUTF(env,input); - jclass main_class = (*env)->FindClass(env, "@SYS_PACKAGE_SLASH@/@SYS_APPNAME@"); - jmethodID method = main_class ? (*env)->GetMethodID(env, main_class, "LNjSchemeSend", "(Ljava/lang/String;)V") : NULL; - method ? (*env)->CallVoidMethod(env, globalObj, method, jin) : NULL; - // Is this required??? (*env)->ReleaseStringUTFChars(env, jin, NULL); - } -} - -// There is likely a way to do this better using only a Java->C call -// to deposit the result in a global variable. I just don't know yet -// how to do this. -const char *lnjscheme_eval_receive_result() -{ - static const char *str = NULL; - static jstring jstr = NULL; - JNIEnv *env = GetJNIEnv(); - if (env&&globalObj){ - jclass main_class = (*env)->FindClass(env, "@SYS_PACKAGE_SLASH@/@SYS_APPNAME@"); - jmethodID method = main_class ? (*env)->GetMethodID(env, main_class, "LNjSchemeResult", "()Ljava/lang/String;") : NULL; - if(jstr) { (*env)->ReleaseStringUTFChars(env, jstr, str); jstr = NULL; } // works? - jstr = (jstring) method ? (*env)->CallObjectMethod(env, globalObj, method) : NULL; - str = jstr ? (*env)->GetStringUTFChars(env, jstr, 0) : NULL; - // (*env)->ReleaseStringUTFChars(env, jstr, NULL); // we do it upon next call - } - return str; -} diff --git a/apps/DemoAndroidLNjScheme/ANDROID_java_activityadditions b/apps/DemoAndroidLNjScheme/ANDROID_java_activityadditions deleted file mode 100644 index 056bc848..00000000 --- a/apps/DemoAndroidLNjScheme/ANDROID_java_activityadditions +++ /dev/null @@ -1,151 +0,0 @@ -/* -*-java-*- */ - -/* # Helper methods */ - -/* LNjScheme_Set_OnClickListener: register a LNjScheme lambda to be called when the View is clicked. - * - * LNjScheme can not (yet) declare annonymous derived classes. (Or at - * least I don't know how that could be done.) - * - * For the time being we get along with a little Java. - */ -private android.view.View.OnClickListener LNjScheme_OnClickListener(final Object proc) { - return new android.view.View.OnClickListener() { - public void onClick(android.view.View v) { - LNjSchemeEvaluate(new LNjScheme.Pair(proc, new LNjScheme.Pair(v, null))); - } - }; -} -public void LNjScheme_Set_OnClickListener(android.view.View v, Object expr) { - v.setOnClickListener(LNjScheme_OnClickListener(expr)); -} - -/* LNtriggerRedraw: trigger a redraw for the LN app. - * - * TBD: Get rid of this method entirely. - */ -public void LNtriggerRedraw() { - // Likely there is a better way to achieve this. I don't know - // how. Note: calling mGLView.onPause causes issues without an - // override of ln_core's `(terminate)`. - mGLView.onPause(); - mGLView.onResume(); -} - -/* LNmGLView: find the original, backward compatible View */ -public GLSurfaceView LNmGLView() {return mGLView;} // FIXME implement field accessors instead! - -private static Object LNjScheme_this = null; // The instance of the app. -public static @SYS_PACKAGE_DOT@.@SYS_APPNAME@ me() {return (@SYS_PACKAGE_DOT@.@SYS_APPNAME@) LNjScheme_this;} - -/* # LNjScheme core */ - -private static LNjScheme.Scheme LNjSchemeSession = new LNjScheme.Scheme(new String[0]); - -public Object LNjSchemeEvaluate(Object expr) { - // sync with the one and only evaluator supported so far. - if(LNjSchemeSession != null) { - synchronized(LNjSchemeSession) { - LNjScheme_this = this; // TBD: It should be enough to initialize this once. - return LNjSchemeSession.eval(expr); - } - } else return null; -} - -/* jschemeCall: evaluate `msg` in any Java thread and return result - * - * FIXME TBD CHECK: This was the initial implementation, but might be broken now. - */ -public String jschemeCall(String msg) { - // BEWARE: Operations not safe to be called asynchronously from - // any thread, not safe to be called from various contexts (e.g., - // within "onDrawFrame" which amounts to "while reacting to - // EVENT_REDRAW"), etc. MAY HANG here. - // - // If you need fast execution and know the call is safe use this - // one. Otherwise use the two-phased version using - // `LNjSchemeSend` followed by a `LNjSchemeResult to dispatch the - // evaluation to `runOnUiThread` and wait for it to be eventually - // evaluated in a more-or-less safe context. - try { - LNjScheme.InputPort in = new LNjScheme.InputPort(new java.io.ByteArrayInputStream(msg.getBytes(java.nio.charset.Charset.forName("UTF-8")))); - Object expr = in.read(); - if(in.isEOF(expr)) return "E\n\"invalid input\""; - Object result = LNjSchemeEvaluate(expr); - java.io.StringWriter buf = new java.io.StringWriter(); - java.io.PrintWriter port = new java.io.PrintWriter(buf); - port.println("D"); - LNjScheme.SchemeUtils.write(result, port, true); - return buf.toString(); - } catch (Exception e) { - java.io.StringWriter buf = new java.io.StringWriter(); - java.io.PrintWriter port = new java.io.PrintWriter(buf); - port.println("E"); - LNjScheme.SchemeUtils.write(("" + e).toCharArray(), port, true); - return buf.toString(); - } -} - -/* LNjSchemeSend: send string for evaluation to Java app main thread. - * - * LNjSchemeResult: receive evaluation result from Java app main thread. - */ - -private java.util.concurrent.FutureTask LNjSchemeJob = null; - -public void LNjSchemeSend(String msg) { - final LNjScheme.InputPort in = new LNjScheme.InputPort(new java.io.ByteArrayInputStream(msg.getBytes(java.nio.charset.Charset.forName("UTF-8")))); - final Object expr = in.read(); - // Object result = LNjSchemeEvaluate(expr); - java.util.concurrent.FutureTask job = new java.util.concurrent.FutureTask - (new java.util.concurrent.Callable() { - @Override - public Object call() throws Exception { - // ln_log("invocation of " + this + " evaluating."); - if(in.isEOF(expr)) throw new Exception("invalid input"); - return LNjSchemeEvaluate(expr); } - }); - // ln_log("Sending to UI: " + job + " for: " + expr); - LNjSchemeJob = job; - new Thread() { - @Override - public void run() { - // ln_log("LNjScheme waiting for completion"); - try { - LNjSchemeJob.get(); - } catch (Exception e) { // InterruptedException java.util.concurrent.ExecutionException - // FIXME: Do something sensible here! - } - // ln_log("LNjScheme notifying result"); - nativeEvent(126,0,0); - } - }.start(); - runOnUiThread(job); -} - -public String LNjSchemeResult() { - try { - Object result = LNjSchemeJob != null ? LNjSchemeJob.get() : null; - LNjSchemeJob = null; - // ln_log("got result from UI"); - java.io.StringWriter buf = new java.io.StringWriter(); - java.io.PrintWriter port = new java.io.PrintWriter(buf); - port.println("D"); - LNjScheme.SchemeUtils.write(result, port, true); - return buf.toString(); - } catch (java.util.concurrent.ExecutionException e) { - // ln_log("got error from call"); - java.io.StringWriter buf = new java.io.StringWriter(); - java.io.PrintWriter port = new java.io.PrintWriter(buf); - port.println("E"); - LNjScheme.SchemeUtils.write(("" + e.getCause()).toCharArray(), port, true); - return buf.toString(); - } catch (Exception e) { - // ln_log("got exception from call"); - java.io.StringWriter buf = new java.io.StringWriter(); - java.io.PrintWriter port = new java.io.PrintWriter(buf); - port.println("E"); - LNjScheme.SchemeUtils.write(("LNjScheme unexpected exception: " + e).toCharArray(), port, true); - return buf.toString(); - } -} diff --git a/apps/DemoAndroidLNjScheme/LNjScheme/Closure.java b/apps/DemoAndroidLNjScheme/LNjScheme/Closure.java deleted file mode 100644 index eb99ffab..00000000 --- a/apps/DemoAndroidLNjScheme/LNjScheme/Closure.java +++ /dev/null @@ -1,28 +0,0 @@ -package LNjScheme; - -/** A closure is a user-defined procedure. It is "closed" over the - * environment in which it was created. To apply the procedure, bind - * the parameters to the passed in variables, and evaluate the body. - * @author Peter Norvig, peter@norvig.com http://www.norvig.com - * Copyright 1998 Peter Norvig, see http://www.norvig.com/license.html **/ - -public class Closure extends Procedure { - - Object parms; - Object body; - Environment env; - - /** Make a closure from a parameter list, body, and environment. **/ - public Closure (Object parms, Object body, Environment env) { - this.parms = parms; - this.env = env; - this.body = (body instanceof Pair && rest(body) == null) - ? first(body) - : cons("begin", body); - } - - /** Apply a closure to a list of arguments. **/ - public Object apply(Scheme interpreter, Object args) { - return interpreter.eval(body, new Environment(parms, args, env)); - } -} diff --git a/apps/DemoAndroidLNjScheme/LNjScheme/Continuation.java b/apps/DemoAndroidLNjScheme/LNjScheme/Continuation.java deleted file mode 100644 index 2705c557..00000000 --- a/apps/DemoAndroidLNjScheme/LNjScheme/Continuation.java +++ /dev/null @@ -1,17 +0,0 @@ -package LNjScheme; - -/** @author Peter Norvig, peter@norvig.com http://www.norvig.com - * Copyright 1998 Peter Norvig, see http://www.norvig.com/license.html */ - -public class Continuation extends Procedure { - - RuntimeException cc = null; - public Object value = null; - - public Continuation(RuntimeException cc) { this.cc = cc; } - - public Object apply(Scheme interpreter, Object args) { - value = first(args); - throw cc; - } -} diff --git a/apps/DemoAndroidLNjScheme/LNjScheme/Environment.java b/apps/DemoAndroidLNjScheme/LNjScheme/Environment.java deleted file mode 100644 index 4d78c227..00000000 --- a/apps/DemoAndroidLNjScheme/LNjScheme/Environment.java +++ /dev/null @@ -1,99 +0,0 @@ -package LNjScheme; - -/** Environments allow you to look up the value of a variable, given - * its name. Keep a list of variables and values, and a pointer to - * the parent environment. If a variable list ends in a symbol rather - * than null, it means that symbol is bound to the remainder of the - * values list. - * @author Peter Norvig, peter@norvig.com http://www.norvig.com - * Copyright 1998 Peter Norvig, see http://www.norvig.com/license.html */ - -public class Environment extends SchemeUtils { - public Object vars; - public Object vals; - public Environment parent; - - /** A constructor to extend an environment with var/val pairs. */ - public Environment(Object vars, Object vals, Environment parent) { - this.vars = vars; - this.vals = vals; - this.parent = parent; - if (!numberArgsOK(vars, vals)) - warn("wrong number of arguments: expected " + vars + - " got " + vals); - } - - /** Construct an empty environment: no bindings. **/ - public Environment() {} - - /** Find the value of a symbol, in this environment or a parent. */ - public Object lookup (String symbol) { - Object varList = vars, valList = vals; - // See if the symbol is bound locally - while (varList != null) { - if (first(varList) == symbol) { - return first(valList); - } else if (varList == symbol) { - return valList; - } else { - varList = rest(varList); - valList = rest(valList); - } - } - // If not, try to look for the parent - if (parent != null) return parent.lookup(symbol); - else return error("Unbound variable: " + symbol); - } - - /** Add a new variable,value pair to this environment. */ - public Object define(Object var, Object val) { - vars = cons(var, vars); - vals = cons(val, vals); - if (val instanceof Procedure - && ((Procedure)val).name.equals("anonymous procedure")) - ((Procedure)val).name = var.toString(); - return var; - } - - /** Set the value of an existing variable **/ - public Object set(Object var, Object val) { - if (!(var instanceof String)) - return error("Attempt to set a non-symbol: " - + stringify(var));; - String symbol = (String) var; - Object varList = vars, valList = vals; - // See if the symbol is bound locally - while (varList != null) { - if (first(varList) == symbol) { - return setFirst(valList, val); - } else if (rest(varList) == symbol) { - return setRest(valList, val); - } else { - varList = rest(varList); - valList = rest(valList); - } - } - // If not, try to look for the parent - if (parent != null) return parent.set(symbol, val); - else return error("Unbound variable: " + symbol); - } - - public Environment defPrim(String name, int id, int minArgs) { - define(name, new Primitive(id, minArgs, minArgs)); - return this; - } - - public Environment defPrim(String name, int id, int minArgs, int maxArgs) { - define(name, new Primitive(id, minArgs, maxArgs)); - return this; - } - - /** See if there is an appropriate number of vals for these vars. **/ - boolean numberArgsOK(Object vars, Object vals) { - return ((vars == null && vals == null) - || (vars instanceof String) - || (vars instanceof Pair && vals instanceof Pair - && numberArgsOK(((Pair)vars).rest, ((Pair)vals).rest))); - } - -} diff --git a/apps/DemoAndroidLNjScheme/LNjScheme/InputPort.java b/apps/DemoAndroidLNjScheme/LNjScheme/InputPort.java deleted file mode 100644 index 1b4c4a8d..00000000 --- a/apps/DemoAndroidLNjScheme/LNjScheme/InputPort.java +++ /dev/null @@ -1,210 +0,0 @@ -package LNjScheme; -import java.io.*; - -/** InputPort is to Scheme as InputStream is to Java. - * @author Peter Norvig, peter@norvig.com http://www.norvig.com - * Copyright 1998 Peter Norvig, see http://www.norvig.com/license.html **/ - -public class InputPort extends SchemeUtils { - - static String EOF = "#!EOF"; - boolean isPushedToken = false; - boolean isPushedChar = false; - Object pushedToken = null; - int pushedChar = -1; - Reader in; - StringBuffer buff = new StringBuffer(); - - /** Construct an InputPort from an InputStream. **/ - public InputPort(InputStream in) { this.in = new InputStreamReader(in);} - - /** Construct an InputPort from a Reader. **/ - public InputPort(Reader in) { this.in = in;} - - /** Read and return a Scheme character or EOF. **/ - public Object readChar() { - try { - if (isPushedChar) { - isPushedChar = false; - if (pushedChar == -1) return EOF; else return chr((char)pushedChar); - } else { - int ch = in.read(); - if (ch == -1) return EOF; else return chr((char)ch); - } - } catch (IOException e) { - warn("On input, exception: " + e); - return EOF; - } - } - - /** Peek at and return the next Scheme character (or EOF). - * However, don't consume the character. **/ - public Object peekChar() { - int p = peekCh(); - if (p == -1) return EOF; else return chr((char)p); - } - - /** Push a character back to be re-used later. **/ - int pushChar(int ch) { - isPushedChar = true; - return pushedChar = ch; - } - - /** Pop off the previously pushed character. **/ - int popChar() { - isPushedChar = false; - return pushedChar; - } - - /** Peek at and return the next Scheme character as an int, -1 for EOF. - * However, don't consume the character. **/ - public int peekCh() { - try { return isPushedChar ? pushedChar : pushChar(in.read()); } - catch (IOException e) { - warn("On input, exception: " + e); - return -1; - } - } - - /** Read and return a Scheme expression, or EOF. **/ - public Object read() { - try { - Object token = nextToken(); - if (token == "(") - return readTail(false); - else if (token == ")") - { warn("Extra ) ignored."); return read(); } - else if (token == ".") - { warn("Extra . ignored."); return read(); } - else if (token == "'") - return list("quote", read()); - else if (token == "`") - return list("quasiquote", read()); - else if (token == ",") - return list("unquote", read()); - else if (token == ",@") - return list("unquote-splicing", read()); - else - return token; - } catch (IOException e) { - warn("On input, exception: " + e); - return EOF; - } - } - - /** Close the port. Return TRUE if ok. **/ - public Object close() { - try { this.in.close(); return TRUE; } - catch (IOException e) { return error("IOException: " + e); } - } - - /** Is the argument the EOF object? **/ - public static boolean isEOF(Object x) { return x == EOF; } - - Object readTail(boolean dotOK) throws IOException { - Object token = nextToken(); - if (token == EOF) - return error("EOF during read."); - else if (token == ")") - return null; - else if (token == ".") { - Object result = read(); - token = nextToken(); - if (token != ")") warn("Where's the ')'? Got " + - token + " after ."); - return result; - } else { - isPushedToken = true; - pushedToken = token; - return cons(read(), readTail(true)); - } - } - - Object nextToken() throws IOException { - int ch; - - // See if we should re-use a pushed char or token - if (isPushedToken) { - isPushedToken = false; - return pushedToken; - } else if (isPushedChar) { - ch = popChar(); - } else { - ch = in.read(); - } - - // Skip whitespace - while (Character.isWhitespace((char)ch)) ch = in.read(); - - // See what kind of non-white character we got - switch(ch) { - case -1: return EOF; - case '(' : return "("; - case ')': return ")"; - case '\'': return "'"; - case '`': return "`"; - case ',': - ch = in.read(); - if (ch == '@') return ",@"; - else { pushChar(ch); return ","; } - case ';': - // Comment: skip to end of line and then read next token - while(ch != -1 && ch != '\n' && ch != '\r') ch = in.read(); - return nextToken(); - case '"': - // Strings are represented as char[] - buff.setLength(0); - while ((ch = in.read()) != '"' && ch != -1) { - buff.append((char) ((ch == '\\') ? in.read() : ch)); - } - if (ch == -1) warn("EOF inside of a string."); - return buff.toString().toCharArray(); - case '#': - switch (ch = in.read()) { - case 't': case 'T': return TRUE; - case 'f': case 'F': return FALSE; - case '(': - pushChar('('); - return listToVector(read()); - case '\\': - ch = in.read(); - if (ch == 's' || ch == 'S' || ch == 'n' || ch == 'N') { - pushChar(ch); - Object token = nextToken(); - if (token == "space") return chr(' '); - else if (token == "newline") return chr('\n'); - else { - isPushedToken = true; - pushedToken = token; - return chr((char)ch); - } - } else { - return chr((char)ch); - } - case 'e': case 'i': case 'd': return nextToken(); - case 'b': case 'o': case 'x': - warn("#" + ((char)ch) + " not implemented, ignored."); - return nextToken(); - default: - warn("#" + ((char)ch) + " not recognized, ignored."); - return nextToken(); - } - default: - buff.setLength(0); - int c = ch; - do { - buff.append((char)ch); - ch = in.read(); - } while (!Character.isWhitespace((char)ch) && ch != -1 && - ch != '(' && ch != ')' && ch != '\'' && ch != ';' - && ch != '"' && ch != ',' && ch != '`'); - pushChar(ch); - // Try potential numbers, but catch any format errors. - if (c == '.' || c == '+' || c == '-' || (c >= '0' && c <= '9')) { - try { return new Double(buff.toString()); } - catch (NumberFormatException e) { ; } - } - return buff.toString().toLowerCase().intern(); - } - } -} diff --git a/apps/DemoAndroidLNjScheme/LNjScheme/JavaMethod.java b/apps/DemoAndroidLNjScheme/LNjScheme/JavaMethod.java deleted file mode 100644 index e0644964..00000000 --- a/apps/DemoAndroidLNjScheme/LNjScheme/JavaMethod.java +++ /dev/null @@ -1,251 +0,0 @@ -package LNjScheme; -import java.lang.reflect.*; - -/** @author Peter Norvig, peter@norvig.com http://www.norvig.com - * Copyright 1998 Peter Norvig, see http://www.norvig.com/license.html */ - -public class JavaMethod extends Procedure { - - Class[] argClasses; - Method method; - boolean isStatic; - - public JavaMethod(String methodName, Object targetClassName, - Object argClassNames) { - this.name = targetClassName + "." + methodName; - try { - argClasses = classArray(argClassNames); - method = toClass(targetClassName).getMethod(methodName, argClasses); - isStatic = Modifier.isStatic(method.getModifiers()); - } catch (ClassNotFoundException e) { - error("Bad class, can't get method " + name); - } catch (NoSuchMethodException e) { - error("Can't get method " + name); - } - - } - - private Object raiseJavaMethodError(String msg, Throwable e, Object args) { - return error(msg + " " + e + " on " + this + stringify(args) + ";"); - } - - /** Apply the method to a list of arguments. **/ - public Object apply(Scheme interpreter, Object args) { - try { - if (isStatic) return method.invoke(null, toArray(args)); - else return method.invoke(first(args), toArray(rest(args))); - } - catch (IllegalAccessException e) - { raiseJavaMethodError("Bad Java Method application:", e, args); } - catch (IllegalArgumentException e) - { raiseJavaMethodError("Bad Java Method application:", e, args); } - catch (InvocationTargetException e) { - Throwable e1 = e.getCause(); - raiseJavaMethodError("Bad Java Method application: " + method, e1, args); - } catch (NullPointerException e) - { raiseJavaMethodError("Bad Java Method application:", e, args); } - catch (Exception e) - { raiseJavaMethodError("Bad Java Method application:", e, args); } - return null; /* unreached */ - } - - public static Class toClass(Object arg) throws ClassNotFoundException { - if (arg instanceof Class) return (Class)arg; - arg = stringify(arg, false); - - if (arg.equals("void")) return java.lang.Void.TYPE; - else if (arg.equals("boolean")) return java.lang.Boolean.TYPE; - else if (arg.equals("char")) return java.lang.Character.TYPE; - else if (arg.equals("byte")) return java.lang.Byte.TYPE; - else if (arg.equals("short")) return java.lang.Short.TYPE; - else if (arg.equals("int")) return java.lang.Integer.TYPE; - else if (arg.equals("long")) return java.lang.Long.TYPE; - else if (arg.equals("float")) return java.lang.Float.TYPE; - else if (arg.equals("double")) return java.lang.Double.TYPE; - else return Class.forName((String)arg); - } - - /** Convert a list of Objects into an array. Peek at the argClasses - * array to see what's expected. That enables us to convert between - * Double and Integer, something Java won't do automatically. **/ - public Object[] toArray(Object args) { - int n = length(args); - int diff = n - argClasses.length; - if (diff != 0) - error(Math.abs(diff) + " too " + ((diff>0) ? "many" : "few") - + " args to " + name); - Object[] array = new Object[n]; - for(int i = 0; i < n && i < argClasses.length; i++) { - if (argClasses[i] == java.lang.Integer.TYPE) - array[i] = new Integer((int)num(first(args))); - else - array[i] = first(args); - args = rest(args); - } - return array; - } - - /** Convert a list of class names into an array of Classes. **/ - public static Class[] classArray(Object args) throws ClassNotFoundException { - int n = length(args); - Class[] array = new Class[n]; - for(int i = 0; i < n; i++) { - array[i] = toClass(first(args)); - args = rest(args); - } - return array; - } - - /*** Backported ***/ - /*** The following functionality is inspired and pratially stolen - * from the community version, which extented the original - * jscheme. I'd rather strip down jscheme for use as embedded - * language (e.g., this use case does often not need quasiquote - * and macro expansion) than use and digest the bloat of a jscheme - * 7.2 or alike. - * - * However: I need constructors with arguments. ***/ - - /** Each bucket in an method table contains a Class[] of - parameterTypes and the corresponding method or constructor. **/ - private static final int BUCKET_SIZE = 2; - private static Class[] getParameterTypes(Object m) { - return (m instanceof Method) ? ((Method) m).getParameterTypes() : - ((Constructor) m).getParameterTypes(); - } - - /** Returns Object[] of parameterType, method pairs. **/ - private static Object[] methodArray(Object[] v) { - Object[] result = new Object[v.length*BUCKET_SIZE]; - for(int i = 0; i < v.length; i++) { - result[i*BUCKET_SIZE] = getParameterTypes(v[i]); - result[i*BUCKET_SIZE+1] = v[i]; - } - return result; - } - /* */ - private static Object findMethod(Object[] methods, Object[] args) { - int best = -1; - /* - System.err.println("Found " + (methods.length/2) + " constructors: " + methods); - System.err.println("Checking against " + args.length + " args, these:"); - for(int i=0; i", GT, 2, n) - .defPrim(">=", GE, 2, n) - .defPrim("abs", ABS, 1) - .defPrim("acos", ACOS, 1) - .defPrim("append", APPEND, 0, n) - .defPrim("apply", APPLY, 2, n) - .defPrim("asin", ASIN, 1) - .defPrim("assoc", ASSOC, 2) - .defPrim("assq", ASSQ, 2) - .defPrim("assv", ASSV, 2) - .defPrim("atan", ATAN, 1) - .defPrim("boolean?", BOOLEANQ, 1) - .defPrim("caaaar", CXR, 1) - .defPrim("caaadr", CXR, 1) - .defPrim("caaar", CXR, 1) - .defPrim("caadar", CXR, 1) - .defPrim("caaddr", CXR, 1) - .defPrim("caadr", CXR, 1) - .defPrim("caar", CXR, 1) - .defPrim("cadaar", CXR, 1) - .defPrim("cadadr", CXR, 1) - .defPrim("cadar", CXR, 1) - .defPrim("caddar", CXR, 1) - .defPrim("cadddr", CXR, 1) - .defPrim("caddr", THIRD, 1) - .defPrim("cadr", SECOND, 1) - .defPrim("call-with-current-continuation", CALLCC, 1) - .defPrim("call-with-input-file", CALLWITHINPUTFILE, 2) - .defPrim("call-with-output-file", CALLWITHOUTPUTFILE, 2) - .defPrim("car", CAR, 1) - .defPrim("cdaaar", CXR, 1) - .defPrim("cdaadr", CXR, 1) - .defPrim("cdaar", CXR, 1) - .defPrim("cdadar", CXR, 1) - .defPrim("cdaddr", CXR, 1) - .defPrim("cdadr", CXR, 1) - .defPrim("cdar", CXR, 1) - .defPrim("cddaar", CXR, 1) - .defPrim("cddadr", CXR, 1) - .defPrim("cddar", CXR, 1) - .defPrim("cdddar", CXR, 1) - .defPrim("cddddr", CXR, 1) - .defPrim("cdddr", CXR, 1) - .defPrim("cddr", CXR, 1) - .defPrim("cdr", CDR, 1) - .defPrim("char->integer", CHARTOINTEGER, 1) - .defPrim("char-alphabetic?",CHARALPHABETICQ, 1) - .defPrim("char-ci<=?", CHARCICMP+LE, 2) - .defPrim("char-ci=?", CHARCICMP+GE, 2) - .defPrim("char-ci>?" , CHARCICMP+GT, 2) - .defPrim("char-downcase", CHARDOWNCASE, 1) - .defPrim("char-lower-case?",CHARLOWERCASEQ, 1) - .defPrim("char-numeric?", CHARNUMERICQ, 1) - .defPrim("char-upcase", CHARUPCASE, 1) - .defPrim("char-upper-case?",CHARUPPERCASEQ, 1) - .defPrim("char-whitespace?",CHARWHITESPACEQ, 1) - .defPrim("char<=?", CHARCMP+LE, 2) - .defPrim("char=?", CHARCMP+GE, 2) - .defPrim("char>?", CHARCMP+GT, 2) - .defPrim("char?", CHARQ, 1) - .defPrim("close-input-port", CLOSEINPUTPORT, 1) - .defPrim("close-output-port", CLOSEOUTPUTPORT, 1) - .defPrim("complex?", NUMBERQ, 1) - .defPrim("cons", CONS, 2) - .defPrim("cos", COS, 1) - .defPrim("current-input-port", CURRENTINPUTPORT, 0) - .defPrim("current-output-port", CURRENTOUTPUTPORT, 0) - .defPrim("display", DISPLAY, 1, 2) - .defPrim("eof-object?", EOFOBJECTQ, 1) - .defPrim("eq?", EQQ, 2) - .defPrim("equal?", EQUALQ, 2) - .defPrim("eqv?", EQVQ, 2) - .defPrim("eval", EVAL, 1, 2) - .defPrim("even?", EVENQ, 1) - .defPrim("exact?", INTEGERQ, 1) - .defPrim("exp", EXP, 1) - .defPrim("expt", EXPT, 2) - .defPrim("force", FORCE, 1) - .defPrim("for-each", FOREACH, 1, n) - .defPrim("gcd", GCD, 0, n) - .defPrim("inexact?", INEXACTQ, 1) - .defPrim("input-port?", INPUTPORTQ, 1) - .defPrim("integer->char", INTEGERTOCHAR, 1) - .defPrim("integer?", INTEGERQ, 1) - .defPrim("lcm", LCM, 0, n) - .defPrim("length", LENGTH, 1) - .defPrim("list", LIST, 0, n) - .defPrim("list->string", LISTTOSTRING, 1) - .defPrim("list->vector", LISTTOVECTOR, 1) - .defPrim("list-ref", LISTREF, 2) - .defPrim("list-tail", LISTTAIL, 2) - .defPrim("list?", LISTQ, 1) - .defPrim("load", LOAD, 1) - .defPrim("log", LOG, 1) - .defPrim("macro-expand", MACROEXPAND,1) - .defPrim("make-string", MAKESTRING,1, 2) - .defPrim("make-vector", MAKEVECTOR,1, 2) - .defPrim("map", MAP, 1, n) - .defPrim("max", MAX, 1, n) - .defPrim("member", MEMBER, 2) - .defPrim("memq", MEMQ, 2) - .defPrim("memv", MEMV, 2) - .defPrim("min", MIN, 1, n) - .defPrim("modulo", MODULO, 2) - .defPrim("negative?", NEGATIVEQ, 1) - .defPrim("newline", NEWLINE, 0, 1) - .defPrim("not", NOT, 1) - .defPrim("null?", NULLQ, 1) - .defPrim("number->string", NUMBERTOSTRING, 1, 2) - .defPrim("number?", NUMBERQ, 1) - .defPrim("odd?", ODDQ, 1) - .defPrim("open-input-file",OPENINPUTFILE, 1) - .defPrim("open-output-file", OPENOUTPUTFILE, 1) - .defPrim("output-port?", OUTPUTPORTQ, 1) - .defPrim("pair?", PAIRQ, 1) - .defPrim("peek-char", PEEKCHAR, 0, 1) - .defPrim("positive?", POSITIVEQ, 1) - .defPrim("procedure?", PROCEDUREQ,1) - .defPrim("quotient", QUOTIENT, 2) - .defPrim("rational?", INTEGERQ, 1) - .defPrim("read", READ, 0, 1) - .defPrim("read-char", READCHAR, 0, 1) - .defPrim("real?", NUMBERQ, 1) - .defPrim("remainder", REMAINDER, 2) - .defPrim("reverse", REVERSE, 1) - .defPrim("round", ROUND, 1) - .defPrim("set-car!", SETCAR, 2) - .defPrim("set-cdr!", SETCDR, 2) - .defPrim("sin", SIN, 1) - .defPrim("sqrt", SQRT, 1) - .defPrim("string", STRING, 0, n) - .defPrim("string->list", STRINGTOLIST, 1) - .defPrim("string->number", STRINGTONUMBER, 1, 2) - .defPrim("string->symbol", STRINGTOSYMBOL, 1) - .defPrim("string-append", STRINGAPPEND, 0, n) - .defPrim("string-ci<=?", STRINGCICMP+LE, 2) - .defPrim("string-ci=?", STRINGCICMP+GE, 2) - .defPrim("string-ci>?" , STRINGCICMP+GT, 2) - .defPrim("string-length", STRINGLENGTH, 1) - .defPrim("string-ref", STRINGREF, 2) - .defPrim("string-set!", STRINGSET, 3) - .defPrim("string<=?", STRINGCMP+LE, 2) - .defPrim("string=?", STRINGCMP+GE, 2) - .defPrim("string>?", STRINGCMP+GT, 2) - .defPrim("string?", STRINGQ, 1) - .defPrim("substring", SUBSTRING, 3) - .defPrim("symbol->string", SYMBOLTOSTRING, 1) - .defPrim("symbol?", SYMBOLQ, 1) - .defPrim("tan", TAN, 1) - .defPrim("vector", VECTOR, 0, n) - .defPrim("vector->list", VECTORTOLIST, 1) - .defPrim("vector-length", VECTORLENGTH, 1) - .defPrim("vector-ref", VECTORREF, 2) - .defPrim("vector-set!", VECTORSET, 3) - .defPrim("vector?", VECTORQ, 1) - .defPrim("write", WRITE, 1, 2) - .defPrim("write-char", DISPLAY, 1, 2) - .defPrim("zero?", ZEROQ, 1) - - ///////////// Extensions //////////////// - - .defPrim("new", NEW, 1, n) - .defPrim("class", CLASS, 1) - .defPrim("method", METHOD, 2, n) - .defPrim("exit", EXIT, 0, 1) - .defPrim("error", ERROR, 0, n) - .defPrim("time-call", TIMECALL, 1, 2) - .defPrim("_list*", LISTSTAR, 0, n) - ; - - return env; - } - - /** Apply a primitive to a list of arguments. **/ - public Object apply(Scheme interp, Object args) { - //First make sure there are the right number of arguments. - int nArgs = length(args); - if (nArgs < minArgs) - return error("too few args, " + nArgs + - ", for " + this.name + ": " + args); - else if (nArgs > maxArgs) - return error("too many args, " + nArgs + - ", for " + this.name + ": " + args); - - Object x = first(args); - Object y = second(args); - - switch (idNumber) { - - //////////////// SECTION 6.1 BOOLEANS - case NOT: return truth(x == FALSE); - case BOOLEANQ: return truth(x == TRUE || x == FALSE); - - //////////////// SECTION 6.2 EQUIVALENCE PREDICATES - case EQVQ: return truth(eqv(x, y)); - case EQQ: return truth(x == y); - case EQUALQ: return truth(equal(x,y)); - - //////////////// SECTION 6.3 LISTS AND PAIRS - case PAIRQ: return truth(x instanceof Pair); - case LISTQ: return truth(isList(x)); - case CXR: for (int i = name.length()-2; i >= 1; i--) - x = (name.charAt(i) == 'a') ? first(x) : rest(x); - return x; - case CONS: return cons(x, y); - case CAR: return first(x); - case CDR: return rest(x); - case SETCAR: return setFirst(x, y); - case SETCDR: return setRest(x, y); - case SECOND: return second(x); - case THIRD: return third(x); - case NULLQ: return truth(x == null); - case LIST: return args; - case LENGTH: return num(length(x)); - case APPEND: return (args == null) ? null : append(args); - case REVERSE: return reverse(x); - case LISTTAIL: for (int k = (int)num(y); k>0; k--) x = rest(x); - return x; - case LISTREF: for (int k = (int)num(y); k>0; k--) x = rest(x); - return first(x); - case MEMQ: return memberAssoc(x, y, 'm', 'q'); - case MEMV: return memberAssoc(x, y, 'm', 'v'); - case MEMBER: return memberAssoc(x, y, 'm', ' '); - case ASSQ: return memberAssoc(x, y, 'a', 'q'); - case ASSV: return memberAssoc(x, y, 'a', 'v'); - case ASSOC: return memberAssoc(x, y, 'a', ' '); - - //////////////// SECTION 6.4 SYMBOLS - case SYMBOLQ: return truth(x instanceof String); - case SYMBOLTOSTRING:return sym(x).toCharArray(); - case STRINGTOSYMBOL:return new String(str(x)).intern(); - - //////////////// SECTION 6.5 NUMBERS - case NUMBERQ: return truth(x instanceof Number); - case ODDQ: return truth(Math.abs(num(x)) % 2 != 0); - case EVENQ: return truth(Math.abs(num(x)) % 2 == 0); - case ZEROQ: return truth(num(x) == 0); - case POSITIVEQ: return truth(num(x) > 0); - case NEGATIVEQ: return truth(num(x) < 0); - case INTEGERQ: return truth(isExact(x)); - case INEXACTQ: return truth(!isExact(x)); - case LT: return numCompare(args, '<'); - case GT: return numCompare(args, '>'); - case EQ: return numCompare(args, '='); - case LE: return numCompare(args, 'L'); - case GE: return numCompare(args, 'G'); - case MAX: return numCompute(args, 'X', num(x)); - case MIN: return numCompute(args, 'N', num(x)); - case PLUS: return numCompute(args, '+', 0.0); - case MINUS: return numCompute(rest(args), '-', num(x)); - case TIMES: return numCompute(args, '*', 1.0); - case DIVIDE: return numCompute(rest(args), '/', num(x)); - case QUOTIENT: double d = num(x)/num(y); - return num(d > 0 ? Math.floor(d) : Math.ceil(d)); - case REMAINDER: return num((long)num(x) % (long)num(y)); - case MODULO: long xi = (long)num(x), yi = (long)num(y), m = xi % yi; - return num((xi*yi > 0 || m == 0) ? m : m + yi); - case ABS: return num(Math.abs(num(x))); - case FLOOR: return num(Math.floor(num(x))); - case CEILING: return num(Math.ceil(num(x))); - case TRUNCATE: d = num(x); - return num((d < 0.0) ? Math.ceil(d) : Math.floor(d)); - case ROUND: return num(Math.round(num(x))); - case EXP: return num(Math.exp(num(x))); - case LOG: return num(Math.log(num(x))); - case SIN: return num(Math.sin(num(x))); - case COS: return num(Math.cos(num(x))); - case TAN: return num(Math.tan(num(x))); - case ASIN: return num(Math.asin(num(x))); - case ACOS: return num(Math.acos(num(x))); - case ATAN: return num(Math.atan(num(x))); - case SQRT: return num(Math.sqrt(num(x))); - case EXPT: return num(Math.pow(num(x), num(y))); - case NUMBERTOSTRING:return numberToString(x, y); - case STRINGTONUMBER:return stringToNumber(x, y); - case GCD: return (args == null) ? ZERO : gcd(args); - case LCM: return (args == null) ? ONE : lcm(args); - - //////////////// SECTION 6.6 CHARACTERS - case CHARQ: return truth(x instanceof Character); - case CHARALPHABETICQ: return truth(Character.isLetter(chr(x))); - case CHARNUMERICQ: return truth(Character.isDigit(chr(x))); - case CHARWHITESPACEQ: return truth(Character.isWhitespace(chr(x))); - case CHARUPPERCASEQ: return truth(Character.isUpperCase(chr(x))); - case CHARLOWERCASEQ: return truth(Character.isLowerCase(chr(x))); - case CHARTOINTEGER: return new Double((double)chr(x)); - case INTEGERTOCHAR: return chr((char)(int)num(x)); - case CHARUPCASE: return chr(Character.toUpperCase(chr(x))); - case CHARDOWNCASE: return chr(Character.toLowerCase(chr(x))); - case CHARCMP+EQ: return truth(charCompare(x, y, false) == 0); - case CHARCMP+LT: return truth(charCompare(x, y, false) < 0); - case CHARCMP+GT: return truth(charCompare(x, y, false) > 0); - case CHARCMP+GE: return truth(charCompare(x, y, false) >= 0); - case CHARCMP+LE: return truth(charCompare(x, y, false) <= 0); - case CHARCICMP+EQ: return truth(charCompare(x, y, true) == 0); - case CHARCICMP+LT: return truth(charCompare(x, y, true) < 0); - case CHARCICMP+GT: return truth(charCompare(x, y, true) > 0); - case CHARCICMP+GE: return truth(charCompare(x, y, true) >= 0); - case CHARCICMP+LE: return truth(charCompare(x, y, true) <= 0); - - case ERROR: return error(stringify(args)); - - //////////////// SECTION 6.7 STRINGS - case STRINGQ: return truth(x instanceof char[]); - case MAKESTRING:char[] str = new char[(int)num(x)]; - if (y != null) { - char c = chr(y); - for (int i = str.length-1; i >= 0; i--) str[i] = c; - } - return str; - case STRING: return listToString(args); - case STRINGLENGTH: return num(str(x).length); - case STRINGREF: return chr(str(x)[(int)num(y)]); - case STRINGSET: Object z = third(args); str(x)[(int)num(y)] = chr(z); - return z; - case SUBSTRING: int start = (int)num(y), end = (int)num(third(args)); - return new String(str(x), start, end-start).toCharArray(); - case STRINGAPPEND: return stringAppend(args); - case STRINGTOLIST: Pair result = null; - char[] str2 = str(x); - for (int i = str2.length-1; i >= 0; i--) - result = cons(chr(str2[i]), result); - return result; - case LISTTOSTRING: return listToString(x); - case STRINGCMP+EQ: return truth(stringCompare(x, y, false) == 0); - case STRINGCMP+LT: return truth(stringCompare(x, y, false) < 0); - case STRINGCMP+GT: return truth(stringCompare(x, y, false) > 0); - case STRINGCMP+GE: return truth(stringCompare(x, y, false) >= 0); - case STRINGCMP+LE: return truth(stringCompare(x, y, false) <= 0); - case STRINGCICMP+EQ:return truth(stringCompare(x, y, true) == 0); - case STRINGCICMP+LT:return truth(stringCompare(x, y, true) < 0); - case STRINGCICMP+GT:return truth(stringCompare(x, y, true) > 0); - case STRINGCICMP+GE:return truth(stringCompare(x, y, true) >= 0); - case STRINGCICMP+LE:return truth(stringCompare(x, y, true) <= 0); - - //////////////// SECTION 6.8 VECTORS - case VECTORQ: return truth(x instanceof Object[]); - case MAKEVECTOR: Object[] vec = new Object[(int)num(x)]; - if (y != null) { - for (int i = 0; i < vec.length; i++) vec[i] = y; - } - return vec; - case VECTOR: return listToVector(args); - case VECTORLENGTH: return num(vec(x).length); - case VECTORREF: return vec(x)[(int)num(y)]; - case VECTORSET: return vec(x)[(int)num(y)] = third(args); - case VECTORTOLIST: return vectorToList(x); - case LISTTOVECTOR: return listToVector(x); - - //////////////// SECTION 6.9 CONTROL FEATURES - case EVAL: return interp.eval(x); - case FORCE: return (!(x instanceof Procedure)) ? x - : proc(x).apply(interp, null); - case MACROEXPAND: return Macro.macroExpand(interp, x); - case PROCEDUREQ: return truth(x instanceof Procedure); - case APPLY: return proc(x).apply(interp, listStar(rest(args))); - case MAP: return map(proc(x), rest(args), interp, list(null)); - case FOREACH: return map(proc(x), rest(args), interp, null); - case CALLCC: RuntimeException cc = new RuntimeException(); - Continuation proc = new Continuation(cc); - try { return proc(x).apply(interp, list(proc)); } - catch (RuntimeException e) { - if (e == cc) return proc.value; else throw e; - } - - //////////////// SECTION 6.10 INPUT AND OUPUT - case EOFOBJECTQ: return truth(x == InputPort.EOF); - case INPUTPORTQ: return truth(x instanceof InputPort); - case CURRENTINPUTPORT: return interp.input; - case OPENINPUTFILE: return openInputFile(x); - case CLOSEINPUTPORT: return inPort(x, interp).close(); - case OUTPUTPORTQ: return truth(x instanceof PrintWriter); - case CURRENTOUTPUTPORT: return interp.output; - case OPENOUTPUTFILE: return openOutputFile(x); - case CALLWITHOUTPUTFILE: PrintWriter p = null; - try { p = openOutputFile(x); - z = proc(y).apply(interp, list(p)); - } finally { if (p != null) p.close(); } - return z; - case CALLWITHINPUTFILE: InputPort p2 = null; - try { p2 = openInputFile(x); - z = proc(y).apply(interp, list(p2)); - } finally { if (p2 != null) p2.close(); } - return z; - case CLOSEOUTPUTPORT: outPort(x, interp).close(); return TRUE; - case READCHAR: return inPort(x, interp).readChar(); - case PEEKCHAR: return inPort(x, interp).peekChar(); - case LOAD: return interp.load(x); - case READ: return inPort(x, interp).read(); - case EOF_OBJECT: return truth(InputPort.isEOF(x)); - case WRITE: return write(x, outPort(y, interp), true); - case DISPLAY: return write(x, outPort(y, interp), false); - case NEWLINE: outPort(x, interp).println(); - outPort(x, interp).flush(); return TRUE; - - //////////////// EXTENSIONS - case CLASS: try { return Class.forName(stringify(x, false)); } - catch (ClassNotFoundException e) { return FALSE; } - case NEW: return JavaMethod.invokeConstructor(x, rest(args)); - case METHOD: return new JavaMethod(stringify(x, false), y, - rest(rest(args))); - case EXIT: System.exit((x == null) ? 0 : (int)num(x)); - case LISTSTAR: return listStar(args); - case TIMECALL: Runtime runtime = Runtime.getRuntime(); - runtime.gc(); - long startTime = System.currentTimeMillis(); - long startMem = runtime.freeMemory(); - Object ans = FALSE; - int nTimes = (y == null ? 1 : (int)num(y)); - for (int i = 0; i < nTimes; i++) { - ans = proc(x).apply(interp, null); - } - long time = System.currentTimeMillis() - startTime; - long mem = startMem - runtime.freeMemory(); - return cons(ans, list(list(num(time), "msec"), - list(num(mem), "bytes"))); - default: return error("internal error: unknown primitive: " - + this + " applied to " + args); - } - } - - public static char[] stringAppend(Object args) { - StringBuffer result = new StringBuffer(); - for(; args instanceof Pair; args = rest(args)) { - result.append(stringify(first(args), false)); - } - return result.toString().toCharArray(); - } - - public static Object memberAssoc(Object obj, Object list, char m, char eq) { - while (list instanceof Pair) { - Object target = (m == 'm') ? first(list) : first(first(list)); - boolean found; - switch (eq) { - case 'q': found = (target == obj); break; - case 'v': found = eqv(target, obj); break; - case ' ': found = equal(target, obj); break; - default: warn("Bad option to memberAssoc:" + eq); return FALSE; - } - if (found) return (m == 'm') ? list : first(list); - list = rest(list); - } - return FALSE; - } - - public static Object numCompare(Object args, char op) { - while (rest(args) instanceof Pair) { - double x = num(first(args)); args = rest(args); - double y = num(first(args)); - switch (op) { - case '>': if (!(x > y)) return FALSE; break; - case '<': if (!(x < y)) return FALSE; break; - case '=': if (!(x == y)) return FALSE; break; - case 'L': if (!(x <= y)) return FALSE; break; - case 'G': if (!(x >= y)) return FALSE; break; - default: error("internal error: unrecognized op: " + op); break; - } - } - return TRUE; - } - - public static Object numCompute(Object args, char op, double result) { - if (args == null) { - switch (op) { - case '-': return num(0 - result); - case '/': return num(1 / result); - default: return num(result); - } - } else { - while (args instanceof Pair) { - double x = num(first(args)); args = rest(args); - switch (op) { - case 'X': if (x > result) result = x; break; - case 'N': if (x < result) result = x; break; - case '+': result += x; break; - case '-': result -= x; break; - case '*': result *= x; break; - case '/': result /= x; break; - default: error("internal error: unrecognized op: " + op); break; - } - } - return num(result); - } - } - - /** Return the sign of the argument: +1, -1, or 0. **/ - static int sign(int x) { return (x > 0) ? +1 : (x < 0) ? -1 : 0; } - - /** Return <0 if x is alphabetically first, >0 if y is first, - * 0 if same. Case insensitive iff ci is true. Error if not both chars. **/ - public static int charCompare(Object x, Object y, boolean ci) { - char xc = chr(x), yc = chr(y); - if (ci) { xc = Character.toLowerCase(xc); yc = Character.toLowerCase(yc); } - return xc - yc; - } - - /** Return <0 if x is alphabetically first, >0 if y is first, - * 0 if same. Case insensitive iff ci is true. Error if not strings. **/ - public static int stringCompare(Object x, Object y, boolean ci) { - if (x instanceof char[] && y instanceof char[]) { - char[] xc = (char[])x, yc = (char[])y; - for (int i = 0; i < xc.length; i++) { - int diff = (!ci) ? xc[i] - yc[i] - : Character.toUpperCase(xc[i]) - Character.toUpperCase(yc[i]); - if (diff != 0) return diff; - } - return xc.length - yc.length; - } else { - error("expected two strings, got: " + stringify(list(x, y))); - return 0; - } - } - - static Object numberToString(Object x, Object y) { - int base = (y instanceof Number) ? (int)num(y) : 10; - if (base != 10 || num(x) == Math.round(num(x))) { - // An integer - return Long.toString((long)num(x), base).toCharArray(); - } else { - // A floating point number - return x.toString().toCharArray(); - } - } - - static Object stringToNumber(Object x, Object y) { - int base = (y instanceof Number) ? (int)num(y) : 10; - try { - return (base == 10) - ? Double.valueOf(stringify(x, false)) - : num(Long.parseLong(stringify(x, false), base)); - } catch (NumberFormatException e) { return FALSE; } - } - - static Object gcd(Object args) { - long gcd = 0; - while (args instanceof Pair) { - gcd = gcd2(Math.abs((long)num(first(args))), gcd); - args = rest(args); - } - return num(gcd); - } - - static long gcd2(long a, long b) { - if (b == 0) return a; - else return gcd2(b, a % b); - } - - static Object lcm(Object args) { - long L = 1, g = 1; - while (args instanceof Pair) { - long n = Math.abs((long)num(first(args))); - g = gcd2(n, L); - L = (g == 0) ? g : (n / g) * L; - args = rest(args); - } - return num(L); - } - - static boolean isExact(Object x) { - if (!(x instanceof Double)) return false; - double d = num(x); - return (d == Math.round(d) && Math.abs(d) < 102962884861573423.0); - } - - static PrintWriter openOutputFile(Object filename) { - try { - return new PrintWriter(new FileWriter(stringify(filename, false))); - } catch (FileNotFoundException e) { - return (PrintWriter)error("No such file: " + stringify(filename)); - } catch (IOException e) { - return (PrintWriter)error("IOException: " + e); - } - } - - static InputPort openInputFile(Object filename) { - try { - return new InputPort(new FileInputStream(stringify(filename, false))); - } catch (FileNotFoundException e) { - return (InputPort)error("No such file: " + stringify(filename)); - } catch (IOException e) { - return (InputPort)error("IOException: " + e); - } - } - - static boolean isList(Object x) { - Object slow = x, fast = x; - for(;;) { - if (fast == null) return true; - if (slow == rest(fast) || !(fast instanceof Pair) - || !(slow instanceof Pair)) return false; - slow = rest(slow); - fast = rest(fast); - if (fast == null) return true; - if (!(fast instanceof Pair)) return false; - fast = rest(fast); - } - } - - static Object append(Object args) { - if (rest(args) == null) return first(args); - else return append2(first(args), append(rest(args))); - } - - static Object append2(Object x, Object y) { - if (x instanceof Pair) return cons(first(x), append2(rest(x), y)); - else return y; - } - - /** Map proc over a list of lists of args, in the given interpreter. - * If result is non-null, accumulate the results of each call there - * and return that at the end. Otherwise, just return null. **/ - static Pair map(Procedure proc, Object args, Scheme interp, Pair result) { - Pair accum = result; - if (rest(args) == null) { - args = first(args); - while (args instanceof Pair) { - Object x = proc.apply(interp, list(first(args))); - if (accum != null) accum = (Pair) (accum.rest = list(x)); - args = rest(args); - } - } else { - Procedure car = proc(interp.eval("car")), cdr = proc(interp.eval("cdr")); - while (first(args) instanceof Pair) { - Object x = proc.apply(interp, map(car, list(args), interp, list(null))); - if (accum != null) accum = (Pair) (accum.rest = list(x)); - args = map(cdr, list(args), interp, list(null)); - } - } - return (Pair)rest(result); - } - -} diff --git a/apps/DemoAndroidLNjScheme/LNjScheme/Procedure.java b/apps/DemoAndroidLNjScheme/LNjScheme/Procedure.java deleted file mode 100644 index 8a21ecbf..00000000 --- a/apps/DemoAndroidLNjScheme/LNjScheme/Procedure.java +++ /dev/null @@ -1,20 +0,0 @@ -package LNjScheme; - -/** @author Peter Norvig, peter@norvig.com http://www.norvig.com - * Copyright 1998 Peter Norvig, see http://www.norvig.com/license.html **/ - -public abstract class Procedure extends SchemeUtils { - - String name = "anonymous procedure"; - - public String toString() { return "{" + name + "}"; } - - public abstract Object apply(Scheme interpreter, Object args); - - /** Coerces a Scheme object to a procedure. **/ - static Procedure proc(Object x) { - if (x instanceof Procedure) return (Procedure) x; - else return proc(error("Not a procedure: " + stringify(x))); - } - -} diff --git a/apps/DemoAndroidLNjScheme/LNjScheme/Scheme.java b/apps/DemoAndroidLNjScheme/LNjScheme/Scheme.java deleted file mode 100644 index 718971c7..00000000 --- a/apps/DemoAndroidLNjScheme/LNjScheme/Scheme.java +++ /dev/null @@ -1,150 +0,0 @@ -package LNjScheme; -import java.io.*; - -/** This class represents a Scheme interpreter. - * See http://www.norvig.com/jscheme.html for more documentation. - * This is version 1.4. - * @author Peter Norvig, peter@norvig.com http://www.norvig.com - * Copyright 1998 Peter Norvig, see http://www.norvig.com/license.html **/ - -public class Scheme extends SchemeUtils { - - InputPort input = new InputPort(System.in); - PrintWriter output = new PrintWriter(System.out, true); - Environment globalEnvironment = new Environment(); - - /** Create a Scheme interpreter and load an array of files into it. - * Also load SchemePrimitives.CODE. **/ - public Scheme(String[] files) { - Primitive.installPrimitives(globalEnvironment); - try { - load(new InputPort(new StringReader(SchemePrimitives.CODE))); - for (int i = 0; i < (files == null ? 0 : files.length); i++) { - load(files[i]); - } - } catch (RuntimeException e) { ; } - } - - //////////////// Main Loop - - /** Create a new Scheme interpreter, passing in the command line args - * as files to load, and then enter a read eval write loop. **/ - public static void main(String[] files) { - new Scheme(files).readEvalWriteLoop(); - } - - /** Prompt, read, eval, and write the result. - * Also sets up a catch for any RuntimeExceptions encountered. **/ - public void readEvalWriteLoop() { - Object x; - for(;;) { - try { - output.print("> "); output.flush(); - if (input.isEOF(x = input.read())) return; - write(eval(x), output, true); - output.println(); output.flush(); - } catch (RuntimeException e) { ; } - } - } - - /** Eval all the expressions in a file. Calls load(InputPort). **/ - public Object load(Object fileName) { - String name = stringify(fileName, false); - try { return load(new InputPort(new FileInputStream(name))); } - catch (IOException e) { return error("can't load " + name); } - } - - /** Eval all the expressions coming from an InputPort. **/ - public Object load(InputPort in) { - Object x = null; - for(;;) { - if (in.isEOF(x = in.read())) return TRUE; - eval(x); - } - } - - //////////////// Evaluation - - /** Evaluate an object, x, in an environment. **/ - public Object eval(Object x, Environment env) { - // The purpose of the while loop is to allow tail recursion. - // The idea is that in a tail recursive position, we do "x = ..." - // and loop, rather than doing "return eval(...)". - while (true) { - if (x instanceof String) { // VARIABLE - return env.lookup((String)x); - } else if (!(x instanceof Pair)) { // CONSTANT - return x; - } else { - Object fn = first(x); - Object args = rest(x); - if (fn == "quote") { // QUOTE - return first(args); - } else if (fn == "begin") { // BEGIN - for (; rest(args) != null; args = rest(args)) { - eval(first(args), env); - } - x = first(args); - } else if (fn == "define") { // DEFINE - if (first(args) instanceof Pair) - return env.define(first(first(args)), - eval(cons("lambda", cons(rest(first(args)), rest(args))), env)); - else return env.define(first(args), eval(second(args), env)); - } else if (fn == "set!") { // SET! - return env.set(first(args), eval(second(args), env)); - } else if (fn == "if") { // IF - x = (truth(eval(first(args), env))) ? second(args) : third(args); - } else if (fn == "cond") { // COND - x = reduceCond(args, env); - } else if (fn == "lambda") { // LAMBDA - return new Closure(first(args), rest(args), env); - } else if (fn == "macro") { // MACRO - return new Macro(first(args), rest(args), env); - } else { // PROCEDURE CALL: - fn = eval(fn, env); - if (fn instanceof Macro) { // (MACRO CALL) - x = ((Macro)fn).expand(this, (Pair)x, args); - } else if (fn instanceof Closure) { // (CLOSURE CALL) - Closure f = (Closure)fn; - x = f.body; - env = new Environment(f.parms, evalList(args, env), f.env); - } else { // (OTHER PROCEDURE CALL) - return Procedure.proc(fn).apply(this, evalList(args, env)); - } - } - } - } - } - - /** Eval in the global environment. **/ - public Object eval(Object x) { return eval(x, this.globalEnvironment); } - - /** Evaluate each of a list of expressions. **/ - Pair evalList(Object list, Environment env) { - if (list == null) - return null; - else if (!(list instanceof Pair)) { - error("Illegal arg list: " + list); - return null; - } else - return cons(eval(first(list), env), evalList(rest(list), env)); - } - - /** Reduce a cond expression to some code which, when evaluated, - * gives the value of the cond expression. We do it that way to - * maintain tail recursion. **/ - Object reduceCond(Object clauses, Environment env) { - Object result = null; - for (;;) { - if (clauses == null) return FALSE; - Object clause = first(clauses); clauses = rest(clauses); - if (first(clause) == "else" - || truth(result = eval(first(clause), env))) - if (rest(clause) == null) return list("quote", result); - else if (second(clause) == "=>") - return list(third(clause), list("quote", result)); - else return cons("begin", rest(clause)); - } - } - -} diff --git a/apps/DemoAndroidLNjScheme/LNjScheme/SchemePrimitives.java b/apps/DemoAndroidLNjScheme/LNjScheme/SchemePrimitives.java deleted file mode 100644 index 4c2889a0..00000000 --- a/apps/DemoAndroidLNjScheme/LNjScheme/SchemePrimitives.java +++ /dev/null @@ -1,158 +0,0 @@ -package LNjScheme; - -/** Holds a string representation of some Scheme code in CODE. - * A string is better than a file because with no files, its easier to - * compress everything in the classes.jar file. For editing convenience, - * the following two perl convert from normal text to this Java quoted - * format and back again: - * 
- * perl -pe 's/"/\\"/g; s/(\s*)(.*?)(\s*)$/\1"\2\\n" +\n/'
- * perl -pe 's/\\"/"/g; s/^(\s*)"/\1/; s/\\n" [+]//'
- *
- * @author Peter Norvig, peter@norvig.com http://www.norvig.com - * Copyright 1998 Peter Norvig, see http://www.norvig.com/license.html **/ -public class SchemePrimitives { - - public static final String CODE = -"(define call/cc call-with-current-continuation)\n" + -"(define first car)\n" + -"(define second cadr)\n" + -"(define third caddr)\n" + -"(define rest cdr)\n" + -"(define set-first! set-car!)\n" + -"(define set-rest! set-cdr!)\n" + - -//;;;;;;;;;;;;;;;; Standard Scheme Macros - -"(define or\n" + - "(macro args\n" + - "(if (null? args)\n" + - "#f\n" + - "(cons 'cond (map list args)))))\n" + - -"(define and\n" + - "(macro args\n" + - "(cond ((null? args) #t)\n" + - "((null? (rest args)) (first args))\n" + - "(else (list 'if (first args) (cons 'and (rest args)) #f)))))\n" + - -"(define quasiquote\n" + - "(macro (x)\n" + - "(define (constant? exp)\n" + - "(if (pair? exp) (eq? (car exp) 'quote) (not (symbol? exp))))\n" + - "(define (combine-skeletons left right exp)\n" + - "(cond\n" + - "((and (constant? left) (constant? right))\n" + - "(if (and (eqv? (eval left) (car exp))\n" + - "(eqv? (eval right) (cdr exp)))\n" + - "(list 'quote exp)\n" + - "(list 'quote (cons (eval left) (eval right)))))\n" + - "((null? right) (list 'list left))\n" + - "((and (pair? right) (eq? (car right) 'list))\n" + - "(cons 'list (cons left (cdr right))))\n" + - "(else (list 'cons left right))))\n" + - "(define (expand-quasiquote exp nesting)\n" + - "(cond\n" + - "((vector? exp)\n" + - "(list 'apply 'vector (expand-quasiquote (vector->list exp) nesting)))\n" + - "((not (pair? exp))\n" + - "(if (constant? exp) exp (list 'quote exp)))\n" + - "((and (eq? (car exp) 'unquote) (= (length exp) 2))\n" + - "(if (= nesting 0)\n" + - "(second exp)\n" + - "(combine-skeletons ''unquote\n" + - "(expand-quasiquote (cdr exp) (- nesting 1))\n" + - "exp)))\n" + - "((and (eq? (car exp) 'quasiquote) (= (length exp) 2))\n" + - "(combine-skeletons ''quasiquote\n" + - "(expand-quasiquote (cdr exp) (+ nesting 1))\n" + - "exp))\n" + - "((and (pair? (car exp))\n" + - "(eq? (caar exp) 'unquote-splicing)\n" + - "(= (length (car exp)) 2))\n" + - "(if (= nesting 0)\n" + - "(list 'append (second (first exp))\n" + - "(expand-quasiquote (cdr exp) nesting))\n" + - "(combine-skeletons (expand-quasiquote (car exp) (- nesting 1))\n" + - "(expand-quasiquote (cdr exp) nesting)\n" + - "exp)))\n" + - "(else (combine-skeletons (expand-quasiquote (car exp) nesting)\n" + - "(expand-quasiquote (cdr exp) nesting)\n" + - "exp))))\n" + - "(expand-quasiquote x 0)))\n" + - -"\n" + -"(define let\n" + - "(macro (bindings . body)\n" + - "(define (named-let name bindings body)\n" + - "`(let ((,name #f))\n" + - "(set! ,name (lambda ,(map first bindings) . ,body))\n" + - "(,name . ,(map second bindings))))\n" + - "(if (symbol? bindings)\n" + - "(named-let bindings (first body) (rest body))\n" + - "`((lambda ,(map first bindings) . ,body) . ,(map second bindings)))))\n" + - -"(define let*\n" + - "(macro (bindings . body)\n" + - "(if (null? bindings) `((lambda () . ,body))\n" + - "`(let (,(first bindings))\n" + - "(let* ,(rest bindings) . ,body)))))\n" + - -"(define letrec\n" + - "(macro (bindings . body)\n" + - "(let ((vars (map first bindings))\n" + - "(vals (map second bindings)))\n" + - "`(let ,(map (lambda (var) `(,var #f)) vars)\n" + - ",@(map (lambda (var val) `(set! ,var ,val)) vars vals)\n" + - ". ,body))))\n" + - -"(define case\n" + - "(macro (exp . cases)\n" + - "(define (do-case case)\n" + - "(cond ((not (pair? case)) (error \"bad syntax in case\" case))\n" + - "((eq? (first case) 'else) case)\n" + - "(else `((member __exp__ ',(first case)) . ,(rest case)))))\n" + - "`(let ((__exp__ ,exp)) (cond . ,(map do-case cases)))))\n" + - -"(define do\n" + - "(macro (bindings test-and-result . body)\n" + - "(let ((variables (map first bindings))\n" + - "(inits (map second bindings))\n" + - "(steps (map (lambda (clause)\n" + - "(if (null? (cddr clause))\n" + - "(first clause)\n" + - "(third clause)))\n" + - "bindings))\n" + - "(test (first test-and-result))\n" + - "(result (rest test-and-result)))\n" + - "`(letrec ((__loop__\n" + - "(lambda ,variables\n" + - "(if ,test\n" + - "(begin . ,result)\n" + - "(begin\n" + - ",@body\n" + - "(__loop__ . ,steps))))))\n" + - "(__loop__ . ,inits)))))\n" + - -"(define delay\n" + - "(macro (exp)\n" + - "(define (make-promise proc)\n" + - "(let ((result-ready? #f)\n" + - "(result #f))\n" + - "(lambda ()\n" + - "(if result-ready?\n" + - "result\n" + - "(let ((x (proc)))\n" + - "(if result-ready?\n" + - "result\n" + - "(begin (set! result-ready? #t)\n" + - "(set! result x)\n" + - "result)))))))\n" + - "`(,make-promise (lambda () ,exp))))\n" + - -//;;;;;;;;;;;;;;;; Extensions - -"(define time\n" + - "(macro (exp . rest) `(time-call (lambda () ,exp) . ,rest)))\n" -; -} diff --git a/apps/DemoAndroidLNjScheme/LNjScheme/SchemeUtils.java b/apps/DemoAndroidLNjScheme/LNjScheme/SchemeUtils.java deleted file mode 100644 index 493d6f3d..00000000 --- a/apps/DemoAndroidLNjScheme/LNjScheme/SchemeUtils.java +++ /dev/null @@ -1,314 +0,0 @@ -package LNjScheme; - -/** @author Peter Norvig, peter@norvig.com http://www.norvig.com - * Copyright 1998 Peter Norvig, see http://www.norvig.com/license.html **/ - -import java.io.*; - -public abstract class SchemeUtils { - - /** Same as Boolean.TRUE. **/ - public static final Boolean TRUE = Boolean.TRUE; - /** Same as Boolean.FALSE. **/ - public static final Boolean FALSE = Boolean.FALSE; - - public static Double ZERO = new Double(0.0); - public static Double ONE = new Double(1.0); - //////////////// Conversion Routines //////////////// - - // The following convert or coerce objects to the right type. - - /** Convert boolean to Boolean. **/ - public static Boolean truth(boolean x) { return x ? TRUE : FALSE; } - - /** Convert Scheme object to boolean. Only #f is false, others are true. **/ - public static boolean truth(Object x) { return x != FALSE; } - - /** Convert double to Double. Caches 0 and 1; makes new for others. **/ - public static Double num(double x) { - return (x == 0.0) ? ZERO : (x == 1.0) ? ONE : new Double(x); } - - /** Converts a Scheme object to a double, or calls error. **/ - public static double num(Object x) { - if (x instanceof Number) return ((Number)x).doubleValue(); - else return num(error("expected a number, got: " + x)); - } - - /** Converts a Scheme object to a char, or calls error. **/ - public static char chr(Object x) { - if (x instanceof Character) return ((Character)x).charValue(); - else return chr(error("expected a char, got: " + x)); - } - - /** Converts a char to a Character. **/ - public static Character chr(char ch) { - return new Character(ch); - } - - /** Coerces a Scheme object to a Scheme string, which is a char[]. **/ - public static char[] str(Object x) { - if (x instanceof char[]) return (char[])x; - else return str(error("expected a string, got: " + x)); - } - - /** Coerces a Scheme object to a Scheme symbol, which is a string. **/ - public static String sym(Object x) { - if (x instanceof String) return (String)x; - else return sym(error("expected a symbol, got: " + x)); - } - - /** Coerces a Scheme object to a Scheme vector, which is a Object[]. **/ - public static Object[] vec(Object x) { - if (x instanceof Object[]) return (Object[])x; - else return vec(error("expected a vector, got: " + x)); - } - - /** Coerces a Scheme object to a Scheme input port, which is an InputPort. - * If the argument is null, returns interpreter.input. **/ - public static InputPort inPort(Object x, Scheme interp) { - if (x == null) return interp.input; - else if (x instanceof InputPort) return (InputPort)x; - else return inPort(error("expected an input port, got: " + x), interp); - } - - /** Coerces a Scheme object to a Scheme input port, which is a PrintWriter. - * If the argument is null, returns System.out. **/ - public static PrintWriter outPort(Object x, Scheme interp) { - if (x == null) return interp.output; - else if (x instanceof PrintWriter) return (PrintWriter)x; - else return outPort(error("expected an output port, got: " + x), interp); - } - - //////////////// Error Routines //////////////// - - /** A continuable error. Prints an error message and then prompts for - * a value to eval and return. **/ - public static Object error(String message) { - System.err.println("**** ERROR: " + message); - throw new RuntimeException(message); - } - - public static Object warn(String message) { - System.err.println("**** WARNING: " + message); - return ""; - } - - //////////////// Basic manipulation Routines //////////////// - - // The following are used throughout the code. - - /** Like Common Lisp first; car of a Pair, or null for anything else. **/ - public static Object first(Object x) { - return (x instanceof Pair) ? ((Pair)x).first : null; - } - - /** Like Common Lisp rest; car of a Pair, or null for anything else. **/ - public static Object rest(Object x) { - return (x instanceof Pair) ? ((Pair)x).rest : null; - } - - /** Like Common Lisp (setf (first ... **/ - public static Object setFirst(Object x, Object y) { - return (x instanceof Pair) ? ((Pair)x).first = y - : error("Attempt to set-car of a non-Pair:" + stringify(x)); - } - - /** Like Common Lisp (setf (rest ... **/ - public static Object setRest(Object x, Object y) { - return (x instanceof Pair) ? ((Pair)x).rest = y - : error("Attempt to set-cdr of a non-Pair:" + stringify(x)); - } - - /** Like Common Lisp second. **/ - public static Object second(Object x) { - return first(rest(x)); - } - - /** Like Common Lisp third. **/ - public static Object third(Object x) { - return first(rest(rest(x))); - } - - /** Creates a two element list. **/ - public static Pair list(Object a, Object b) { - return new Pair(a, new Pair(b, null)); - } - - /** Creates a one element list. **/ - public static Pair list(Object a) { - return new Pair(a, null); - } - - /** listStar(args) is like Common Lisp (apply #'list* args) **/ - public static Object listStar(Object args) { - if (rest(args) == null) return first(args); - else return cons(first(args), listStar(rest(args))); - } - - /** cons(x, y) is the same as new Pair(x, y). **/ - public static Pair cons(Object a, Object b) { - return new Pair(a, b); - } - - /** Reverse the elements of a list. **/ - public static Object reverse(Object x) { - Object result = null; - while (x instanceof Pair) { - result = cons(first(x), result); - x = rest(x); - } - return result; - } - - /** Check if two objects are equal. **/ - public static boolean equal(Object x, Object y) { - if (x == null || y == null) { - return x == y; - } else if (x instanceof char[]) { - if (!(y instanceof char[])) return false; - char[] xc = (char[])x, yc = (char[])y; - if (xc.length != yc.length) return false; - for (int i = xc.length - 1; i >= 0; i--) { - if (xc[i] != yc[i]) return false; - } - return true; - } else if (x instanceof Object[]) { - if (!(y instanceof Object[])) return false; - Object[] xo = (Object[])x, yo = (Object[])y; - if (xo.length != yo.length) return false; - for (int i = xo.length - 1; i >= 0; i--) { - if (!equal(xo[i],yo[i])) return false; - } - return true; - } else { - return x.equals(y); - } - } - - /** Check if two objects are == or are equal numbers or characters. **/ - public static boolean eqv(Object x, Object y) { - return x == y - || (x instanceof Double && x.equals(y)) - || (x instanceof Character && x.equals(y)); - } - - /** The length of a list, or zero for a non-list. **/ - public static int length(Object x) { - int len = 0; - while (x instanceof Pair) { - len++; - x = ((Pair)x).rest; - } - return len; - } - - /** Convert a list of characters to a Scheme string, which is a char[]. **/ - public static char[] listToString(Object chars) { - char[] str = new char[length(chars)]; - for (int i = 0; chars instanceof Pair; i++) { - str[i] = chr(first(chars)); - chars = rest(chars); - } - return str; - } - - /** Convert a list of Objects to a Scheme vector, which is a Object[]. **/ - public static Object[] listToVector(Object objs) { - Object[] vec = new Object[length(objs)]; - for (int i = 0; objs instanceof Pair; i++) { - vec[i] = first(objs); - objs = rest(objs); - } - return vec; - } - - /** Write the object to a port. If quoted is true, use "str" and #\c, - * otherwise use str and c. **/ - public static Object write(Object x, PrintWriter port, boolean quoted) { - port.print(stringify(x, quoted)); - port.flush(); - return x; - } - - /** Convert a vector to a List. **/ - public static Pair vectorToList(Object x) { - if (x instanceof Object[]) { - Object[] vec = (Object[])x; - Pair result = null; - for (int i = vec.length - 1; i >= 0; i--) - result = cons(vec[i], result); - return result; - } else { - error("expected a vector, got: " + x); - return null; - } - } - - /** Convert a Scheme object to its printed representation, as - * a java String (not a Scheme string). If quoted is true, use "str" and #\c, - * otherwise use str and c. You need to pass in a StringBuffer that is used - * to accumulate the results. (If the interface didn't work that way, the - * system would use lots of little internal StringBuffers. But note that - * you can still call stringify(x) and a new StringBuffer will - * be created for you. **/ - - static void stringify(Object x, boolean quoted, StringBuffer buf) { - if (x == null) - buf.append("()"); - else if (x instanceof Double) { - double d = ((Double)x).doubleValue(); - if (Math.round(d) == d) buf.append((long)d); else buf.append(d); - } else if (x instanceof Character) { - if (quoted) buf.append("#\\"); - buf.append(x); - } else if (x instanceof Pair) { - ((Pair)x).stringifyPair(quoted, buf); - } else if (x instanceof char[]) { - char[] chars = (char[])x; - if (quoted) buf.append('"'); - for (int i = 0; i < chars.length; i++) { - if (quoted && chars[i] == '"') buf.append('\\'); - buf.append(chars[i]); - } - if (quoted) buf.append('"'); - } else if (x instanceof Object[]) { - Object[] v = (Object[])x; - buf.append("#("); - for (int i=0; iquoted is true.. **/ - static String stringify(Object x, boolean quoted) { - StringBuffer buf = new StringBuffer(); - stringify(x, quoted, buf); - return buf.toString(); - } - - /** For debugging purposes, prints output. **/ - static Object p(Object x) { - System.out.println(stringify(x)); - return x; - } - - /** For debugging purposes, prints output. **/ - static Object p(String msg, Object x) { - System.out.println(msg + ": " + stringify(x)); - return x; - } -} diff --git a/apps/DemoAndroidLNjScheme/LNjScheme/primitives.scm b/apps/DemoAndroidLNjScheme/LNjScheme/primitives.scm deleted file mode 100644 index 30c81cac..00000000 --- a/apps/DemoAndroidLNjScheme/LNjScheme/primitives.scm +++ /dev/null @@ -1,146 +0,0 @@ -;; Scheme primitives implemented in Scheme. -;; The quasiquote, and a few others, are from Darius Bacon -;; (But then, he started with my PAIP code, and modified it.) -;; - Peter Norvig - -;;;;;;;;;;;;;;;; Extensions: new names for old procedures - -(define call/cc call-with-current-continuation) -(define first car) -(define second cadr) -(define third caddr) -(define rest cdr) -(define set-first! set-car!) -(define set-rest! set-cdr!) - -;;;;;;;;;;;;;;;; Standard Scheme Macros - -(define or - (macro args - (if (null? args) - #f - (cons 'cond (map list args))))) - -(define and - (macro args - (cond ((null? args) #t) - ((null? (rest args)) (first args)) - (else (list 'if (first args) (cons 'and (rest args)) #f))))) - -(define quasiquote - (macro (x) - (define (constant? exp) - (if (pair? exp) (eq? (car exp) 'quote) (not (symbol? exp)))) - (define (combine-skeletons left right exp) - (cond - ((and (constant? left) (constant? right)) - (if (and (eqv? (eval left) (car exp)) - (eqv? (eval right) (cdr exp))) - (list 'quote exp) - (list 'quote (cons (eval left) (eval right))))) - ((null? right) (list 'list left)) - ((and (pair? right) (eq? (car right) 'list)) - (cons 'list (cons left (cdr right)))) - (else (list 'cons left right)))) - (define (expand-quasiquote exp nesting) - (cond - ((vector? exp) - (list 'apply 'vector (expand-quasiquote (vector->list exp) nesting))) - ((not (pair? exp)) - (if (constant? exp) exp (list 'quote exp))) - ((and (eq? (car exp) 'unquote) (= (length exp) 2)) - (if (= nesting 0) - (second exp) - (combine-skeletons ''unquote - (expand-quasiquote (cdr exp) (- nesting 1)) - exp))) - ((and (eq? (car exp) 'quasiquote) (= (length exp) 2)) - (combine-skeletons ''quasiquote - (expand-quasiquote (cdr exp) (+ nesting 1)) - exp)) - ((and (pair? (car exp)) - (eq? (caar exp) 'unquote-splicing) - (= (length (car exp)) 2)) - (if (= nesting 0) - (list 'append (second (first exp)) - (expand-quasiquote (cdr exp) nesting)) - (combine-skeletons (expand-quasiquote (car exp) (- nesting 1)) - (expand-quasiquote (cdr exp) nesting) - exp))) - (else (combine-skeletons (expand-quasiquote (car exp) nesting) - (expand-quasiquote (cdr exp) nesting) - exp)))) - (expand-quasiquote x 0))) - -(define let - (macro (bindings . body) - (define (named-let name bindings body) - `(let ((,name #f)) - (set! ,name (lambda ,(map first bindings) . ,body)) - (,name . ,(map second bindings)))) - (if (symbol? bindings) - (named-let bindings (first body) (rest body)) - `((lambda ,(map first bindings) . ,body) . ,(map second bindings))))) - -(define let* - (macro (bindings . body) - (if (null? bindings) `((lambda () . ,body)) - `(let (,(first bindings)) - (let* ,(rest bindings) . ,body))))) - -(define letrec - (macro (bindings . body) - (let ((vars (map first bindings)) - (vals (map second bindings))) - `(let ,(map (lambda (var) `(,var #f)) vars) - ,@(map (lambda (var val) `(set! ,var ,val)) vars vals) - . ,body)))) - -(define case - (macro (exp . cases) - (define (do-case case) - (cond ((not (pair? case)) (error "bad syntax in case" case)) - ((eq? (first case) 'else) case) - (else `((member __exp__ ',(first case)) . ,(rest case))))) - `(let ((__exp__ ,exp)) (cond . ,(map do-case cases))))) - -(define do - (macro (bindings test-and-result . body) - (let ((variables (map first bindings)) - (inits (map second bindings)) - (steps (map (lambda (clause) - (if (null? (cddr clause)) - (first clause) - (third clause))) - bindings)) - (test (first test-and-result)) - (result (rest test-and-result))) - `(letrec ((__loop__ - (lambda ,variables - (if ,test - (begin . ,result) - (begin - ,@body - (__loop__ . ,steps)))))) - (__loop__ . ,inits))))) - -(define delay - (macro (exp) - (define (make-promise proc) - (let ((result-ready? #f) - (result #f)) - (lambda () - (if result-ready? - result - (let ((x (proc))) - (if result-ready? - result - (begin (set! result-ready? #t) - (set! result x) - result))))))) - `(,make-promise (lambda () ,exp)))) - -;;;;;;;;;;;;;;;; Extensions - -(define time - (macro (exp . rest) `(time-call (lambda () ,exp) . ,rest))) diff --git a/apps/DemoAndroidLNjScheme/MODULES b/apps/DemoAndroidLNjScheme/MODULES index cbc1d482..7abf9dc0 100644 --- a/apps/DemoAndroidLNjScheme/MODULES +++ b/apps/DemoAndroidLNjScheme/MODULES @@ -1 +1 @@ -eventloop ln_glgui uiform +eventloop ln_glgui lnjscheme webview uiform diff --git a/apps/DemoAndroidLNjScheme/Makefile b/apps/DemoAndroidLNjScheme/Makefile deleted file mode 100644 index deab01d2..00000000 --- a/apps/DemoAndroidLNjScheme/Makefile +++ /dev/null @@ -1,8 +0,0 @@ - -NAME=LNjScheme - -android_jars/$(NAME).jar: $(NAME)/*.java - @-mkdir android_jars - rm -f $(NAME)/*.class - javac $(NAME)/Scheme.java - jar cf $@ $(NAME)/*.class diff --git a/apps/DemoAndroidLNjScheme/README.md b/apps/DemoAndroidLNjScheme/README.md deleted file mode 100644 index e35bb084..00000000 --- a/apps/DemoAndroidLNjScheme/README.md +++ /dev/null @@ -1,104 +0,0 @@ -# LNjScheme - -This directory contains an app to demo how to use LNjScheme from LN. - -LNjScheme allows to call any Java/Android method from -lambdanative/gambit without additional JNI code. Either directly or -within tje UI thread (dispatched asynchronously via `runOnUiThread`). - -## Build - -1. call `make -f Makefile` in this directory to create `android_jars/LNjScheme.jar`. -2. use lambdanative make to create the demo app. - -## Toy With It - -To the user, the interesting file is `lnjstest.scm`. It contains user -defined code to be run. - -- An example file `lnjstest.scm` is embedded. Modify it to suit your - likings. -- use `adb push lnjstest.scm /scdard/DemoAndroidLNjScheme/` to install -- push the button *Load it!* to execute it from the demo app. - -The (initial) example `lnjstest.scm` replaces the content of the app -with a `LinearLayout` containing a (scaled, since I did not find out -how to resize it) view of the content followed by a greating, a `Back` -button and a WebView displaying `lambdanative.org`. Push the button -to return to the previews view. - -NB: Garbage in `lnjstest.scm` will likely break the app. Use Androids -App Settings for *force terminate* then. - -# History - -LNjScheme is derived from the 1.4 version of -[Jscheme from Peter Norvig](http://norvig.com/jscheme.html). - -Jscheme version 1.4, the last version that I released (in April -1998). A mercilessly small, easily modifiable version. - -(NB: There is another thing going by the name Jscheme, which was -extented by a community until 2006. This version grew beyond the -features, complexity and size which make the Pter Norvigs version -interesting as a strating point.) - -Jscheme 1.4 however lacks a few features, notably the ability supply -arguments to constructors. Therefore a derivative was required for -LN. In accordance with the stated license for Jscheme it got a new -name. - -## Changes - -1. Baseline: unpacked the sources from `jscheme-source.jar` into - subdirectory `LNjScheme`. -2. Changed package name to - -LNjScheme and added Makefile. -3. Refined errors raised from application of Java methods. -4. Pulled some code from the community version to support constructors with arguments. -5. Copied glue code from experimental branch and rename identifiers. - -# Issues - -## Split Into Module and Demo App - -The LNjScheme core stuff would better be a reusable module as it might -simplify the build script dance around e.g. `hybridapp`s. -Issues/missing: -1. how to compile the `.jar` during build -2. install the `.jar` -3. handle the EVENT_LNjSchemeRETURN (i.e. #126) in core (see - `main.scm` around line 127). -4. discover why exactly `##thread-heartbeat` of `gambit` fame was - disabled and clean up such that Gambit threads still work as - naively expected. (Maybe this solve the performance issue - observed.) - - -## Numbers - -jScheme uses `lang.java.Double` for all numbers. This does not play -nice with native Jave APIs. TBD: Teach it either about fixnums or -conversion; or both. - -## Missing - -Really missing is the ability to access arbitrary field values (as -apposed to calling methods) of any class. - -From -https://stackoverflow.com/questions/13400075/reflection-generic-get-field-value - - import java.lang.reflect.Field; - - Field chap = c.getDeclaredField("chapters"); - out.format(fmt, "before", "chapters", book.chapters); - chap.setLong(book, 12); - out.format(fmt, "after", "chapters", chap.getLong(book)); - - Field[] fields = c.getDeclaredFields(); - for (Field classField : fields) - { - result.add(classField); - } diff --git a/apps/DemoAndroidLNjScheme/VERSION b/apps/DemoAndroidLNjScheme/VERSION index d3827e75..9459d4ba 100644 --- a/apps/DemoAndroidLNjScheme/VERSION +++ b/apps/DemoAndroidLNjScheme/VERSION @@ -1 +1 @@ -1.0 +1.1 diff --git a/apps/DemoAndroidLNjScheme/android_jars/LNjScheme.jar b/apps/DemoAndroidLNjScheme/android_jars/LNjScheme.jar deleted file mode 100644 index f985d8e387c84f1679491d20d7bd6031a4951b1e..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 32216 zcmaI6Wl&u~lr>5c+}+*X-QC@tAQyLcg1fuByE_E9K#<_>T!KSzxcJM=H{W}2e$1Sz zuIjGdeY&gm>UH+nd#NgXgT#b@g@uI}`eCaA@&9|^ARr->q%_5tDa%PqX=pMlN#7|=Pbn%eG0!6@FwxIU&$g7L*L3Gndftid=`)W>D?yvI0Le{iTWAeQZJU2j~!{O2iVUs)C; z|Lr05ul>)b!1*_;sBEiYZVhk%ut?ZDxp}w(n9c1?-Q42UHysy6QH64I2@WdcED#fJb;-Gn#3{cWqvRg73l^FchSd1JqI1Gq^P9nv3E^R9p9|oB9 z_OzPi<7gcW40=c2L;ia%yYGwMs;g}&HG-5MsFj_|p{o&Sboqx1)BS|i15<55bww2| z>WOi16X(~;=E|=cPsXRBm$vnc$Gu?Dy3_U@Sjln$bltkurwydn^oz-}1_4+9*-Lqy zaw=l}297oCwV6UGI6b&=IzgKKgw>RUON0QXvxhh4;~^1>Z&Ba9lK2ZBwT=Q$-4K#Ery&?|;VVM12mLe@QZDpgQw37D6i!p@ERj)=Uxz(Z?WxTv zp`x&L4$CXzig*r*zSCRzLG3rTO*g*h-=FyU#UEa$Ksgnjyd+l(4@ly0u@CbzD~{&r z%^c8S!masLaltgu4Y3Ukc3FA@A#R7AL)wH5g=`vxi`FVAy~Ow~dO^fq&Jy(*rkv@W zXrX;DJB>S$_+^IN0U6&R2N#cWB8glk0eo&jo4QZ#Wfw(gip7ScfX@td1%Q>7iBhST zPN0bC4XMS5=2EY6&4@Xop&S$o5+k9Tmqc;-%MpjNg&CX!DHL+hExO+>@*m)aT}f3$ z|A+4LZ~q&t2>&~*oE+V496e0kZJZqc3tMVa@*|>{LaE#VWj1ysD>`CZviPHphM4q@ zF%2OxSWk%#Hxzlf$n3CL)Y3BX3s0h9f@?3%}82{06N&)Vd+1zriSeGp0Q&~}6aU&^n zTb7va5qSC%aJlP)q(-2Hydna_q)DDJ*s;i}Sz`d`*r!XytvS`3iQl>XepHYGoaX;B zo2J9o%3@%{x|O9=>Id@!82zi;WGSTV=63?c^>40<`vVu_fhCfE*tO{8qRwFc!!OuW zVjId|ARy@f`R0GV?ganMFH(-4Hm**N4gg2@|8k3#g9e5UX5dPneM$o*bcu8{v}AA} z>ZZDhDC({%W>QSZhOJQw6*G0OORLx^%gK1)C<&>_+YgQq#r)F~9D&8`kMNJgz^cdY zTvSTwbH$^){-*-J8J_~Tncsz1fv-fOB7w+ztkQ2M!+2yf@Gi`vF2-Zw5Pi5erkW?Q z;)b`TiYHUUpcvExaYb0R(-E!W$}q6;7?;Qf>*dG;L`fIgPekUatcU#y-a#s$16d#{ zNCwaAD{oY<*-dJkU!c2qIvWiI!%%;fJ^*h22FgS2H>M^z<&^usBKIpD6nJh!`+pbtxNQhh z$nxGu!SOuo)7x?DWs)wgrSpa`kIGWG5C^I>Y?`#&r1m#|E6`E z8P{SkL1Ui!=5py0o!o9{7#!h4c8e}}(`Vy$EbI=2aH4Y!0R<&RHXtR^dmX`Mr5$IO zr&Jxwjxx7_8bPhQy~3nj!N^g2NS{%$N0y~fYnwHuK3|u1P+nikZeOV&9*;{2oLTG8 zW?XmKjB8DB;ZlYH|OXg*g?ndpu2 zMoRTGn})#R@?2lq8+3K@?g*mjC49r^d;G0v3tOTB8s2;O9Rn7!$bj=}npHH|piz_p zsFh;-@5dKz{ApUCx5MMS-PK)>XD8^{Ge<}LPwN$|!qk;m=9 zpVgKaHH9VO15fbe1ObkYTQD-`IvFX#EtGeFcri3h<#^ zqbm#VQ2gGX$=5-f(?A3%T5r)}%d&&zEWpl~v>0g%QyJM2{3FsfrDF8oVcOp%;-Ybe%w@ z0kL~Hv)s8SxD$f4!EoVc{CT zz#i)PeCnj1=ZlxGbHj8b=R1l&vYvkPlN>`Ou+DmCmE2HiEtP@2XKcjA|@3 z=Wf=&>Vm-d+CUa&bNu)FrDKGb5c#j8?Wk9cOe;QQ9wJVO_9^}P7n+nHQOnkfS`S|F z%P00u=5o%QyPCTHmK{iI z<~4OsksZjmC`ATmlCr$l zexiMo+2%bOQb+7^F)UO0b&v3kW}EkLjD-u6(PX)7XthtMg@L_N0DYIck}EZ4w3BH? z6*&1HAD#F@|04?mrtR9lHO^l3FyW8eT}W+8rIh#9!gwVwTc~2 zbyU|(PNW?Z((q_+RT(jHoZS-VPo=hm8avLeqe`76GC*E1ZAoh-<%=D;a+5J88ChQ3 z$A{gi-y(FWUBk4nqoge5+$N94<2~2x;LpmL@m^k^E$co$DXYF+I_wEEOT}at88Cwi zb19?aEEPrElNw$2n-+Gm=NI-0qji@1K!YyNl^Lq`=r=YsHJql1KP(7Y-bjs8_Yu)NE*n4t@6E7qWDK;n z+$eJnI~Hp*7+hH<;ETZkO==9Jc<@?>H#xv#DOQMFvv9X|_A1$EMDuc*nmr?WcaMm@ zgFQ*0HQ8O!WunS_r`5%(e3fZmXvWo(f1N0H0Rh7ZecS7Xc*-_x1oRWHk10oo3yQx5 zl0(BU_0hZgPt+ej zMC3Vzzf&HL=?W5^H+_ws5v5GhzNzy%P@(>aLs5Ezy2=JK2$zJOT2RU#Y`fU;C`jk! zkgfXHnc9*n*EbhfbS|5Za%jtJN9`%9<3Nw@wuayO5lQBw>+CVUaPPB^8xaTCaK_Y;F@sOoT&Xi+79+tn&X9FCNap21sMn+? z`+=iXrNJi6yWDFQpu=d+2RJm_inboLVOX>u?F97L_fe8R&;I^JyY!T>vu{U}iYla_ zQT;34Rl!<=!ogO5V@p0($)%5}IUz7Qn#&wuwy29%OSla6wJPak}TFZA9ja3Vg6 zX=)Ns#}jY5Swl4Q9rN=YU!dd-PCnG&{{99*o%a*?KrV*xL#_++ zaEVB@4gL-@KT!d5Iem0l5pAz>JH74ctGtqoY<|@k`9>c;ju`?K^-r#K+%O%1SaEAd zLzYD(cYxhaG4y!x&HfifdO&@vGZ49TDD5H`*qQF8F*or8&r?qEjR5aH z^qF*%XZir?PA>X=rdsdMlu&^`rA%RWm=!bC_++6RFSm&W%@9T9iyF44xbTk&m_g?0 z7qM~&_==;@Qw`I>kUR#w1*$fu>f2^qD8Q<%!o?2{WGF?01KOaZFS!eb=ea#7qx&IW zz;5jWlL54MMx?%7eDQIo!?1DRH7_Nq8}+eiSVPYd077owLJBKfBj-hR63-7jnTeQC zgYT#7ycuD0w!ReZUoz-6ekEXSOxD50lb2iL<4IjcwKctoG15{Zr=h})p}|n2eW{85 zCia(^6rRy6nF}3Cn-b$;~4SCx(RGf~15+bLlU1-$U7l3oV^N-fgM-o*h$bgu(IlYgib1_zg zlk`5@yV=a_xyC!d$6<3tIXyz&Hk5K=%sJ+$nM-;{oheVKI|l>K`%EFqD~$? zypKp|=bM+0RuWiF>{sj>1 zV;jXE%s*z>^*p4gCdYP3R*AlV!`QiqAU|z2f|{Kvy*Bg|27evo%&S#dMm#DuOrOs~ z`Z@ZhW6TANEEb=v%O_|*wS%V!U$w)hmHXkVCuVJBEr!aoG!28-nS!?bn)?-viUk9O zZ22quNlo8l;ZVBt9jVz85N3v>GrK3@lq=Kog%Q_}!!XqMxR2%!xS{F4Z742m#|B`> z{`Bs?_&qNHflFl1b))I??Yb$yYY5Xzw5`Z-XOV)vGdjU2VZpffKg7eOywT%6v&Q}* zG&d-J1A{Bu;qPr0uj8zLrztP&Uq!VK;L!aKg^i!|hQF*$ynfyHEt5~73oUP%W@mGY94@RRUkhTe5gpF$e0 z0q}wFA91Vw6CQ@kznJw6{eO#F@&8-gDsSp(sswPicCz?CX@YcJIDgDlpHGp?I!jNk zuWho>WN<5Mq|GU)(2Q}AxTq;;vLU31(Du`|T>ABTmwQ4#%WT}z+T>C$-PMmMG#AAP}0#9|A5(EE&E$eLgP7j zoHXO05b>=w!RZ8yL$sULo{8ko5asx02eCWmh4^LwF<$oh1W~dui2f7pbdcbu+UY07 z58~5Ljvp}PpT-ahf13tyB84+VGwlWHVSCM6D6yZObaD2z|v|t@=DevnqbQL5nKiVuG+mb(;(| z60DWw%LskPDgi_f8lfs}T-)+GZuv#Z-}FXORqmWbSMt&vcnqbe{0mRA_ZDqTcuJ$2 zdF#sIw`>dowkQmYboz=06mkq14(DDgT~o3a(5>_Kjwh%7B)6%|}tr>{frEKAw-0d>Q&W6Ffm~OcsjeVzg#otF`6q97US8ndR~qsQM}5 z4$Pw`D)kjnNBdv$SBc0}d>V4`X5+7=G=w>5W_kI%ff3&|tCVFh@a%B(dbHgu7d`ch zKgVh=NR&1!!%XNLj+E)Zr8LTvDhykTORGHBzrNcq;kRyV{aw*zrPxw*=J;W0;XuO+ z&yeFdO-3^E{mGo|T#|bTm3O?ed{M1tN%st#td1{OS!>x64JUGSJ(){1gU}dbu--rK zp2llttz3v&rqxw+tINfej;b$@R>PVii}d6dbwTUVfLW`aH!W#NK#>~N{XM%nwAPPK z8}iA&Kyf@4W%fGUuj79H4C552OP-D}551&9=a=^Pc?=bLD$qS>3RshDS9KJQ7ce5=JIAA5Es>-*yZ->>~1P z1O$Q@%i~%2c;0BQEYAgH#M~O0?aJDGYNs}%x-yB5{I(LovQg>Murh9Ueg(;Aj#5wl z+PzXqW$H`Kyi^J~0r?jHwHdzb-tXK$726FSvTIC`PHYpaA8S_OfR8uUymp)DZOzs( zhYLJr`RcG?r|F0~!yLNZxK?|yeagKDU$?~CO@0Op4uj5(4ygl8Zj>FedW9*TY7lhv z$o#yu+4t}iv%sXnKpctSsR2X!T-?@}w?0n5F@?0(pLsrVJyhkgVY7#*eB{_+7^OG1 z51=MWl?1g3&QtbTlFvF5_;znqKIY-O`Da8@$SQbOrHG-g${H^nN z#4s$28CnpZq6pJ5*MLr1+CmHk<1{;=DC~x8EIv(K59aP~mG7G7_>w-gNz%M-L5nie zm2<05UQ25OfrYsyQnojK(035ZjZ8&M^?tU`=|D9)@=0u7Z`J+Retg971#BygnJ@2Y73(+Pm)Sg`6^=1cIZ0)t!nwInPAv6lRgStZVSySta#M^( z;(O#{ONCClcl{Y7|2O3_oh@MWs&G<@Hhlq6e*$<15A<5vGLJ(v*~NBXE7VH>v6wj- zZxs1}oH_mlrls6?hpU`%?-9!XrzLx|x4hwYYR7n(!~~ByYqAT2+;j?zg{9NS^I1^} zfxaW#Y#FJiZ?e~*5jJ%gPsUpdE!1z+(ckp0 zia-nU)NLn{rZ7Iop&PYfx7hTNxfb}bi!rwG#osOK~U-)p7S8O0>$Z&14rKQ~d=s{L~FOUF) zjZD%_=Z?L(>9Phh5#@|iVuDN?@R<{B7zKHQ0pW)^d{ZP9fm3tw`Bknjyfu7x+_s(A z)SEs_9>O{`b5W?=-^rdBkN(5Hbr$X4{iFCd>N?SDmn#o5navQD1U@5 z+?>mJ2pY>A`6K!!tjWpeb&V~mD57kSjk%1Gt7UxiHEm{GGG6peu}Uko;PXSPz9s-G zW!B<%9qm{(e<#!eF=3HSQE61=V#a*b;Z$;ayM0TZYgx&-gIzT6i;2GcRT6O;-=5RyBzIFh`L&oDt&DnEH@w_kCv_2FTNxFOsejH$_wU>SLI5EHp}uc1 z$%uSp#tzafbHul<&{nUMb9qVJA`e}O1SP~pdi%q!*j9nL>3$|$ssO@zSu-wILXimW zJj+k)t-~+}w)-40qN~4)H^d)11gkf~kAqmEqQd61TI7!okDwbG@}_*ArA z&Kyq}@!AShyvPqUP8Df!CZCdY;F;jOw3$*tS1fQtusH$vBIv>s{V3QR3>5M)qliur zoad8!&aG(nS(s@3YI|k5sSL9%@yD_3hR9xEK2!-8Xh}GN9k*|Mbghlw{+n%Aat<+j zhor#0B^T#g&>Q*f4=shRbT>es5558Ss)D#N;m!hU0ur$xeuc{wW=BK^8Wobt5UfMt z50NFRy=^v{yR$+WugD|2r&aKIp|n^0zibL8e|h6gV>wR2P>O#2SkM=tNZOV_{3oG6 zVgVSM?~`qcNG&!e0tY%6IxI`Jt=mnhK6A11V}tO$*}A?C#BASD&#IiV4$={G zt#zYYR==y)3!Sms#*$;DH6k}Q-8bQ6t)N%*AJk=K&IyDYVbqmpHu=E^KxN;Ne!@J{ z-qHRh^j=CXF0HGHME{kl;+S~sGMQXopB($4Hr6mJ1IucxkbC}Kn*7qfh>M$6>=_5# z%VytrbafM(L5Jb5{LXrZ&3bnRJBUTdbNAKdi>@b>*v$!GgCNanfCgNmGn)d)J(WRQ zC$`b`gYyG7O4KgH2KOIS)w1}B)X;4hRV`QC^w8`(t!?dzbO1nSu`PsAOLpTc%Emtj zB%VXKPq5bK0-w&3TRe%MfZxncd>WzSdSV4XeL)rZZn-y(pbMb{q~&Xq z;EJVM>(VFY(26t|pBR&n0;Uo7V%}yp*XCysjI%(%nqnxn+Lfit{+F5yfpgv~tjoHq z3&y8>bL$Fkl6ykQzH}Y7^HW1jmw+0g7;R z1guiPp4?KBAZG&VzPGNWu2vhIwUny_a#~^O^s&#Zkp+{_OlXw0-uWhd3;6kT!gs4S zK>`iC(<Z)v4Vf{@ejPfoQ7txNHRy9JJ~g0n0S-+QAzDprZSFuVOT z_F2#xO^Wteiiu6!Eg<*(umB0Ad`F#y|zRr6K5Cz$BNpyc5R4*c|Y&c>sI*1Pkmr6-2I_kqdY zYrCjsmA&)uH{1Ce(-2n-uH()cofVBGgR>chnnK>HljB&MB3`K!;~4Mkp;!m|A5JNl zcQck;$(a7ZRk;?_%KJcz$U(4kPNdztnGf}6Lw33i$CH(l>0sS4|72`pewumC6Fps} zWn~`a$_ZiqnD$M_xuur>(y2dhKP=H6LD|5>I}69@;OOu@{MGE0>+zHK z?W^J~$@L!;y_P^=s)%LGd)WSG^}&{9nhBN#Z)1NYr0?xsZEwgZf5Ea#!l?V?(Lu=I zQ%gaf6{x4GdwXg|G>l(_JASdX&{M?xm5t^X$>)Dc0Jil&xvxkN5V`-V{Qq;Q8SB6O zLMoY>yE^?}UCFM>qAKRc-<5g;oes7zHX;d37XyJY%z57Z@SlsKsd&4+>Q+{(%-f09 zAd!;KAB|Z*DTQ&pADqa?+@{j_F`F6c#g$4sZ!EoP+RH%S1GUAAOXb5VM z$p@BfA-#l#pd(|!0I+!w~}*AZfCp2&z1lE2&H-vfJ1yBgagq-58?bMqJ9BDUXj zU&0Ak!15eMB$LAyup^rNm8VxvZ3*L~CBIPZ?0U{G;<5^!*`75AzOu=BR9>BpHB6K% z`1PI9qogK_sz-$QM1VhIEUIWHbfu!nmRNHtm`dZgkaZ*lQ*Ln2*$cjhdL5fo=;T;w zSxoO?kK7-wcO1IEGQ-I#(^Ep%FE$IO1ljc%y{J5Ii#sC)QlBJj1J=6cH(xk?M``9e z?ItEX7d>(^7U$}k*-T|kI7G^paILXNDhe0uEdSb4W>_~I?3tj(iQul=yck4?B1B?0)Qi&Dx8m3{q^NG$_NDu$MlMj66b44X3&31n+_9*XN3Rh9P}aoHvs;J!0P{#HmRE0xc(RZH1$+4)G$Ao^F1Tj z!`1Pce&}Ldy7N1vYiZ+P@`$GPPy%5h*+<2!ixHxu69=AQfL=Cc-bs>8H$#U~7(pQ- zqqq-S3Pa^wH>NZFyWPhE=lyrjueqHNFRYj05wb#*xQ3E|EMt9hLtwWoEpPQ+S_m;z zKl}^kJp-;P>&d7MqD!nPvotTE7Av)R-cY`$>+@HM@3!;$t>_BcmSipgj`PY`(zs=L zzh?zYmB;9kTyz^dYE~p2G2F-noH#g@`0)HHx&*C`9rfK5%5K(brR?Zti!h@}uK@wCyf$ z=AfFjwJ)XxL#uUQsuJ|F>2Gd5>8E^d^d~-Exmn#$Fh1{NDelcUeS0d&n>voPQ^Dp_5{%w_DQTZGrnn??*ZMUI@55?q|C7l< zT13y1g?ORuCWaX<0MNBsjOL2w3P-6xCEK8sOoFn2j50xLvGFWds+L3>j#u=+ znqQS%ysU6AEz@e%ft?Z)G3qs3HyMJeaWKEg_3qTwKg z%r!;CH13!{mAeS?Od$&4&tX+@Sdu8c%mDh=uUxK6k{(UjYckfB_Anm;(s;j#Eb)TT z|K`B6ty`0lQBVoo7}8 zcd6$U*%f6g>13S0v295b+T;P*l}(X^yu*wID?YC=?hoiZ?)l!OO}@h#;7a3_dPlm< zA1HH1A(K2k``@=EO1wfVRb--p>3i_7)gB7}BXQVyiTug&PxQ6+uju_hv;KcCc&obF zIM}$`c>Z5Sp&`uoG%4&rjgRg1?ZQ7QvR{j#%fc{4CFdZLlOSO!*OS5;Kq-t(Nfsm2 z#p_rEo@!{SnvAsEjG~wXXQ%5k35OR2zE%P%vjT^rfBT<5x8FonOF6CroGf?xeC{gV zA&tQg$>U$Xm-X$;vOi-8tG>xidTKnTWr{G(2s-cm0L^+o7rwpeedK|HwBLM2O;q2c zMorY;0HdEJV1}4M`NKxKj~>uvj7b@oAZD-{Y!Gv$_U16UtM+Czx~uWl7&F)ihKUKP z0?Wh%)q!bZf@;84F`r5|vsjbEWkb6mzBFKL{G64-|z{4WS!KN0pbQLZlLu_fA)p2d7;# zps5aPmc*jV$x||z(j}Kj)}R}u%W9AtMI%!6(9Ih~D^mH=&TB*)%in94B%%jk?bb+U zpueY`Gy>IPc58tURM7Nnve85G77T2X(S%g4>Ay6{O`?nC5jEb>s3I6#+R!P|c%`G0 zDrHr(K6EL0Mb#4BXml$1^sFi%B^5P;S_Kf3 zs)AmvK{6aYT^=&MO5H36eOZ2qR;?E3PGw2UrV*_tKdo(+fbN#gs}`M_#;X_YBcE3y zDI5JPzeK0jD5)C_CC{j7mW+-@h0V|`84XQ^pKh&AUL*OB1=FMG=1U}N(H-O&?@C)U z{YK$M1cwS$&8XCyV_G!Qd66XK^BRD7VY6iyj5UEB=*Or+nJvqj$AX|4n!jH`%w-qk zjk*%|W+MKK%*7Y#A(?8Pd;lF)Pbz?pT1Q4pEnRO!iyfW8G1e-Yk;-o#)XwCtbGqIk z2JYw4co6lhcT-T+o8=_8h9?5nj{Leq+P3mK_T=B93+2fUbx$0Cmxd<_;7Q$+1h6SP z^`0gqO5vB(6&bauyoKDjCfBw-D=MhCPLXz5a-lX!d>1qRKFv^2q_2`I11r7M9No%4`+V`Ryf>ioJ9O$3%l!dQ)4d9S2 zmg2SeavtO?L~ z@5#nF4veMFIQ;t0{A(*zzUJA zlLOi74M0~;RjjbhsPtZcRXO%B>Rn;bc(YGXlzO$$X;jo;-)7)QyEsbUerJ?~3bmka zKiv;q1*kypjLB-K*_$GK)0U=f8YyXl{Rqw?JfP?hj-_ASqN8f{)q19fpt4iDH`>L|i)7(I>Tv;(lp z^@D=)RyNK~(?_M+H+D*!oGm@Fk)Vt43H_?;ElIWWQ4upTv9)Z4Lg$ilY?giPLz7wZ zwaTCEFB*E>rENUowb{c6bu};;sgptM z*kXcbGx&_+lwobseBpW#23(x?S{{|+>S!BI&VaG%DNApAEo$S|)z&lMpXi{85{FrVu1*Wn;(h4Q zwpC2ANsyx&%1(FD<6=S+60IMA-bdU@2zgwy&A)DzqRdX%UktV^k|yv7n^iQqg8YQ~04V!*BS z>x~6QYK(^|0#h9b-ps&;>-WOOM$`Fsx#)&IL=RKhHGyeYNH_V~Q2aVkikc8EKs$ir z!r3S~WO6}H3T}v=zucL36w9|kWz-dEif~9Tx_=BUFLK5c@`m5;#5qsvPgWow|JT_( z$N_Qleq7FhlnUqrD@(kDU7>CrHraR_LO~(B(+m21y6Xq`9~r)Ue^(#_mvgyRn915q zoZbQLz^lb$Wv2Y8sE^|!^!UdGxzKUs2PrTOp_-JMiwCM#ONo5_+3uhDv$LXx&(hY? z)uoM%Kv4&C3Z-Q2t#`q7001Ci`7e=FKhCSjoX8n|*(>K@9r#UNo!p(v#=0s-3ZJ4r z8DN?>yT5*Tm>z3)h8<2YG9sUwA!RmSG3Kmso<$~;RLWO;bOfE(f3T(Gz+U0+Vy$Pb zD^X>$-?aBOy3fDhmIa%sp=4L(C?{2=XAps-=O5tzFB`DPa zu{n0Mjgc!M#OCCVD0SVkw+NhCJF@Md&j-hw;=8FSC}83^iqUYPWMblY*;Wiz*EjQS ztP#c(KS6tyoOb56x0|(I%;coIZzy+2VuSS4*8vjOe_)rG;78H>y(*5JCkSoVMjy3G zY}8YUAm{O!RxzGn+&yf~QtErTZDFtnjITrD70gVDW+sbfEXx;z%{=8eo_A$5M8(i3OojN_by~I<(y{fUr>aNfchV(a0mLPPX}Yv279N=GO^{ zIR5uY)wFgmL`X!Y^|jhk<`(TV3+lu+Vy}W^G>HA&p%Q5EWLwh5Jvx$FjQThYPO%;x zwETL!4H3n%7o-$z5QQGNdR+4zx<+dqLUhduk?JtiB07&;dSOhQ>tFxXiuir`UzqJ| zkyy$i;YSFpbUKR@@EfPu0V2_>CJ|4n5j@HfoeB}1tisqVMsetloPDTxXgRy$={Jsy z5+3u|w+HC4?xfA|I&zhr7e z_Zw9-eb?_W^B#$QkHb!`UV^rLbve!^sVSWO4SO5p<>X%qKZC8m7ERyUx_o- z%WQ~^Or#j44-c{_HY_66>H7Mvb6>fP++QRUFvRl#=RUM zZEXzNxI%(|c$oPHHCgduQ=>db@zNvysfGo_7t3l0`TQgp=}w&g%4#;x?OJFHci@Q; z^AOwm0EF*%n9L~0v?u_Utt$o=3zf^cto`w~mxtBY=AKF9rc{1^1FvK1>@mKI!U)2u z>B%e)ht{4QUKM%AJrmV^qcz5o38lDMmwl=v90*;0jron;W2;JHoV$#*aWrm}WP$P< z>r2NE?POsk!J9P>2kO6d%*cva7vDE6VAiPp93+#Q^Bm!I^%lW>4e;Y7OC->AmwZUx zIj5vfMws=hQ@rA21PPH`4R^{27UQ7wE)!sF^n5It|p+GmS9@9;#`}>A?dKs@4h8`jyu=DG}6L z!55*~R73!5a59MwxG-gKPoQ^uPZZY-ZQn_)qQCoyqcmJG6^``HJ^v_;i z7~2!ka{%(|cmP=~P_AUc$%@I<^;driY$m1H&2D4C_>G44lT`lkbOhEt(39cRL19;B zbET!BXC2h=s|#2j`Vhl%*B+6|xr_6Ax=?3RDpbo&zIkOz5V$ zhS*OxLpm-R%$W>|fg(Xa=pVQa<+~@-DklLIf=C?63fL-?-u$D0Qo)flEA{?XS^=qo z%k<-{Tf^=gu?#zS8-TX70nLJPE^aE_>_O*2e#6Kf-CBuwqcQ%~YE!=7{%;~m35P(4_JFz5{C&EfB!}tkG&p}Bc=h`=InQ%}R z$6~)AO=|X!Y?p8?R}AaHHPQE>ulLZ*r&BJ*)M00>B^#DCe|?9rRpS{HeW>c60wbRY z5mu#exTUnitA!pmF;MK{2+zEHIHz{_UF>vm9hiRIPS#q#>e@}#9&%OmX*Zb9J!ZQ6 z2t73(E@U;!zw5PS2z^-zZOe>#a^6h!_o2`mu~v#3YeKbsE=zRXyYI;UGy#4X_;Uvc z$X(r+!WexFBb?*|zgNAETB{u5zFfNkXQ`g^xp`gRl}!c#`R919S-<#nRaF`%Q?LeF2`j7iqIOK;>J6E`pG;U8MWGXn+n}s zh>0<^plg9iG8UiLN1l1&N}P4u`rp<@n9=jU2^zgIp$#u9tK5(*t z{*d~m?q^t|X7@$O>k>!UsR`OWcNViu73F))JOqXvM3)TWFWJEz>2sP~lBF+v_!Tga za;N6XZfOnj>r_1nWmkhRGJ0mTatR@xS*x*82Gi&rDqIIYd`-c6r|7Pr`%7WO3TN_K79hKNrO z^fl50EfY`e)rcOuFJyO55Z@m~+zI5@K+Pth7SdKGa4zJf9W^43GRMA{Ldda~k^Dkj z4l7Y@)>d&spfQ)I62AO|;Y~#?{G5Aqdpo@)pRC`f?)x+(u2$j>;9pfsRzp8`*ULOY z*({9rBnI0>j=#2e8y8g78r z*?r9poHFu;0;Mze!QWIf`{RQajlhUNtDbAUs9Dc_H`K!O;aar9y_n1hxgPc3rnet#)5~M6LE-Ljwtnz`j79u4`%_ zPtUbdl#}QF?A+%mC;7ls_?5JOBEoJgSQuv~0vw1F2yqk2 z{Dum;WbXTRqm1Jy^VWnQ65^eSAQA&+!wDq3!C-!)1Z^|FVS*}+z<9tQ*L^EAk>lYY z>9;Dz7#oC%qb#+x9KMKJ+3O4qa%A2ja;ZRg65U!1_apmz zIUIocj-giKOqkNxNP8cXS;laGI6W$q*)ZHY2SJCT!DU|`xM<`J4a#N~M7XiXDG2p$Kq!m?Q{o8Y z-3a0cL%IA4Kc;AK+xG>U;u!z%E=FJxCv@2#jmqp|E%@B>__(7!nK3#Ragx5^|MWp@ zK7Tu|kNP(@iCFtLhxMP`@c-y8qV~@G!>`%u^X#nnKig-%q%U!WQ#$5>#PZT#VWK&i ztZ16@3O0j}?>CUiE1x`*o=Wp>?$}hmzAH5AE`~HDeH9M;GB~$Vv;+0c$74{;?q>J63rbbWFj+o;cOjaNvO{0tm&9$ljiK!wT0vqd{>%x_lK`riNGrVxt^1q^wr9y zf){FLSy2u?uQXe|R-Y%wTFaJyBB$om!Y-!*pdDVJQRk{usc&`WdAMSeqpe$Mt8bHE zY%|Aiv`Am8xLRl#&Q;%mZKrPzu+_Kon184+z~C$}U4|>+sF%u_X;Dsw9v!u3s9>0G z?&}#cRIu?a;WAuIt&{ErO{};YxfsJ6R%dI}VQ?bpt@j-HPgT0)dz29MK4`}hh3#W@ ziQ_Oe9ohBF)hxKH8R`IS+iRISQrf>q1J*;J?dq^O_1!ofS`t?JrRvdgxDDv^2bOXw zZKm-XZDJpslnm;VJKh~u+;jCTf45&6IC`{aV`&epv@hV-oYLFQ=p(O4Z&~$w+EtWo56K zIlqxySfpv;5;RwCO3$^SS@0{{!DJt{$NMjDy6Wj!b5hd zjwChHmVW*gtSqDuQxlsv8QcauIQHzflr(8%gT1wj_^v(1TlS||0 z)OMMsjrrX{sV$@s4AbKos!^)73p~1>W#~25D|t&b1iUb*7dc zUF_1d9^I)G=zQi2mQTWqAf7+h0MZ5_4PTSa_U_A@w7M*RS2t{J3KQ1cuMljRyqde- z7vIHi+%um-(Wj);(fg1A<#X_#uH2YpKm^eMHQ&HGve6)WMX+Gw_0eR4zfuXaLC_e` zjQ?=pf}tUbEQax~#w*>HNruGy!YbA?Wrz*+{c*eu*(44pun_17|sZ%WxD5XdPC%On&2KAL$-AWxgYd~ zpVx`~?TV6Nv#J-PFB6VnP}9lO7QX(BJ)r`m2D=x80~LFqsM1)mryKMSJ>gnuq~rd*+Yv zct}&DEN*hDeOdc>Zn~2pn0tn93WM9^EwH+YhuwO6IBuf45LKg5z|?jK-6YpO+-qVt zB>_m=k7A)1FNn>=%WmFlR5vvrh|3Ye?T_x|c3Zp0Zs_h1F&r=B+u)ceAz&CYya2mc zpV=S`kkjb1*LUz8I3o%#i*ztwPK+MGNYlqrbx=KAvmVaDAYg?(xtE#s4_}L9=Q?(pQqs!OnyH3J0%82Q4BO;Gu}k9(0o0DR&rjO0mO^8WdcLznKXwVfxMd9lsanS&s~X-Hnr znlFZLihh17kE+^^`V84yzG9~IU$)^uF10{>1h4g!R(d28jA(jlIhpx`k1=GBz=oHY z`2&tcWeANtFstmAj8+V_*BA{v2)jePLjm7>pbA5N5=Pe}&6>){svmluH97iGgp#4+3Uo3auNn}IQ&1^zsGB^kiqx3bMRy#guNe+Aw9^7Jw~=hubd%l1S7rEh%dNBbHvWy)V*3@u z+Zl%<5|!}cXXkmcolIvEvv;)7)BqbIYV=r$5z_deQ=(1NJB=2RMltMBf!Lf3@!cUnn6`#CY3r%#av8CQM!XPC4cfZIO+tVmPCo6*8S- z+OZ*HiSVb|o64tU=aCo^=(9sFsDGC6Lp9>LF)H!!Y%O}|&OZ@|-$x5?EzBl4y%8Kt zwa|^u%?>e|hje`(>jP_qXm7^YTG~ZwRJcK6Bn{y3+rN0yo4>I|TWvJP`6wBy#}^2{ z8PoPs^+#$s3DkD}dd1VW186Q2SOLxYz6L=!MFCuqdt5_&)Lwcd(FOFmJhC9XZN}Aq ze-)~9O|s^y&sUl$>=Rki@eMsH0|$K1GK;basftBgHBOfuwP6{dsKblz6zZHEIHa%$ zzo@^~*-hUIbW{IYj?IrW1K{7_H+IP8W!ST2{ub&Zep5=TQ)#8s=_DIsTwiOF_lix^ z*X2|%Nw(Ye3<)$#?kwZ{!Puu=7jzBpTbzf_Gc(|Oy36Y^H<(>l&%DJw*j)BDS8?fy z`Ob*>9uV<9Gw{AP@V>YE4%mG^-Sw3NdUT%yBj}0hmvY|ofDim2FJ}!=9@ziU%W0jU>oga&11k$osA@OQT%g#^PK;tD> zlC}9TYa_~9T*TNBx#yo5x5T{1!Y;EReEBi$E{j2kp4WzohTJ;$#R@+YEcoEWci@>g zXt-IA?KK2PrJ6W)gX0pu7f{OU*&HK~hbfbtnr5xE{W3kLHz#X>H9PL`H%?+>#demP zl8L@l!dRHrmNIB21c+MElwSj1pSQ&&>bXE{r8m}~#)$~{uJIY*P=Z|U~ks0V{ zByx7f(Y%WpSLW9kv2QALVUaD#kWsRvoJ&|8VJrAJ4Y~WTcYBtP>gQw zonN7!%eT#Moh}gNZ04`1kFiwIaM(e_nk+6 zD>33ycTwjdwZ%`a@gsRA<*`?bUrveMRHy4=??rw$T!3GlaaRbd`GpH}Njl4A@j+iw zPuo_b&b8JD;=26T<3jo%N72iNU| zSQlGF=0e!I`ho=aX5EFu7;0>$phd1kKvqLw@Ehj@5wnx+#@Qy5KpQ_CKTF%WzHrkQ zOCeW(slM?GdHrG*v{)Z9m%fXz;Ek*x-IR@*p%krbD!I zm<#i@HPX-iM)eh>fSfN;D1>Psy^xKw3ihV;75H#5R%S!Cw8Q;lNQRz@gV}vUla11> z2=oE`yenKUlf*!(8bE0Vy5aoo=HjGWx1aHaK448_=7^wQ7Hb2J9piR{?My3tN~7I- zpt$_D{I)ZVxP$a7>~r~KFV$~YEwfwbn90$j0+m4VhpDspSW!wDHP!V=DVFCoFY4=C z!Og^UOer;vSY3)ooa0dn{ND_qG4G$=m)>mERkO*MIDaJdcIS2*%E}{Y<1a@#Ic}@w znkI7hj~hUAAJ_RMBVB?pfkMVl2VvXs32a9s_lCHG5bjV2G{=kJNTYnxD5Ww!&W$t) zT`5m1Hsco|J*7^p(cJ}G)LIXBqCF+OFz_C5NhEiv@iF8)Wy~}a4_jIWx#Ga363F&V z3_!rxs$;&AC{9rVE4sA%6PWm2uAg2*e2UOT74&Z{(Ga9GUaQfX;irV^P^q*{Bk zpmO%r8KF(WM&D}Q=FG4mLnl|)FsW2++2jP(rR6zAC+EJ7*1Nm%+I>Y+PtB#FN^sWN zC5kag=ae_K;^tTFsaM^KhaTzLHgB5EtxjL%!^X&WApao8ldcixvw#`rlaE2uBX`@v zR?x|PJpne;ZKjEG45W&s+s0&owijv>O+3^?Kdzo#j z`=T!bo*Yc!{FqpMZ+KLOQ&3XNaDF9c1Kry9iu&B1+|}W)sgoZE zyD#Am^EOo_&KP_%U96d!5Iuvdi}kh`T;7`4KO;QAKBK+SzHe}6e;Hiw?__Tx*%*AY zXso-OC|d3s=UhfQc##k^61 zzV}b^MCglLunPhW#M6z`IS+8s3c?P3SJ$nQ*D^blf@^#H z|LvZdC>xEL5X0viWg9<84bbhye<*I z?;0C?2ApU%TgYs(<;rR2sY`J8&ofkwn!GMo5JKR&B z;h`6-avSd=#L69n!vU4!ioxUYl?bL)P9)?q05th!koEWhpgS0M`|-!1+YJ5E4K7|2 z7Eyy%V_a2(+4u38$;WCL&n?iQvCLK0YAn=efpIRk>J9|P^U^;Z{m7*l}}?nuo+5B_WJw&%HMk+HAeNP%QMS$fsFw~sI@|8svG-v++ZpO^^U8Oz!EqY7cH0vu{#q&xvEnCt_-^Lc z>*VzXTx?|XxVBR`@9h;y7aG(D>~;^(V9K~1y$~OJqJ>(z)fcXtf4FyMDtWq-uPtl3 z$2SrOd>_?L!CXIq zCG+I=x)JtNlFKPo>C^5cw3tGX#Ou%jG2=>xqkIFSmimKS#~JaAZLYUAL^F2@da( zG$OG8P4bTzop?5~&VMgX7Lz(AycedqVqNaL=5lL2=|po=@@!(A;o4ShXHLR)wr5Nn ztxcLnyGG}B-RU?^ug*ZB#2jsvU0;#^9Kp>dv~}2pLn2{#(U*6<@l4N*78SPGR>ko4 zXMbLgU!b(2cCnNHT9CzoL(r#6uNej6r9<-^Q578yrvMscp5xo@>u+;mm(-FM1s@=j zIUVBxyw8(w7wa1AjD5t?u%w&1K>^Q*^(u=eOrsTA^u`#hdGwf5iyZc5nx1_))t@9T)|h9FIPyuuPY~C ztF3lLO*JL!1((fIQBRv+6VJvUJi%-3&*;zA2{}7cYXpSHA7OO%Ph0YM3ZV3S5;os+ z=>*u3LgmEfG{@e!*0yeOI857OaUVTIYDb9aMv3VLi0MX%Ri5?_XM{bqer`DS6=5vm zD0$2CUiqj4Lu4mB%FKkA43B)kLnN-OVrY<6>UMkOFF_9kh!;*a9_klyleK z0rhsM!k1|a-o1G!db_C?Ydz@9?pmK~B}texgItNLfzscLFI9X9oW7rb$}bmWOH3pB z?c&ylw`|L0IBo@&qKmfE*u2f1t7Zd@r)fgQv&AWjwpXVqvlDZlp!8ILud#8!*;!a8 z2Bs-Qr!t~ z)cpS`Dz`N)Xra5FCcXw|%l8ooVQT6UtsQ660@QL(l|{2w3TpCWTjWUAk)}iwE-jpT*w*@XZYF6_1Y$%7Xp-E}E51@nuDKuxBNmKzK2G7|apqS%TN>ii#~=eOwQ zE00=?@j|Zpzw{VzhctrTVS+^p%!ZeXF~dl?1l7_f)NYnLf*&LoTvGW?Y?m1$Sc0MB z%#?h+-WP6rntqlyw~b*kQbkm7?#z*yoFBo5 z`Nh?zkBiGRL#3P)$h-sXNIFitI-9bO(Q~YNiuS9A%U)*^MD6Xp_Hpw8 zW9)`Aa#Mh3j0TXyj1NhtJea_I?Mx3*>j#cv=?;vk-2hX$DvdOjZtOnIZ4UQYVL$K? z=uU-l0#Blt*Au#N+S!6R2Y?6Qlfk${T5dkHNaD#yHr9h{Ms84Rx06`kO}E?J++6W4 z!vG!aUV3;<{r0qsLn+_=)tUybe0(0i;1TW}B3%J@xCDA{#Ep_=^l_sH?LFZMrS+kr zukFNnK`-|V!bb|-+4~fsU+lg7LyYXb;wE0uv|QBiTv>Pc?bmVpykRvf3`=&Y)n_+4 z4)txnFViJkxw4vP0X)*s>bcRUD7nldv8?FL&IOieJiIISQy5U_@M<$a`!+T3YP5^g znIc5m=t$`N_3be=M90>0^-JDlsHZu?g{?gKPXmSGY!_gvQB_qM-69 z(6`%8rp>B1lERx#@|1DpO!Iwm-Nc^gP_mZ+qjHx9*+=0Mr_p11_{$YYJYVsygSL

2JabCDtwqP)0@gqrRzP>$?WTB7X{-hIndHMBd7#cd=6b|#) zC^gcFyW`K%uVdJa9UMt>My{*3gMCZd^zeImnY3l0AYTJ>*H< zLHvc<%3gdt5N>0OK2_465&)ACNoR%s(Pu($!GRtsawAVQN_AjmA{kxGbuJTgZ3 z73;vJ6D%P>?li}cmdb$UTrG)Gez0a#4J;02g|a&5)@B}E+zAJy_-Q&}Ol3@X1gplI}rsUUlQmmxqTcjw6O2?j?E#>4}wsU?+dv*X);E#mWQsJ2MY$XrhAUDc26wBZgU$jU0}CN4d?#0qbF5(neVry;4%u z((O&>)+iRMs9dHQ$X@3_P13--4kkDCCh~FA4`_@g@*#zRE$@Wn1@j9NyMS=cJzn{C z)RKP~h@lFBH#97!D&o2agK(T~C1K;ekl5)~iKN@8U0abZEufjhD16BJCNP^|yV=eKS(R>*uD(@f&n z-WwumYcxk2_ewNp*R>$dA#2k#i>x#Qk89(_rSeL$I4De)T$of}6Uug7nMnK0aMY-0FE7Mp z8zjYP`^REz*!3{%XUX`fg~wx$?zmWfxl~+b?fGA=9%H-6zh>d2R<)f3cH9SwZ)Q8WaSqiyzIQCsOeEtcs5;n?S4p3o$4 z3KY#oN>F2^4)+numChkD)|TY6b_|kVPbTIcQ7nv8o^7qCXy$D-CW$V6#7v%KIK+Qs zp~b2R(EFr>R25_O3lRh#ovHDkUsR!K%uddvYwS9v`$OD837h&BhT{?Hr8Szp&?j(8?aq@-GV{8^h8G- z(@vI`JR|~v)$d@&auhRMYaSdAh`01^9SN^dsybJgZWaU;(VB}qPVCxDA{k^{n zjm&keky```g9j#j?pO>Zc1Zbm8eqEDMr8ot7C64vUT_foMNZ8vQKt}%tr@)(Ca)c; zBXucN1s)pYFWGEWhD=O zPtdYTU{~;^3!3))5n}0#=(Y;NLVutF$9_Qv9bPr$5SkMkvSuG4MW-wQ7@9HefFa`W zR*F~D0rzKRLcecLWsmB`ZJ(`)T0DAOpWbL)97fBU&!dgf#9|Q&nucoa3xrRp{2-)FVT*nl#NE?vM)A zw3@39tIC%nlH6;(m*ywr2yl(Y%@Es<>bfYl)SsJ$>;6M)z2#7@(*YhqI992-zFbr4Yu><6kh(|2~c_le`OxO zlxIjD?6n{(sxGc_zbT!BLbl5MVs)r1T);z>s-Noldk2_#Ko7Ccejg_;aW9V|#+N8=l#K{^YI`)gBEJ+hl&fVmQSEUf)W>sAC+y(lqNWXV5(SY&=;`6iIvB zSzO~dra+ebG#qrR&~i06+Tkys^a-rs6>#ZfyJ^mxwB?j5wt}L%s`yWHq+qCR_!;pQ zif$fT{b!^i$P2Y$nH)yUjnMSx<{o&m`TE2o`L-C;EfzmzEb_EBmfaay#IsF#E8YBq9&*V5SEX!&dZQ z)gJym%nt;nZaVpNwE;WjDXUmd5v-B;DV*AsWfzZ_dw?Oc(qxh(m)3Ds~7#p$!*+TbF3g{!_A=cThQ zzY0xf!ctq2y~Y$chKU)lz8)#->%(5ZFRcNMtr%2P60sPsBj`d8%k4Lz^8&*SanU;` zn$uTxaRkdx>_znRnJ#nd(&xt-^XZW0X_&?AI?`Hq&TJoeo;8UR@nWKjJSksfHGl%m zy&&?wQTCur)=7ju4J}i#F;jUul=MnyfD|Vpb;qr<)NH~hDw;gI1SYcwMD}8sA6&!nlHHG&_(%54!_6Egs(&5)c)6B{9 zZp8^}1v;eHV&I-hECVXS^-{|G>6e7pq8j@NTK1n4Mx2WDK-$%ZgbLzP;YnNLPVuKm zQ>Ka*;EK6Bf08_rqz5EH+iFhFyFgCJRf_|uXD8{6C06>P9$n7R(+rK^#x5}$V%J@1 z6P2Z_d}F9O5ps^~mI=VHXa48@`?P~}8QR3er7IvCy`OwY49%Wp5-I^kDT z7RlLvg18h*k61FqEx2WA&s6*kc~WAFR>&xpwhpKnvPYD?NfH$Ef|dHZyYrufL0Es* zK=TKCq@D18OBfLSKlXnA-HYz{U%NmxY1=h1WZi@Pz^Hh(FG%#?^zjMnWhC3^J*-eM zCD!6&(d=T&>PXaB@CA$=3N!`Fiop19wQt4IGg3CllM?92cqG={eQqYs9PTcCeP1WA zUZVLCR&4IgWB50X51KSd+V_3K3;| zi~i&hNCqWL-imLRH|}M!5ty4`q2#zSzV>a8m7&x`A$^($7Rf9JYr08UiOAs}b}Sy<*q@vn+C4(LP2@|F%zP-wN{7f@0&- zLha&c&*!C%#N6%33_ItJP?>$W6i(BLpjNQZ?tBe7D&){IO~;waF$*0mX+d&u`Xb=Z z`b(7@wq3e;nH!2MJ@Ygu4NydApBT^y61^`Bu>+!mCzcSQ^HLZY4Wc1|cTxbD)p1K9 zo8){PI(R)pEd0QGk`!2*Ic+!>@aEgx=d`BJ4Gh6W0Er$&NS#`4dJM!(wqkAI*RPnH+Rlf;Su!%74h)Xh-pW6n*HMApn9;uo5?J(2w-# z+c3Az(=RJpmwSgYIZicp85K7@dl(YmTeb8?nD;AO`}wnj*9lYs@{L|_caBHPv#l|% zVDxkK{$oF{u+hC-wpeI#f?F#fyU%JIT7-Dag2G+ql5CC;lh|LISrnAe$j2DLMwoYO zSk{ksj#u_*=QMjoD0}(-&giBcl`z;GGj5m?_=E`gvgDMN4Mp_(nLerp3$#}ugbZX* zxkhpWT0UneIGmnVH4P9 z+pS?Y(%2JPsj@b=u&?l;TQ&Tp5DSeoeS5*1im<}+Ksg~KgzbfVIhC}Ilf5Q z?AsbQp|OgOq1@Ze!$ymFj3b6mD&8g|du0k0t!U-yu=d*y;nKWu4j1VJh*<09HMHo? zy;-{~wEkKw1r%Hn16e~mq2<+Y+Rmaf0)0u}FmT;@ASnM{!|w(QoFeuLA$p2ijNI^k zql9}S3X$J_A%G$5c@TD3dnf!Wt=0mA%8c*<_t-`J- z7HXU4VNnV`3klPNua*`!IG^vXPE;^7H)v8zz29t(jqRBrU&~&2O!`jpKhQn!Uk!A$ zf#4O1J=v3RJXV8nN;u}RaY{PYVRivYF`L}3qy^d5PX@#Ue=lbn#NYDIu2W2y3Xa$& z9Uw9`KB9D2v8_|zRInW1?J^*&8Fy|(w6U*~_6ab$m>(tWRCzaJ@^&=K_r0=gk>5bI zyM5~uW_gc7>Kf?7A-Do4oZas-3--Ec_o3qW91g?_%mW@~e+%^~eSNPFHp}-_O+Ea* z?yf85n{XgM`&(o3Hzsz+_CUmJ*WM6UJKY2=j_#ci;v0=w*FsF!&Lzuh2;2KSF!i zGL#~5AuCYjBR4SvZ$fPB>F2+z)^znLtHeL#kymvWGpXxW@u57y{1yz z4|s%;`{b_%N_;3*7rHfMiK&?6+$eJ;7q<>UvFsHM8lneNvf^tD$@u4NSnZGBa_T7p z946y#jBJjn8!FI#9qAIc70n|qMQl2Nd|X>EH}X0E*nkXDU`I&#fiRX=Vy?xL7+2>~ zpp@&0G3bb6?8%N^I@y>}!^W8rPMHX^I;x)5`&e$?w`2}*+Z{KisbC_9lU7o?d2(D! z98&E+nTTeAN|KXyaw!T*VcN{+=5xXepvo*4j1MouEZi+*b}%eaX4&Vea&BI=e)d!q zRf4&uk1A@Ng=&g#=>JJ%MMFWSsYb^?x0jh9`ykwt2O2tSxV`T(uo@TUVn4Qjh2|+Q zuDwV}K=PPfF&Q~HKp}3*KgYx(+dn;H!HLS#fC| zTjBk#3d+!OBhs>>U7hgBy?7=E+<7o|t??uBEe5!GFaUV7Jas>(eb|gQ#)EhS2D{Klg9-UI zX9xf$k>NV?k{yQUJ?2aX)gu05amOP<`0qWGvtFfuu1A?68tr@|>fP~e4aLOhjz>aN zRY+~z2kYt^d%vS*`5y8oTBUM#D~^3wvS2*p?ug*(@{g&pVo*ocLrXo9I>OQ-6H?Q{ zATk;;;?xP6T|Yi2y39_ULNI=Z>Bsl-TbiWG z^-@6Nl+C2d7_U?Xdd+Lzc&K`2bqOD9nZdp1CVye+u+)umJm=$i#!W zR5Mvbsi*{S2_#yqRAeVF9Sa@?)zq&Gkxo2~xvcmylmRkI&Neg3OfAamL@C9nyCXb4 zG{N{{%L3^@L$844+4M3m9)|dtef2y5RP$FgpJ}10UZjxqGIvoD0FTZ-bycNPy7)tJ zNx@QyR~5~)N)An&WDOhW1%8dX7Gyox-LOCnSat*g~HTjrdh1U zb&-(t7A-u4A0wGp<2i-wdNs;i3;Fyg8XE~Y@p0YU%uI&Gb3>?f?&omYZnmKQ9YOxm ztcw`FLOeU`6WJc*FDv8@T#-wXLxq$e1Xm1NR5W-vjF4}~K6C|FM3j1zV+`(k-=uS?qH6EgfSDlfc zd%oeUr{MoONs5;P{+mrv~rM%i}^Cas-Rv-l=m$_8V<*-pj(G4C{H^ z=|_wEOeT%MzWkn9EL2{>wjGo#@|4gSU=lXci272-{)?Cgld3@$A6Q!7T#Nf zt}22ec));qHxCems%$@wgjy^!!FZs{oEYdVZQXu$&IMT+D}|e|mqWUCA#qi>Lv+i) zQNantS@+naV@$-&wuh@KqvwEMCjTH1sbs~PH zio0%W8Spid9lSXQHf(|?1%g-K5bF6`tqF){;HNgHh) zp@3MFK(Zq)0}yperU(y=0$SMu+NZi2Bu9P1i~dZp0{Kzp)P>F7@8o_z@$gp>=)E}o zJJ1wOEcHyJv3NzkHWP}&hf@(zO-szDP!%{fV)qSLWT1 zbRA8Roi`m#VHH8tb4pCNNED3R2u=l^*F~!Dx1*5i2`gAxeLzNoY@L zxsjE^^h-SDNoH(^Xx`-XUkP>L4yru++J;)><{F};(`wJmGuXesdY8z02a0BxDViBI z2f}X+;6xCUDXu`d(CdXmp$)&qrFpt{82 z=NxjZHEK9YGm@`dJ=n8LOgg{0Sar0&Tk$WJA{E}+VH_{TzP&Wwwy2s%E65%=MykYadY{4Lf6OP1zmmgYxQuzJ_gfkb96Swqndld?ku_RKsGf5V-G?oW;E+a>L z2jTL7RIuG5`zXb|nR)y>z5^F0>h)Rm3a7Zs!g;GC2T2>>IVyia<{cI`^&Ottkgt(< zl$jvNt-bZ{aTDK|6i&P$#-8%UjbdT1UCO>z40+>CCma6zB3xKyEwEiphbOhX-fG7mnHD#HAxjJ;bLY1P-sBY*pRL5)&NH4ss`9xggs85K+AN3k9v6zc zpj^F4Vk*laBCMBZayRA?2xBf5qXC+3;jwN$YC8|r^weo?w*s0Qg76%gx-ASHe8}Lf zktU(sZh;IE0%U&5i7x5f>F^NlnXh3{tQEEHMQP9Nx#d_v+WZ-lx0~j^2U-X%r3hAW z-BR;$3!xYykW4*UfwYtw%q?WlGpWk|!7Y=YZ|h|o$MXo5km=An5c_eNOAX|Lk!cp# zZ{=QZc=c6QK%t_0Q~J*BxHMCgU+{DCOh`QDeKDzwYk5v!$^47*_l|T0UK$c_t_rA_w3S^tT1hrsZBeiE z^v-E|Vx6W_3}wd}ky_!IVja^p}~ z%@)an%=@%JPV<0{&(x*te!X53Z5(05rntdhTKF!bf=nHI%regzURW4RAmSs>6n@hv zF(lA%W()@aR1i&zwb`f{4`>l0ej$zhB9#0Uq9XHX3jpZ!)N{Co*~CYK}h$Q|-A0l^AWSp~6>YnYF`_ z$6o0y8$yKf0l*wr0?*Z;YkK9%0VvAxp$&^~%IPK|(?_X-7%Ht zz~Sm?tOIx-iBt>D7>*IMPAX$dy4^{hKJ>-^?0v?S^fv3@K|sbnwm09TLBY^K{^|Jq z0UQ0l@t5QCKjXhGod5EF{`XV=^kDuANBVd0e;oezQ~z*({VGKwldAb|nLo>8{wZUw_D`9A)KUFg=Fd#) zU$r!UM~23qGJjUq{9EJClmgM;0v|^yX8%*;-x=C}tNr;U{paMnwf>)Kestring obj))) - (mutex-lock! mutex) - (cond-expand - (android (lnjscheme-invoke/s2s req)) - (else (error "lnjscheme-call: not availible on platform" (system-platform)))))) - (r0 (begin - (mutex-unlock! mutex) - (if (string? s) - (call-with-input-string s - (lambda (port) - (let* ((key (read port)) - (value (read port))) - (case key - ((D) value) - ((E) (raise value)) - (else (error "lnjscheme-call: unexpected reply " s)))))) - (error "lnjscheme-call: unexpected reply " s))))) - (cond - ;; Numbers are always printed as inexacts by jscheme. - ((integer? r0) (inexact->exact r0)) - (else r0)))) - lnjscheme-call)) - -(define LNjScheme-result #f) - -(define lnjscheme-future - ;; Not sure that we need a mutex here. But what if the java side - ;; manages to call into gambit? - (let ((mutex (make-mutex 'LNjScheme))) - (define jscheme-send - (c-lambda (char-string) void " -#ifdef ANDROID -extern void lnjscheme_eval_send(const char *); -lnjscheme_eval_send(___arg1); -#endif -")) - (define jscheme-receive - (c-lambda () char-string " -#ifdef ANDROID -extern const char *lnjscheme_eval_receive_result(); -#endif -___result= -#ifdef ANDROID -(char*) lnjscheme_eval_receive_result(); -#else -NULL; -#endif -")) - (define (noresult) #f) - (define (reset!) (set! LNjScheme-result noresult)) - (define (jscheme-call obj) - (cond-expand - (android) - (else (error "jscheme-call: not availible on platform" (system-platform)))) - (mutex-lock! mutex) - (let ((resm (make-mutex obj))) - (mutex-lock! resm) - (set! LNjScheme-result - (lambda () - (reset!) - (mutex-specific-set! resm (jscheme-receive)) - (mutex-unlock! mutex) - (mutex-unlock! resm))) - (jscheme-send (object->string obj)) - (delay - (let* ((s (begin - (mutex-lock! resm #f #f) - (mutex-specific resm))) - (r0 (begin - (if (string? s) - (call-with-input-string - s - (lambda (port) - (let* ((key (read port)) - (value - (with-exception-catcher - (lambda (exn) (raise (string-append "jscheme-call: unreadable result: " s))) - (lambda () (read port))))) - (case key - ((D) value) - ((E) (raise value)) - (else (error "jscheme-call: unexpected reply " s)))))) - (error "jscheme-call: unexpected reply " s))))) - (cond - ;; Numbers are always printed as inexacts by jscheme. - ((integer? r0) (inexact->exact r0)) - (else r0)))))) - (reset!) - jscheme-call)) diff --git a/apps/DemoAndroidLNjScheme/lnjstest.scm b/apps/DemoAndroidLNjScheme/lnjstest.scm index e804c6d7..efbc0c54 100644 --- a/apps/DemoAndroidLNjScheme/lnjstest.scm +++ b/apps/DemoAndroidLNjScheme/lnjstest.scm @@ -2,71 +2,8 @@ ;; Try this to find out how where methods are defined: ;; -;; (method "checkOrRequestPermission" (android-app-class) "java.lang.String") +(procedure? (method "checkOrRequestPermission" (android-app-class) "java.lang.String")) ;; Just to see an error: ;; -;; (error "nananana") - -(let* ((app (android-app-class)) - (this ((method "me" app))) - (ln-mglview (method "LNmGLView" app)) ;; deprecated - (trigger-redraw! (let ((run (method "LNtriggerRedraw" app))) - (lambda () (run this)))) - ) - (let ( - (main-layout (new "android.widget.LinearLayout" this)) - (tv (new "android.widget.TextView" this)) - (button (new "android.widget.Button" this)) - ;; - (getApplicationContext (method "getApplicationContext" app)) - (getWindow (method "getWindow" app)) - (getParent (method "getParent" "android.view.View")) - (removeView! (method "removeView" "android.view.ViewGroup" "android.view.View")) - (setText (method "setText" "android.widget.TextView" "java.lang.CharSequence")) - (addView! (method "addView" "android.view.ViewGroup" "android.view.View")) - (addView/params! (method "addView" "android.view.ViewGroup" "android.view.View" - "android.view.ViewGroup$LayoutParams")) - (setContentView (method "setContentView" app "android.view.View")) - (addContentView (method "addContentView" app "android.view.View" "android.view.ViewGroup$LayoutParams")) - (setOrientation (method "setOrientation" "android.widget.LinearLayout" "int")) - ;; - (onclick-set! (method "LNjScheme_Set_OnClickListener" app "android.view.View" "java.lang.Object")) - (checkOrRequestPermission (method "checkOrRequestPermission" app "java.lang.String")) - ) - (define (set-layout-vertical! x) - (setOrientation x (intValue 1))) - (define (arrange-in-order! parent childs) - (for-each (lambda (v) (addView! parent v)) childs)) - (set-layout-vertical! main-layout) - (setText button (new "java.lang.String" "Back")) - (setText tv (new "java.lang.String" "Hallo kleine Welt!")) - (let* ((ln-glview (ln-mglview this))) - (define (switch-back-to-ln! v) - (removeView! (getParent ln-glview) ln-glview) - (setContentView this ln-glview) - (trigger-redraw!)) - (onclick-set! this button switch-back-to-ln!) - (removeView! (getParent ln-glview) ln-glview) - (let ((frame (new "android.widget.LinearLayout" this)) - (wv (new "android.webkit.WebView" (getApplicationContext this))) - (frame2 (new "android.widget.LinearLayout" this))) - (set-layout-vertical! frame) - (addView/params! frame2 ln-glview (new "android.view.ViewGroup$LayoutParams" (intValue -1) (intValue 280))) - (arrange-in-order! main-layout (list frame)) - (arrange-in-order! frame (list frame2 tv button wv)) - (if (checkOrRequestPermission this (new "java.lang.String" "android.permission.INTERNET")) - (begin - (setText tv (new "java.lang.String" "Hallo World!")) - ((method "loadUrl" "android.webkit.WebView" "java.lang.String") wv (new "java.lang.String" "http://www.lambdanative.org"))) - (setText tv (new "java.lang.String" "I'm sorry, there are no permissions to dispaly the URL."))) - ) - (let ((wrap_content (intValue -2)) ;; #xfffffffe - (fill_parent (intValue -1)) ;; #xffffffff - ) - (addContentView - this main-layout - (new "android.view.ViewGroup$LayoutParams" fill_parent wrap_content))) - ;; Finally trigger redraw. - (trigger-redraw!) - ln-glview))) +(error "nananana") diff --git a/apps/DemoAndroidLNjScheme/main.scm b/apps/DemoAndroidLNjScheme/main.scm index 7f73c1f0..2cea633d 100644 --- a/apps/DemoAndroidLNjScheme/main.scm +++ b/apps/DemoAndroidLNjScheme/main.scm @@ -12,61 +12,53 @@ ) (else)) -(define test-file-name "lnjstest.scm") -(define test-path-name (string-append (system-directory) (system-pathseparator) test-file-name)) - -(include "lnjscheme.scm") - -(define (exception-->printable exc) - (if (os-exception? exc) - (list 'OS-EXCEPTION (os-exception-procedure exc) - (os-exception-arguments exc) - (os-exception-code exc) - (err-code->string (os-exception-code exc)) - (os-exception-message exc)) - exc)) - (define (try-LNjScheme) - (cond-expand - (android - (define (evl expr) (force (lnjscheme-future expr)))) - (else (define evl eval))) - (define exprs '()) (define (try-expr expr) (display "Input:\n") (pretty-print expr) - (newline) + (let ((result (lnjscheme-eval expr))) + (display "Result: ") + (pretty-print result))) + (define (try-exprs exprs) (with-exception-catcher (lambda (exn) (display "EXN: ") - (display (exception-->printable exn)) + (display-exception exn) (newline)) - (lambda () - (let ((result (evl expr))) - (display "Result: ") - (write result) - (newline))))) - ;; Important: We need to return from the button's action - ;; immediately, hence running the actual change in background - ;; thread. - (thread-start! - (make-thread - (lambda () - (try-expr `(define (android-app-class) ,(android-app-class))) - (let ((fn test-path-name)) - (if (file-exists? fn) (set! exprs (call-with-input-file fn read-all)) (set! exprs (list "failed to find" fn))) - (dbset - 'testresults - (with-output-to-string (lambda () (for-each try-expr exprs)))))) - 'LNjScheme-worker)) + (lambda () (for-each try-expr (force exprs))))) + (define (file-result fn) + (with-output-to-string + (lambda () + (try-exprs + (delay + (let ((exprs (call-with-input-file fn read-all))) ;; 1st read them all + ;; FIXME: Do we need this here? + (set! exprs (cons `(define (android-app-class) ,(android-app-class)) exprs)) + exprs)))))) + (define (try-file! fn) + (thread-start! (make-thread (lambda () (dbset 'testresults (file-result fn))) fn))) + (let ((fn test-path-name)) + ;; Important: We must return from the button's action immediately, + ;; hence running the actual change in background thread. + (if (file-exists? fn) + (try-file! fn) + (dbset 'testresults (string-append "failed to find file: " fn)))) #f) +(define test-file-name "lnjstest.scm") +(define test-path-name (string-append (system-directory) (system-pathseparator) test-file-name)) + (define (make-uiforms) `( (main "LNjScheme" #f #f + (button + text "Try Webview" action + ,(lambda () + (webview-launch! "http://www.lambdanative.org" via: 'webview) + #f)) (spacer) (label text ,(string-append "Push Button to load '" test-path-name "'")) (spacer) @@ -111,9 +103,6 @@ (##thread-heartbeat!) (thread-yield!) (cond - ;; EVENT #126: retrieve and dispatch LNjScheme result. - ;; TBD: move this out of the application into LN core. - ((eq? t 126) (LNjScheme-result)) ((= t EVENT_KEYPRESS) (if (= x EVENT_KEYESCAPE) (terminate))) (else (glgui-event gui t x y)))) ;; termination diff --git a/modules/webview/ANDROID_application_attributes b/modules/webview/ANDROID_application_attributes new file mode 100644 index 00000000..a766aa5a --- /dev/null +++ b/modules/webview/ANDROID_application_attributes @@ -0,0 +1 @@ +android:usesCleartextTraffic="true" diff --git a/modules/webview/ANDROID_java_additions b/modules/webview/ANDROID_java_additions new file mode 100644 index 00000000..b3950fd2 --- /dev/null +++ b/modules/webview/ANDROID_java_additions @@ -0,0 +1,158 @@ +/* webview -*- mode: java; c-basic-offset: 2; -*- */ +class SchemeWebView extends android.webkit.WebView { + + LNjScheme.Scheme interpreter = null; + SchemeWebViewClient client = null; + + public void ln_log(String msg) { + interpreter.eval(LNjScheme.Scheme.list(LNjScheme.Scheme.sym("log-message"), msg.toCharArray())); + } + + private Object iapply(Object fn, Object arg1, Object args) { + return interpreter.eval(LNjScheme.Scheme.cons(fn, LNjScheme.Scheme.cons(arg1, args))); + } + + private Object iapply(Object fn, Object arg1) { return iapply(fn, arg1, null); } + + class SchemeWebViewClient extends android.webkit.WebViewClient { + + public Object onloadresource = null; + public Object onpagefinished = null; + public Object onpagecomplete = null; + + // LNjScheme.Scheme interpreter = null; + /* + SchemeWebViewClient(LNjScheme.Scheme interp) { + interpreter = interp; + } + */ + public Object eval(Object expr) { return interpreter.eval(expr); } + + public void onLoadResource(final android.webkit.WebView view, final String url) { + Object fn = onloadresource; + if(fn!=null) { iapply(fn, view, LNjScheme.Scheme.list(url.toCharArray())); } + } + + public void onPageFinished(final android.webkit.WebView view, final String url) { + Object fn = onpagefinished; + if(fn!=null) { iapply(fn, view, LNjScheme.Scheme.list(url.toCharArray())); } + @IF_ANDROIDAPI_GT_22@ + if(onpagecomplete!=null) { + view.postVisualStateCallback + (0, + new android.webkit.WebView.VisualStateCallback() { + public void onComplete(long requestId) { + interpreter.eval + (LNjScheme.Scheme.cons + (onpagecomplete, + (LNjScheme.Scheme.list (view, url.toCharArray())))); + }}); + } + /* end of IF_ANDROIDAPI_GT_22 */ + } + + public boolean shouldOverrideUrlLoading(final android.webkit.WebView view, String url) { + return false; + } + + //* These suppress the "favicon.ico" request + @Override + public android.webkit.WebResourceResponse shouldInterceptRequest(android.webkit.WebView view, String url) { + if(url.toLowerCase().contains("/favicon.ico")) { + return new android.webkit.WebResourceResponse("image/png", null, null); + } + return null; + } + + @IF_ANDROIDAPI_GT_22@ + @Override + public android.webkit.WebResourceResponse shouldInterceptRequest(android.webkit.WebView view, android.webkit.WebResourceRequest request) { + if(!request.isForMainFrame() && request.getUrl().getPath().endsWith("/favicon.ico")) { + return new android.webkit.WebResourceResponse("image/png", null, null); + } + return null; + } + /* end of IF_ANDROIDAPI_GT_22 */ + // end of suppressing the "favicon.ico" request */ + } + + public SchemeWebView(android.content.Context context, LNjScheme.Scheme interp) { + super(context); + interpreter = interp; + client = new SchemeWebViewClient(); + String http_proxy=java.lang.System.getenv("http_proxy"); + String https_proxy=java.lang.System.getenv("https_proxy"); + if(http_proxy!=null || https_proxy!=null) { + try { + ln_log("webview setting proxy to " + http_proxy /* + " and " + https_proxy*/); + int i = http_proxy.indexOf(':', 7); + String host = http_proxy.substring(7, i); + int port = Integer.parseInt(http_proxy.substring(i+1, http_proxy.length())); + if(!ProxySettings.setProxy(context, host, port)) { + ln_log("webview setting proxy FAILED"); + } + /* + androidx.webkit.ProxyConfig.Builder pcb = new androidx.webkit.ProxyConfig.Builder(); + if(http_proxy!=null) { pcb.addProxyRule(http_proxy); } + if(https_proxy!=null) { pcb.addProxyRule(https_proxy); } + // pcb.addDirect(); // if desired as fallback + */ + } catch (Exception e) { + ln_log("Setting proxy failed: " + e); + } + } + setWebViewClient(client); + } + + public Object SchemeSetProxy(Object args) { + return true; //NYI + } + + public Object apply(LNjScheme.Scheme interpreter, Object args) { + Object key0 = LNjScheme.Scheme.first(args); + String key = null; + if(key0 instanceof String) { key = (String)key0; } + if(key == null) { + return LNjScheme.Scheme.error("webview: dispatch key missing"); + } else if( key == "load" ) { + setVisibility(android.view.View.VISIBLE); + Object a1 = LNjScheme.Scheme.second(args); + if(a1 instanceof char[]) { loadUrl(new String((char[])a1)); return true; } + else { return LNjScheme.Scheme.error("webview: not a URL " + a1); } + } else if( key == "redraw" ) { + ln_log("webview redraw"); + setVisibility(android.view.View.VISIBLE); //onResume();// onDraw(); // that might have to be something else! + onPause(); + onResume(); + return true; + } else if( key == "setproxy" ) { + return SchemeSetProxy(LNjScheme.Scheme.rest(args)); + } else if( key == "onloadresource" ) { + client.onloadresource = LNjScheme.Scheme.second(args); + return true; + } else if( key=="onpagecomplete" ) { + client.onpagecomplete = LNjScheme.Scheme.second(args); + return true; + } else if( key=="onpagefinished" ) { + client.onpagefinished = LNjScheme.Scheme.second(args); + return true; + } else { + return LNjScheme.Scheme.error("webview: unknown key: " + key); + } + } + + private static LNMethod lnmethod = new LNMethod("webview!") { + public Object apply(LNjScheme.Scheme interpreter, Object args) { + if(args instanceof LNjScheme.Pair) { + Object a1 = LNjScheme.Scheme.first(args); + if(a1 instanceof SchemeWebView) { + SchemeWebView obj = (SchemeWebView)a1; + return obj.apply(obj.interpreter, LNjScheme.Scheme.rest(args)); + } else { + return LNjScheme.Scheme.error("webview: not a webview " + a1); + } + } else { return LNjScheme.Scheme.error("webview: mising arguments"); } + }}; + + public static LNMethod proc() { return lnmethod; } +} diff --git a/modules/webview/ANDROID_java_oncreate b/modules/webview/ANDROID_java_oncreate new file mode 100644 index 00000000..de2f2683 --- /dev/null +++ b/modules/webview/ANDROID_java_oncreate @@ -0,0 +1,42 @@ +LNjSchemeEvaluate + (LNjScheme.Scheme.cons + (LNjScheme.Scheme.sym("define"), + LNjScheme.Scheme.list + (LNjScheme.Scheme.sym("webview!"), SchemeWebView.proc()))); + +LNjSchemeEvaluate + (LNjScheme.Scheme.cons + (LNjScheme.Scheme.sym("define"), + LNjScheme.Scheme.list + (LNjScheme.Scheme.sym("make-webview"), + new LNMethod("make-webview") { + public Object apply(LNjScheme.Scheme interpreter, Object args) { + if(args instanceof LNjScheme.Pair) { + Object a1 = null; + a1 = LNjScheme.Scheme.first(args); + if(a1 instanceof android.content.Context) { + return new SchemeWebView((android.content.Context)a1, LNjSchemeSession); + } + } + return LNjScheme.Scheme.error("make-webview" + args); + }} + ))); + +LNjSchemeEvaluate +// Dummy + (LNjScheme.Scheme.cons + (LNjScheme.Scheme.sym("define"), + LNjScheme.Scheme.list + (LNjScheme.Scheme.sym("webview-set-proxy!"), LNjScheme.Scheme.sym("list")))); + +/* + (lnjscheme-eval + `(let ((String (lambda (x) (new "java.lang.String" x))) + (setProperty (method "setProperty" "java.lang.System" "java.lang.String" "java.lang.String"))) + (let ((host (String ,(if (= v 0) "" "127.0.0.1"))) + (port (String ,(if (= v 0) "" (number->string v))))) + (setProperty (String "http.ProxyHost") host) + (setProperty (String "http.ProxyPort") port) + (setProperty (String "https.ProxyHost") host) + (setProperty (String "https.ProxyPort") port)))) +*/ diff --git a/modules/webview/ANDROID_java_public_ProxySettings b/modules/webview/ANDROID_java_public_ProxySettings new file mode 100644 index 00000000..79e28945 --- /dev/null +++ b/modules/webview/ANDROID_java_public_ProxySettings @@ -0,0 +1,187 @@ +/* webview ProxySettings -*- mode: java; c-basic-offset: 2; -*- */ + +import android.annotation.TargetApi; +import android.content.Context; +import android.content.Intent; +import android.net.Proxy; +import android.os.Build; +import android.os.Parcelable; +import android.util.ArrayMap; +//import org.apache.http.HttpHost; + +import java.lang.reflect.Constructor; +import java.lang.reflect.Field; +import java.lang.reflect.InvocationTargetException; +import java.lang.reflect.Method; + +/** + * Utility class for setting WebKit proxy used by Android WebView + */ +@SuppressWarnings({"unchecked", "ConstantConditions"}) +public class ProxySettings { + + private static final String TAG = "ProxySettings"; + public static final String LOG_TAG = TAG; + + static final int PROXY_CHANGED = 193; + + private static Object getDeclaredField(Object obj, String name) throws + SecurityException, NoSuchFieldException, + IllegalArgumentException, IllegalAccessException { + Field f = obj.getClass().getDeclaredField(name); + f.setAccessible(true); + // System.out.println(obj.getClass().getName() + "." + name + " = "+ + // out); + return f.get(obj); + } + + public static Object getRequestQueue(Context ctx) throws Exception { + Object ret = null; + Class networkClass = Class.forName("android.webkit.Network"); + if (networkClass != null) { + Object networkObj = invokeMethod(networkClass, "getInstance", new Object[]{ctx}, + Context.class); + if (networkObj != null) { + ret = getDeclaredField(networkObj, "mRequestQueue"); + } + } + return ret; + } + + private static Object invokeMethod(Object object, String methodName, Object[] params, + Class... types) throws Exception { + Object out = null; + Class c = object instanceof Class ? (Class) object : object.getClass(); + if (types != null) { + Method method = c.getMethod(methodName, types); + out = method.invoke(object, params); + } else { + Method method = c.getMethod(methodName); + out = method.invoke(object); + } + // System.out.println(object.getClass().getName() + "." + methodName + + // "() = "+ out); + return out; + } + + public static void resetProxy(Context ctx) throws Exception { + Object requestQueueObject = getRequestQueue(ctx); + if (requestQueueObject != null) { + setDeclaredField(requestQueueObject, "mProxyHost", null); + } + } + + private static void setDeclaredField(Object obj, String name, Object value) + throws SecurityException, NoSuchFieldException, IllegalArgumentException, + IllegalAccessException { + Field f = obj.getClass().getDeclaredField(name); + f.setAccessible(true); + f.set(obj, value); + } + + /** + * Override WebKit Proxy settings + * + * @param ctx Android ApplicationContext + * @param host + * @param port + * @return true if Proxy was successfully set + */ + public static boolean setProxy(Context ctx, String host, int port) { + boolean ret = false; + setSystemProperties(host, port); + + try { + if (Build.VERSION.SDK_INT > 18) { + ret = setKitKatProxy(ctx, host, port); + } else if (Build.VERSION.SDK_INT > 13) { + ret = setICSProxy(host, port); + } else { + /* + Object requestQueueObject = getRequestQueue(ctx); + if (requestQueueObject != null) { + // Create Proxy config object and set it into request Q + HttpHost httpHost = new HttpHost(host, port, "http"); + + setDeclaredField(requestQueueObject, "mProxyHost", httpHost); + ret = true; + */ + return false; + } + } + catch (Exception e) { + e.printStackTrace(); + } + return ret; + } + + private static boolean setICSProxy(String host, int port) throws + ClassNotFoundException, NoSuchMethodException, + IllegalArgumentException, InstantiationException, + IllegalAccessException, InvocationTargetException { + Class webViewCoreClass = Class.forName("android.webkit.WebViewCore"); + Class proxyPropertiesClass = Class.forName("android.net.ProxyProperties"); + if (webViewCoreClass != null && proxyPropertiesClass != null) { + Method m = webViewCoreClass.getDeclaredMethod("sendStaticMessage", Integer.TYPE, + Object.class); + Constructor c = proxyPropertiesClass.getConstructor(String.class, Integer.TYPE, + String.class); + m.setAccessible(true); + c.setAccessible(true); + Object properties = c.newInstance(host, port, null); + m.invoke(null, PROXY_CHANGED, properties); + return true; + } + return false; + + } + + @TargetApi(Build.VERSION_CODES.KITKAT) + private static boolean setKitKatProxy(Context context, String host, int port) { + Context appContext = context.getApplicationContext(); + try { + Class applictionCls = appContext.getClass(); + Field loadedApkField = applictionCls.getField("mLoadedApk"); + loadedApkField.setAccessible(true); + Object loadedApk = loadedApkField.get(appContext); + Class loadedApkCls = Class.forName("android.app.LoadedApk"); + Field receiversField = loadedApkCls.getDeclaredField("mReceivers"); + receiversField.setAccessible(true); + ArrayMap receivers = (ArrayMap) receiversField.get(loadedApk); + for (Object receiverMap : receivers.values()) { + for (Object rec : ((ArrayMap) receiverMap).keySet()) { + Class clazz = rec.getClass(); + if (clazz.getName().contains("ProxyChangeListener")) { + Method onReceiveMethod = clazz.getDeclaredMethod("onReceive", Context.class, Intent.class); + Intent intent = new Intent(Proxy.PROXY_CHANGE_ACTION); + + /*********** optional, may be need in future ************* / + final String CLASS_NAME = "android.net.ProxyProperties"; + Class cls = Class.forName(CLASS_NAME); + Constructor constructor = cls.getConstructor(String.class, Integer.TYPE, String.class); + constructor.setAccessible(true); + Object proxyProperties = constructor.newInstance(host, port, null); + intent.putExtra("proxy", (Parcelable) proxyProperties); + //*********** optional, may be need in future *************/ + + onReceiveMethod.invoke(rec, appContext, intent); + } + } + } + return true; + } catch (Exception e) { + e.printStackTrace(); + } + return false; + } + + private static void setSystemProperties(String host, int port) { + + java.lang.System.setProperty("http.proxyHost", host); + java.lang.System.setProperty("http.proxyPort", port + ""); + + java.lang.System.setProperty("https.proxyHost", host); + java.lang.System.setProperty("https.proxyPort", port + ""); + + } +} diff --git a/modules/webview/MODULES b/modules/webview/MODULES new file mode 100644 index 00000000..9fbed2fa --- /dev/null +++ b/modules/webview/MODULES @@ -0,0 +1 @@ +ln_core lnjscheme diff --git a/modules/webview/webview.scm b/modules/webview/webview.scm new file mode 100644 index 00000000..e2302b34 --- /dev/null +++ b/modules/webview/webview.scm @@ -0,0 +1,159 @@ +(define (run-in-LNjScheme #!key (success values) (fail raise) #!rest body) + (thread-start! + (make-thread + (lambda () + (for-each + (lambda (expr) + (cond-expand + (android + ;; (log-debug "jScheme EVAL:" 1 expr) + (call-with-lnjscheme-result + expr + (lambda (promise) + (with-exception-catcher + (lambda (exn) + (log-error + (call-with-output-string + (lambda (port) + (display "EXN in\n" port) + (pretty-print expr port) + (display "EXN: " port) + (display-exception exn port))))) + (lambda () (success (force promise))))))) + (else #f))) + body)) + 'jscheme-worker)) + #t) + +(define (android-webview-code) + `(let* ((app ,(android-app-class)) + (this ln-this) + (intValue (method "intValue" "java.lang.Double")) ;; FIXME teach jscheme fixnums! + (String (lambda (x) (new "java.lang.String" x))) + ) + (let ( + (getWindow (method "getWindow" app)) + (getParent (method "getParent" "android.view.View")) ;; TBD: get rid of this + (setText (method "setText" "android.widget.TextView" "java.lang.CharSequence")) + (addView! (method "addView" "android.view.ViewGroup" "android.view.View")) + (addView/params! (method "addView" "android.view.ViewGroup" "android.view.View" + "android.view.ViewGroup$LayoutParams")) + (setContentView (method "setContentView" app "android.view.View")) + (addContentView (method "addContentView" app "android.view.View" "android.view.ViewGroup$LayoutParams")) + (setOrientation (method "setOrientation" "android.widget.LinearLayout" "int")) + ;; + (onclick-set! (method "LNjScheme_Set_OnClickListener" app "android.view.View" "java.lang.Object")) + (checkOrRequestPermission (method "checkOrRequestPermission" app "java.lang.String")) + (loadUrl (method "loadUrl" "android.webkit.WebView" "java.lang.String")) + (wv-can-go-back? (method "canGoBack" "android.webkit.WebView")) + (wv-goBack! (method "goBack" "android.webkit.WebView")) + (wv-setClient! (method "setWebViewClient" "android.webkit.WebView" "android.webkit.WebViewClient")) + ;; + (websettings (method "getSettings" "android.webkit.WebView")) + (wvs-javascript-enabled-set! (method "setJavaScriptEnabled" "android.webkit.WebSettings" "boolean")) + (wvs-zoom-support-set! (method "setSupportZoom" "android.webkit.WebSettings" "boolean")) + (wvs-zoom-builtin-set! (method "setBuiltInZoomControls" "android.webkit.WebSettings" "boolean")) + (wvs-zoom-builtin-controls-set! (method "setDisplayZoomControls" "android.webkit.WebSettings" "boolean")) + ) + (define (set-layout-vertical! x) + (setOrientation x (intValue 1))) + (define (arrange-in-order! parent childs) + (for-each (lambda (v) (addView! parent v)) childs)) + (let ( + (frame (new "android.widget.LinearLayout" this)) + (wv (make-webview this)) + (navigation (new "android.widget.LinearLayout" this)) ;; horizontal is default + (back (new "android.widget.Button" this)) + (back-pressed-h #f) + (reload (new "android.widget.Button" this)) + (Button3 (new "android.widget.Button" this)) + ) + (define (switch-back-to-glgui! v) + (on-back-pressed back-pressed-h) + (set! back-pressed-h #f) + (setContentView this ln-mglview)) + (define (back-pressed) + (if (wv-can-go-back? wv) (wv-goBack! wv) (switch-back-to-glgui! frame))) + ;; (webview! wv 'onpagecomplete (lambda (view url) (log-message "webview post visual state"))) + ;; (webview! wv 'onLoadResource (lambda (view url) (log-message (string-append "onLoadResource " url)))) + ;; (webview! wv 'onPageFinished (lambda (view url) (log-message (string-append "onPageFinished " url)))) + (let* ((wvs (websettings wv)) + (js+- (let ((is #f)) + (lambda _ + (set! is (not is)) + (wvs-javascript-enabled-set! wvs is))))) + ;; (wvs-javascript-enabled-set! wvs #t) + (begin + (setText Button3 (String "JS+-")) + (onclick-set! this Button3 js+-)) + (wvs-zoom-support-set! wvs #t) + (wvs-zoom-builtin-set! wvs #t) + (wvs-zoom-builtin-controls-set! wvs #f)) + (arrange-in-order! navigation (list back reload Button3)) + (setText back (String "Back")) + (setText reload (String "Reload")) + (onclick-set! this back switch-back-to-glgui!) + (onclick-set! this reload (lambda (v) ((method "reload" "android.webkit.WebView") wv))) + (set-layout-vertical! frame) + (set-layout-vertical! frame) + (arrange-in-order! frame (list navigation wv)) + (lambda (cmd arg) + (case cmd + ((load) (webview! wv cmd arg)) + (else + (if (not back-pressed-h) + (begin + (set! back-pressed-h (on-back-pressed)) + (on-back-pressed back-pressed))) + (setContentView this frame)))))))) + +(define android-webview + (let ((in-android-webview + (lambda (args) + (define (otherwise) + (log-error "android-webview: call not recognized" (object->string args)) + #f) + (cond + ((null? args) (otherwise)) + (else + (let ((a1 (car args))) + (cond + ((eq? a1 #t) '(webview #t #t)) + ((string? a1) `(webview 'load ,a1)) + (else (otherwise)))))))) + (webview-running #f)) + (lambda args + (cond + ((eq? webview-running #f) + (set! webview 'initializing) + (apply + run-in-LNjScheme + ;; success: (lambda _ (set! webview #t) (run-in-LNjScheme '(webview 'redraw #t))) + #;`(define (log-message str) + (let* ((app ,(android-app-class)) + ;; DOES NOT work on Android 10!!! + (log (method "ln_log" app "java.lang.String"))) + (log ln-this (new "java.lang.String" str)) + #t)) + ;; '(log-message "log-message working, app class:") + ;; `(log-message ,(debug 'android-app-class (android-app-class))) + `(if (not (bound? 'webview)) (define webview ,(android-webview-code))) + (map in-android-webview args)) + (set! webview-running #f)) + (else + (log-error + "android-webview: called again while previous call did not yet return. IGNORED: " + (object->string args)))) + #!void))) + +(define + webview-launch! + (let ((orginal-launch-url launch-url)) + (lambda (url #!key (via #f)) + (cond-expand + (android + (case via + ((webview) (android-webview '("about:blank") `(,url) '(#t))) + ((extern) (orginal-launch-url url)) + (else (orginal-launch-url url)))) + (else (orginal-launch-url url)))))) From 2c70a6cc683a57afdd223e2890719a01964ee964 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=B6rg=20F=2E=20Wittenberger?= Date: Wed, 11 Nov 2020 16:36:42 +0100 Subject: [PATCH 21/26] ANDROID: better code position --- loaders/android/bootstrap.c.in | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/loaders/android/bootstrap.c.in b/loaders/android/bootstrap.c.in index 4e32681e..93f67434 100644 --- a/loaders/android/bootstrap.c.in +++ b/loaders/android/bootstrap.c.in @@ -87,6 +87,15 @@ jint JNI_OnLoad(JavaVM* vm, void* reserved){ return JNI_VERSION_1_4; } +int JNI_forward_exception_to_gambit(JNIEnv*env) { + // TBD: actually forward, not only clear! + if((*env)->ExceptionCheck(env)) { + (*env)->ExceptionClear(env); + return 1; + } + return 0; +} + JNIEnv* GetJNIEnv(){ int error=0; JNIEnv* env = NULL; @@ -103,15 +112,6 @@ JNIEnv* GetJNIEnv(){ return (error?NULL:env); } -int JNI_forward_exception_to_gambit(JNIEnv*env) { - // TBD: actually forward, not only clear! - if((*env)->ExceptionCheck(env)) { - (*env)->ExceptionClear(env); - return 1; - } - return 0; -} - // url launcher ffi void android_launch_url(char* urlstring){ JNIEnv *env = GetJNIEnv(); From 4c46e18a72b9513c90bfda10ae9fbae057d2f766 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=B6rg=20F=2E=20Wittenberger?= Date: Sun, 22 Nov 2020 16:56:37 +0100 Subject: [PATCH 22/26] JNI: be careful to free local references --- modules/lnjscheme/ANDROID_c_additions | 33 ++++++++++++++++++--------- 1 file changed, 22 insertions(+), 11 deletions(-) diff --git a/modules/lnjscheme/ANDROID_c_additions b/modules/lnjscheme/ANDROID_c_additions index b846a90f..f7c9a626 100644 --- a/modules/lnjscheme/ANDROID_c_additions +++ b/modules/lnjscheme/ANDROID_c_additions @@ -18,14 +18,18 @@ const char* lnjscheme_eval(const char* input) jstring jin = (*env)->NewStringUTF(env,input); jclass main_class = (*env)->FindClass(env, "@SYS_PACKAGE_SLASH@/@SYS_APPNAME@"); jmethodID method = main_class ? (*env)->GetMethodID(env, main_class, "LNjSchemeCall", "(Ljava/lang/String;)Ljava/lang/String;") : NULL; - if(!method && JNI_forward_exception_to_gambit(env)) { + if(main_class) (*env)->DeleteLocalRef(env, main_class); + if(!method) { + JNI_forward_exception_to_gambit(env); return "E \"JNI: method LNjSchemeCall not found\""; } - if(jstr) { (*env)->ReleaseStringUTFChars(env, jstr, str); jstr = NULL; } // works? - jstr = (jstring) method ? (*env)->CallObjectMethod(env, globalObj, method, jin) : NULL; - // Is this required??? (*env)->ReleaseStringUTFChars(env, jin, NULL); + if(jstr) { (*env)->ReleaseStringUTFChars(env, jstr, str); jstr = NULL; } + jstr = (jstring) (*env)->CallObjectMethod(env, globalObj, method, jin); + (*env)->DeleteLocalRef(env, method); + (*env)->DeleteLocalRef(env, jin); str = jstr ? (*env)->GetStringUTFChars(env, jstr, 0) : NULL; - // (*env)->ReleaseStringUTFChars(env, jstr, NULL); // we do it upon next call + // (*env)->ReleaseStringUTFChars(env, jstr, str); // we do it upon next call + JNI_forward_exception_to_gambit(env); } return str; } @@ -36,12 +40,15 @@ void lnjscheme_eval_send(const char* input) if (env&&globalObj){ jclass main_class = (*env)->FindClass(env, "@SYS_PACKAGE_SLASH@/@SYS_APPNAME@"); jmethodID method = main_class ? (*env)->GetMethodID(env, main_class, "LNjSchemeSend", "(Ljava/lang/String;)V") : NULL; - if(!method && JNI_forward_exception_to_gambit(env)) { + if(main_class) (*env)->DeleteLocalRef(env, main_class); + if(!method) { + JNI_forward_exception_to_gambit(env); return; // "E \"JNI: method LNjSchemeSend not found\""; } else { jstring jin = (*env)->NewStringUTF(env,input); (*env)->CallVoidMethod(env, globalObj, method, jin); - (*env)->ReleaseStringUTFChars(env, jin, NULL); + (*env)->DeleteLocalRef(env, method); + (*env)->DeleteLocalRef(env, jin); JNI_forward_exception_to_gambit(env); } } @@ -56,15 +63,19 @@ const char* lnjscheme_eval_receive_result() static jstring jstr = NULL; JNIEnv *env = GetJNIEnv(); if (env&&globalObj){ - if(jstr) { (*env)->ReleaseStringUTFChars(env, jstr, str); jstr = NULL; } // works? + if(jstr) { (*env)->ReleaseStringUTFChars(env, jstr, str); jstr = NULL; } jclass main_class = (*env)->FindClass(env, "@SYS_PACKAGE_SLASH@/@SYS_APPNAME@"); jmethodID method = main_class ? (*env)->GetMethodID(env, main_class, "LNjSchemeResult", "()Ljava/lang/String;") : NULL; - if(!method && JNI_forward_exception_to_gambit(env)) { + if(main_class) (*env)->DeleteLocalRef(env, main_class); + if(!method) { + JNI_forward_exception_to_gambit(env); return "E \"JNI: method LNjSchemeResult not found\""; } else { - jstr = (jstring) method ? (*env)->CallObjectMethod(env, globalObj, method) : NULL; + jstr = (jstring) (*env)->CallObjectMethod(env, globalObj, method); str = jstr ? (*env)->GetStringUTFChars(env, jstr, 0) : NULL; - // (*env)->ReleaseStringUTFChars(env, jstr, NULL); // we do it upon next call + // (*env)->ReleaseStringUTFChars(env, jstr, str); // we do it upon next call + (*env)->DeleteLocalRef(env, method); + JNI_forward_exception_to_gambit(env); } } return str; From 84b221e4701e6dab1a6c76aa32854830314f3e69 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=B6rg=20F=2E=20Wittenberger?= Date: Mon, 23 Nov 2020 19:30:03 +0100 Subject: [PATCH 23/26] JNI: conservative coding - #defines LAMBDANATIVE_JNI_VERSION to JNI_VERSION_1_4 - uses `jint` as if it was an opaque type - checks via GetEnv before attaching a thread (there are claims on the Internet that this may save some overhead) - use AttachCurrentThreadAsDaemon instead of AttachCurrentThread for gut feeling --- loaders/android/bootstrap.c.in | 23 ++++++++++++++++++----- 1 file changed, 18 insertions(+), 5 deletions(-) diff --git a/loaders/android/bootstrap.c.in b/loaders/android/bootstrap.c.in index 93f67434..7139d5a7 100644 --- a/loaders/android/bootstrap.c.in +++ b/loaders/android/bootstrap.c.in @@ -46,6 +46,8 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include +#define LAMBDANATIVE_JNI_VERSION JNI_VERSION_1_4 + @ANDROID_C_DEFINES@ // event hook @@ -84,7 +86,7 @@ jint JNI_OnLoad(JavaVM* vm, void* reserved){ JNIEnv *env; s_vm=vm; // if ((*s_vm)->GetEnv(s_vm,(void**) &env, JNI_VERSION_1_4) != JNI_OK) return -1; - return JNI_VERSION_1_4; + return LAMBDANATIVE_JNI_VERSION; } int JNI_forward_exception_to_gambit(JNIEnv*env) { @@ -97,7 +99,7 @@ int JNI_forward_exception_to_gambit(JNIEnv*env) { } JNIEnv* GetJNIEnv(){ - int error=0; + jint error=0; JNIEnv* env = NULL; /* static `env` does NOT work! Once in a while we should ponder if it still does not work or why. @@ -107,9 +109,20 @@ JNIEnv* GetJNIEnv(){ return env; } */ - if(s_vm) error=(*s_vm)->AttachCurrentThread(s_vm, &env, NULL); - if(!error) error = JNI_forward_exception_to_gambit(env); - return (error?NULL:env); + if(s_vm) { + // some say that despite AttachCurrentThread being a no-op, one + // may save overhead when checking first via GetEnv, so we do. + error = (*s_vm)->GetEnv(s_vm, &env, LAMBDANATIVE_JNI_VERSION); + if(error==JNI_EDETACHED) { + error=(*s_vm)->AttachCurrentThreadAsDaemon(s_vm, &env, NULL); + } + } + if(error!=JNI_OK) { + JNI_forward_exception_to_gambit(env); + return NULL; + } else { + return env; + } } // url launcher ffi From 93485a10aa62acb88ff0e10069db265e63dd1c29 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=B6rg=20F=2E=20Wittenberger?= Date: Mon, 23 Nov 2020 21:01:55 +0100 Subject: [PATCH 24/26] ANDROID: make mGLView static and initialization once only This appears to be the correct way and seems to actually solve the issue observed and not fixed by da86a5160 ff. --- loaders/android/bootstrap.java.in | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/loaders/android/bootstrap.java.in b/loaders/android/bootstrap.java.in index f1b77848..537b0dc3 100644 --- a/loaders/android/bootstrap.java.in +++ b/loaders/android/bootstrap.java.in @@ -144,9 +144,9 @@ public class @SYS_APPNAME@ extends Activity implements @ANDROID_JAVA_IMPLEMENTS@ } current_ContentView = view; super.setContentView(current_ContentView); - if(current_ContentView instanceof android.opengl.GLSurfaceView) { - ((android.opengl.GLSurfaceView)current_ContentView).onResume(); - } + } + if(current_ContentView instanceof android.opengl.GLSurfaceView) { + ((android.opengl.GLSurfaceView)current_ContentView).onResume(); } } @@ -171,9 +171,12 @@ public class @SYS_APPNAME@ extends Activity implements @ANDROID_JAVA_IMPLEMENTS@ WindowManager.LayoutParams.FLAG_FULLSCREEN); // prevent sleep getWindow().addFlags(WindowManager.LayoutParams.FLAG_KEEP_SCREEN_ON); - mGLView = new xGLSurfaceView(this); - // This may better before other pieces - nativeInstanceInit(getApplicationContext().getPackageCodePath().toString(), getFilesDir().toString()); + if(mGLView==null) { // once only! + mGLView = new xGLSurfaceView(this); + // This may better before other pieces + nativeInstanceInit(getApplicationContext().getPackageCodePath().toString(), getFilesDir().toString()); + setContentView(mGLView); // MUST NOT run before nativeInstanceInit completed + } mSensorManager = (SensorManager)getSystemService(Context.SENSOR_SERVICE); @@ -181,8 +184,6 @@ public class @SYS_APPNAME@ extends Activity implements @ANDROID_JAVA_IMPLEMENTS@ // Additions and permissions needed by modules, e.g. gps @ANDROID_JAVA_ONCREATE@ - setContentView(mGLView); // MUST NOT run before nativeInstanceInit completed - // start EVENT_IDLE if(idle_tmScheduleRate > 0) idle_tm.scheduleAtFixedRate(idle_task, 0, idle_tmScheduleRate); } @@ -234,7 +235,7 @@ public class @SYS_APPNAME@ extends Activity implements @ANDROID_JAVA_IMPLEMENTS@ @ANDROID_JAVA_ACTIVITYADDITIONS@ // Native event bindings - GLSurfaceView mGLView; + static GLSurfaceView mGLView = null; native void nativeEvent(int t, int x, int y); static { System.loadLibrary("payloadshared"); } // OpenURL code From 5dfe4cc46511e13f774b0a05d36812ccafe070bf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=B6rg=20F=2E=20Wittenberger?= Date: Mon, 23 Nov 2020 21:45:20 +0100 Subject: [PATCH 25/26] LNjSCHEME: revert change breaking things --- modules/lnjscheme/ANDROID_java_oncreate | 2 ++ 1 file changed, 2 insertions(+) diff --git a/modules/lnjscheme/ANDROID_java_oncreate b/modules/lnjscheme/ANDROID_java_oncreate index ce901cb4..401f9bd8 100644 --- a/modules/lnjscheme/ANDROID_java_oncreate +++ b/modules/lnjscheme/ANDROID_java_oncreate @@ -124,3 +124,5 @@ LNjSchemeEvaluateNoSync } }} ))); + +// eof: LNjScheme From 138c742d8d6d9bcbb80e14b04ce5d3bc70d422d0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=B6rg=20F=2E=20Wittenberger?= Date: Tue, 24 Nov 2020 12:50:14 +0100 Subject: [PATCH 26/26] Revert "LNjSCHEME: revert change breaking things" This reverts commit 5dfe4cc46511e13f774b0a05d36812ccafe070bf. --- modules/lnjscheme/ANDROID_java_oncreate | 2 -- 1 file changed, 2 deletions(-) diff --git a/modules/lnjscheme/ANDROID_java_oncreate b/modules/lnjscheme/ANDROID_java_oncreate index 401f9bd8..ce901cb4 100644 --- a/modules/lnjscheme/ANDROID_java_oncreate +++ b/modules/lnjscheme/ANDROID_java_oncreate @@ -124,5 +124,3 @@ LNjSchemeEvaluateNoSync } }} ))); - -// eof: LNjScheme