diff --git a/jni.cabal b/jni.cabal --- a/jni.cabal +++ b/jni.cabal @@ -1,5 +1,5 @@ name: jni -version: 0.2.3 +version: 0.3.0 synopsis: Complete JNI raw bindings. description: Please see README.md. homepage: https://github.com/tweag/inline-java/tree/master/jni#readme @@ -34,8 +34,10 @@ build-depends: base >= 4.7 && < 5, bytestring >=0.10, + choice >= 0.2.0, containers >=0.5, - inline-c >=0.5, + inline-c >=0.5.6.1, singletons >= 2.0, thread-local-storage >=0.1 + build-tools: cpphs default-language: Haskell2010 diff --git a/src/Foreign/JNI.c b/src/Foreign/JNI.c --- a/src/Foreign/JNI.c +++ b/src/Foreign/JNI.c @@ -20,12 +20,12 @@ } -JNIEnv * inline_c_Foreign_JNI_3_99b0dd0131b646dafcbe5e45017817ad4c5859cb() { +JNIEnv * inline_c_Foreign_JNI_3_7a31865bf33245c9e432165e1fe1577264708e3b() { jsize num_jvms; JavaVM *jvm; - - + + JNI_GetCreatedJavaVMs(&jvm, 1, &num_jvms); JNIEnv *env; @@ -34,9 +34,9 @@ exit(EFAULT); } - - - + + + (*jvm)->AttachCurrentThreadAsDaemon(jvm, (void**)&env, NULL); return env; } @@ -336,121 +336,149 @@ } -jobject inline_c_Foreign_JNI_53_8c39298123ed5c8656bc5277898eef8b54389907(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2) { +void inline_c_Foreign_JNI_53_ace3bc46d6fd80627af710dce368567213addfaa(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject gobj_inline_c_2) { + (*env_inline_c_0)->DeleteGlobalRef(env_inline_c_1 + ,gobj_inline_c_2); + +} + + +jobject inline_c_Foreign_JNI_54_16595ba5c6f78926bf8bd31d9d0e8bf072131bb0(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2) { return ( - (*env_inline_c_0)->NewGlobalRef(env_inline_c_1, - obj_inline_c_2) ); + (*env_inline_c_0)->NewGlobalRef(env_inline_c_1, + obj_inline_c_2) ); } -void inline_c_Foreign_JNI_54_03477bcc772fad6c91dec2c4c759fcb4fc07724e(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2) { +jobject inline_c_Foreign_JNI_55_286b821e24496c30618bcd36d10e07939424a96e(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2) { +return ( + (*env_inline_c_0)->NewLocalRef(env_inline_c_1, + obj_inline_c_2) ); +} - (*env_inline_c_0)->DeleteGlobalRef(env_inline_c_1, - obj_inline_c_2); + +void inline_c_Foreign_JNI_56_f46c3362caa2b895c87351e1914a06c012eee294(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2) { + + (*env_inline_c_0)->DeleteLocalRef(env_inline_c_1, + obj_inline_c_2) ; } -void inline_c_Foreign_JNI_55_1fc0f64f3f314012d49ffbd906fd558d03aef37d(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { - (*env_inline_c_0)->CallVoidMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ; +jint inline_c_Foreign_JNI_57_c49bfdb1320e2f77592a15068a422089ae09feba(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jint capacity_inline_c_2) { + + (*env_inline_c_0)->PushLocalFrame(env_inline_c_1, + capacity_inline_c_2); } -jobject inline_c_Foreign_JNI_56_203a086f6ff15893a2417732fde0904a88dd4307(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { -return ( (*env_inline_c_0)->CallObjectMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +jobject inline_c_Foreign_JNI_58_53148f1b21d55375d63ea7ade9238bc4f16e149e(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2) { +return ( + (*env_inline_c_0)->PopLocalFrame(env_inline_c_1, + obj_inline_c_2) ); } -jboolean inline_c_Foreign_JNI_57_b729da20539bd62f9d8b8e8579dbf42bbafc76c4(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { -return ( (*env_inline_c_0)->CallBooleanMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +void inline_c_Foreign_JNI_59_8d66436d754c77c4f92234fe2c72cb9e8a9ad940(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { + (*env_inline_c_0)->CallVoidMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ; } -jbyte inline_c_Foreign_JNI_58_4e4bdbfc154de6ffe6eb562e1edfcbb529c275e8(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { -return ( (*env_inline_c_0)->CallByteMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +jobject inline_c_Foreign_JNI_60_15d6a4ae1fac1a6ba84db740b2bfac9d44b23329(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +return ( (*env_inline_c_0)->CallObjectMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); } -jchar inline_c_Foreign_JNI_59_5e000da030371e4db09c808934e3e5f504eda6c9(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { -return ( (*env_inline_c_0)->CallCharMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +jboolean inline_c_Foreign_JNI_61_71e1f15d31cfe83371d148dbf20d2aebf0293c53(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +return ( (*env_inline_c_0)->CallBooleanMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); } -jshort inline_c_Foreign_JNI_60_516aded3c2f638c87a12e56d246bdcea1c7e1a47(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { -return ( (*env_inline_c_0)->CallShortMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +jbyte inline_c_Foreign_JNI_62_5c031f42ce827bc7ef3320331f4333dfb7ddaa3a(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +return ( (*env_inline_c_0)->CallByteMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); } -jint inline_c_Foreign_JNI_61_58b123994733ee132cc23af0e5a7da34ef37f584(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { -return ( (*env_inline_c_0)->CallIntMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +jchar inline_c_Foreign_JNI_63_f67cb9064f7392b8f942ac21b300b8594ddc8043(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +return ( (*env_inline_c_0)->CallCharMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); } -jlong inline_c_Foreign_JNI_62_46357804ee4af723721f601341c61ac4eecad475(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { -return ( (*env_inline_c_0)->CallLongMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +jshort inline_c_Foreign_JNI_64_3dc48e937e27459da9000a1fba7694c91562fbd6(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +return ( (*env_inline_c_0)->CallShortMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); } -jfloat inline_c_Foreign_JNI_63_75b26f9688a40ee63e314f73ee5f9563c48e02c0(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { -return ( (*env_inline_c_0)->CallFloatMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +jint inline_c_Foreign_JNI_65_0d9906f84552f67ba8fc08d4403ca6919417f4de(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +return ( (*env_inline_c_0)->CallIntMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); } -jdouble inline_c_Foreign_JNI_64_f33654d183f21d1a2c8ffc121684d4e60e273fa2(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { -return ( (*env_inline_c_0)->CallDoubleMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +jlong inline_c_Foreign_JNI_66_ff3b913f1c1e13665522e2fa9f46cf345cef625e(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +return ( (*env_inline_c_0)->CallLongMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); } -void inline_c_Foreign_JNI_65_5e76a5cd24826d8a13100c53ae77823083465978(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +jfloat inline_c_Foreign_JNI_67_7d9a7c851ecb7d144f8aadac5cb17df79f87edfc(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +return ( (*env_inline_c_0)->CallFloatMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +} + + +jdouble inline_c_Foreign_JNI_68_9928358856d291d7c670b6bb00810c66255dcc65(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject obj_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +return ( (*env_inline_c_0)->CallDoubleMethodA(env_inline_c_1, obj_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); +} + + +void inline_c_Foreign_JNI_69_5e76a5cd24826d8a13100c53ae77823083465978(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { (*env_inline_c_0)->CallStaticVoidMethodA(env_inline_c_1, cls_inline_c_2, method_inline_c_3, cargs_inline_c_4) ; } -jobject inline_c_Foreign_JNI_66_6b65c20aae594d93c02434b3de002e443794ad14(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +jobject inline_c_Foreign_JNI_70_6b65c20aae594d93c02434b3de002e443794ad14(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { return ( (*env_inline_c_0)->CallStaticObjectMethodA(env_inline_c_1, cls_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); } -jboolean inline_c_Foreign_JNI_67_58bcbcce6c8bf92799bd1db44c288a7b0a260a36(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +jboolean inline_c_Foreign_JNI_71_58bcbcce6c8bf92799bd1db44c288a7b0a260a36(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { return ( (*env_inline_c_0)->CallStaticBooleanMethodA(env_inline_c_1, cls_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); } -jbyte inline_c_Foreign_JNI_68_1f0c41a419f29557514552df4d07022a006f2ca3(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +jbyte inline_c_Foreign_JNI_72_1f0c41a419f29557514552df4d07022a006f2ca3(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { return ( (*env_inline_c_0)->CallStaticByteMethodA(env_inline_c_1, cls_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); } -jchar inline_c_Foreign_JNI_69_51a3cb1cefc6391ba5958a887d84196690a418f2(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +jchar inline_c_Foreign_JNI_73_51a3cb1cefc6391ba5958a887d84196690a418f2(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { return ( (*env_inline_c_0)->CallStaticCharMethodA(env_inline_c_1, cls_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); } -jshort inline_c_Foreign_JNI_70_5822dfce2b301e3b90f80885a4a5838bdc57cd44(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +jshort inline_c_Foreign_JNI_74_5822dfce2b301e3b90f80885a4a5838bdc57cd44(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { return ( (*env_inline_c_0)->CallStaticShortMethodA(env_inline_c_1, cls_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); } -jint inline_c_Foreign_JNI_71_4fdc28424fe7ef156763f715ef79463ed387abb2(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +jint inline_c_Foreign_JNI_75_4fdc28424fe7ef156763f715ef79463ed387abb2(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { return ( (*env_inline_c_0)->CallStaticIntMethodA(env_inline_c_1, cls_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); } -jlong inline_c_Foreign_JNI_72_93382b358dc7f0275c6a620eaa67fdfd75167d54(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +jlong inline_c_Foreign_JNI_76_93382b358dc7f0275c6a620eaa67fdfd75167d54(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { return ( (*env_inline_c_0)->CallStaticLongMethodA(env_inline_c_1, cls_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); } -jfloat inline_c_Foreign_JNI_73_89ea2435847f3d94e8b71bcceba739a077829ca9(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +jfloat inline_c_Foreign_JNI_77_89ea2435847f3d94e8b71bcceba739a077829ca9(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { return ( (*env_inline_c_0)->CallStaticFloatMethodA(env_inline_c_1, cls_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); } -jdouble inline_c_Foreign_JNI_74_0b9bb41f21f19495338507ff5779f50a17ac0245(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { +jdouble inline_c_Foreign_JNI_78_0b9bb41f21f19495338507ff5779f50a17ac0245(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jclass cls_inline_c_2, jmethodID method_inline_c_3, jvalue * cargs_inline_c_4) { return ( (*env_inline_c_0)->CallStaticDoubleMethodA(env_inline_c_1, cls_inline_c_2, method_inline_c_3, cargs_inline_c_4) ); } -jobjectArray inline_c_Foreign_JNI_75_0b57533e83360b5a6660bf703521b3b6c2fbec66(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jsize sz_inline_c_2, jclass cls_inline_c_3) { +jobjectArray inline_c_Foreign_JNI_79_0b57533e83360b5a6660bf703521b3b6c2fbec66(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jsize sz_inline_c_2, jclass cls_inline_c_3) { return ( (*env_inline_c_0)->NewObjectArray(env_inline_c_1, sz_inline_c_2, @@ -459,47 +487,47 @@ } -jbooleanArray inline_c_Foreign_JNI_76_b1841567b8f0e99405458b9e8a3b7f3a3e20812f(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jsize sz_inline_c_2) { +jbooleanArray inline_c_Foreign_JNI_80_b1841567b8f0e99405458b9e8a3b7f3a3e20812f(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jsize sz_inline_c_2) { return ( (*env_inline_c_0)->NewBooleanArray(env_inline_c_1, sz_inline_c_2) ); } -jbyteArray inline_c_Foreign_JNI_77_1a9345ff427557126ba3aa5f0fb460f3df632ff8(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jsize sz_inline_c_2) { +jbyteArray inline_c_Foreign_JNI_81_1a9345ff427557126ba3aa5f0fb460f3df632ff8(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jsize sz_inline_c_2) { return ( (*env_inline_c_0)->NewByteArray(env_inline_c_1, sz_inline_c_2) ); } -jcharArray inline_c_Foreign_JNI_78_b00869a9422815fdc3aa43f15e3b782dc6f19e03(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jsize sz_inline_c_2) { +jcharArray inline_c_Foreign_JNI_82_b00869a9422815fdc3aa43f15e3b782dc6f19e03(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jsize sz_inline_c_2) { return ( (*env_inline_c_0)->NewCharArray(env_inline_c_1, sz_inline_c_2) ); } -jshortArray inline_c_Foreign_JNI_79_06a1e38de0ed2d7764757388457ed0797c72d8aa(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jsize sz_inline_c_2) { +jshortArray inline_c_Foreign_JNI_83_06a1e38de0ed2d7764757388457ed0797c72d8aa(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jsize sz_inline_c_2) { return ( (*env_inline_c_0)->NewShortArray(env_inline_c_1, sz_inline_c_2) ); } -jintArray inline_c_Foreign_JNI_80_af7c087746afd64be9d977ebf078c2df4b3d918e(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jsize sz_inline_c_2) { +jintArray inline_c_Foreign_JNI_84_af7c087746afd64be9d977ebf078c2df4b3d918e(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jsize sz_inline_c_2) { return ( (*env_inline_c_0)->NewIntArray(env_inline_c_1, sz_inline_c_2) ); } -jlongArray inline_c_Foreign_JNI_81_270c75c62cc97fdc3741af544fa35a61abf37fba(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jsize sz_inline_c_2) { +jlongArray inline_c_Foreign_JNI_85_270c75c62cc97fdc3741af544fa35a61abf37fba(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jsize sz_inline_c_2) { return ( (*env_inline_c_0)->NewLongArray(env_inline_c_1, sz_inline_c_2) ); } -jfloatArray inline_c_Foreign_JNI_82_312dee8af1c4b2058cb1b2703277cf297ba34224(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jsize sz_inline_c_2) { +jfloatArray inline_c_Foreign_JNI_86_312dee8af1c4b2058cb1b2703277cf297ba34224(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jsize sz_inline_c_2) { return ( (*env_inline_c_0)->NewFloatArray(env_inline_c_1, sz_inline_c_2) ); } -jdoubleArray inline_c_Foreign_JNI_83_103070e78986a21762e18c9aebfa9162a3565d9b(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jsize sz_inline_c_2) { +jdoubleArray inline_c_Foreign_JNI_87_103070e78986a21762e18c9aebfa9162a3565d9b(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jsize sz_inline_c_2) { return ( (*env_inline_c_0)->NewDoubleArray(env_inline_c_1, sz_inline_c_2) ); } -jstring inline_c_Foreign_JNI_84_d5ed5b314231e7dc3292c2329a2cb4191e262633(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jchar * ptr_inline_c_2, jsize len_inline_c_3) { +jstring inline_c_Foreign_JNI_88_d5ed5b314231e7dc3292c2329a2cb4191e262633(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jchar * ptr_inline_c_2, jsize len_inline_c_3) { return ( (*env_inline_c_0)->NewString(env_inline_c_1, ptr_inline_c_2, @@ -507,61 +535,61 @@ } -jsize inline_c_Foreign_JNI_85_9be0134c89fa74c4d07a2601d81d89982ce8bdf6(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jarray array_inline_c_2) { +jsize inline_c_Foreign_JNI_89_9be0134c89fa74c4d07a2601d81d89982ce8bdf6(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jarray array_inline_c_2) { return ( (*env_inline_c_0)->GetArrayLength(env_inline_c_1, array_inline_c_2) ); } -jsize inline_c_Foreign_JNI_86_2e55ce4ded52c43b7b69c0c49c4425aef4f8a80b(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jstring jstr_inline_c_2) { +jsize inline_c_Foreign_JNI_90_2e55ce4ded52c43b7b69c0c49c4425aef4f8a80b(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jstring jstr_inline_c_2) { return ( (*env_inline_c_0)->GetStringLength(env_inline_c_1, jstr_inline_c_2) ); } -jboolean * inline_c_Foreign_JNI_87_153a97a3a91d03dbe7d10fe0e3d48afaa842ee96(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2) { +jboolean * inline_c_Foreign_JNI_91_153a97a3a91d03dbe7d10fe0e3d48afaa842ee96(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2) { return ( (*env_inline_c_0)->GetBooleanArrayElements(env_inline_c_1, array_inline_c_2, NULL) ); } -jbyte * inline_c_Foreign_JNI_88_b630cdc25e3d575cad69a3fc3bec490a99a6ab49(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2) { +jbyte * inline_c_Foreign_JNI_92_b630cdc25e3d575cad69a3fc3bec490a99a6ab49(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2) { return ( (*env_inline_c_0)->GetByteArrayElements(env_inline_c_1, array_inline_c_2, NULL) ); } -jchar * inline_c_Foreign_JNI_89_7c0f806fe4d40ac0c1d06b4ccccc42fdc562c8ec(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2) { +jchar * inline_c_Foreign_JNI_93_7c0f806fe4d40ac0c1d06b4ccccc42fdc562c8ec(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2) { return ( (*env_inline_c_0)->GetCharArrayElements(env_inline_c_1, array_inline_c_2, NULL) ); } -jshort * inline_c_Foreign_JNI_90_66e42eb3b8a0e71cc0cc2b722b925689a20ed23f(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2) { +jshort * inline_c_Foreign_JNI_94_66e42eb3b8a0e71cc0cc2b722b925689a20ed23f(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2) { return ( (*env_inline_c_0)->GetShortArrayElements(env_inline_c_1, array_inline_c_2, NULL) ); } -jint * inline_c_Foreign_JNI_91_9ca3666fbed332c3a833881ceba71295e27d5d16(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2) { +jint * inline_c_Foreign_JNI_95_9ca3666fbed332c3a833881ceba71295e27d5d16(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2) { return ( (*env_inline_c_0)->GetIntArrayElements(env_inline_c_1, array_inline_c_2, NULL) ); } -jlong * inline_c_Foreign_JNI_92_3bd0969839fbd68b98c00a27f6197704f6e2718b(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2) { +jlong * inline_c_Foreign_JNI_96_3bd0969839fbd68b98c00a27f6197704f6e2718b(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2) { return ( (*env_inline_c_0)->GetLongArrayElements(env_inline_c_1, array_inline_c_2, NULL) ); } -jfloat * inline_c_Foreign_JNI_93_1799b6e92e7df6d5155518d25fe2fde47055a7ff(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2) { +jfloat * inline_c_Foreign_JNI_97_1799b6e92e7df6d5155518d25fe2fde47055a7ff(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2) { return ( (*env_inline_c_0)->GetFloatArrayElements(env_inline_c_1, array_inline_c_2, NULL) ); } -jdouble * inline_c_Foreign_JNI_94_6b454504f66bff257e7cb14d00f7064112a8f5a2(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2) { +jdouble * inline_c_Foreign_JNI_98_6b454504f66bff257e7cb14d00f7064112a8f5a2(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2) { return ( (*env_inline_c_0)->GetDoubleArrayElements(env_inline_c_1, array_inline_c_2, NULL) ); } -const jchar * inline_c_Foreign_JNI_95_ac075a3bdcb535575fe36c6f7b5eb3d66ace44a7(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jstring jstr_inline_c_2) { +const jchar * inline_c_Foreign_JNI_99_ac075a3bdcb535575fe36c6f7b5eb3d66ace44a7(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jstring jstr_inline_c_2) { return ( (*env_inline_c_0)->GetStringChars(env_inline_c_1, jstr_inline_c_2, @@ -569,87 +597,87 @@ } -void inline_c_Foreign_JNI_96_c405fd2cc3cc77bea5093b022f17d3b2c443e2a2(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jbooleanArray array_inline_c_2, jsize start_inline_c_3, jsize len_inline_c_4, jboolean * buf_inline_c_5) { +void inline_c_Foreign_JNI_100_c405fd2cc3cc77bea5093b022f17d3b2c443e2a2(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jbooleanArray array_inline_c_2, jsize start_inline_c_3, jsize len_inline_c_4, jboolean * buf_inline_c_5) { (*env_inline_c_0)->SetBooleanArrayRegion(env_inline_c_1, array_inline_c_2, start_inline_c_3, len_inline_c_4, buf_inline_c_5) ; } -void inline_c_Foreign_JNI_97_6aefb6e6ad5f3a169ff39bd2c3186b897bcd220f(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jbyteArray array_inline_c_2, jsize start_inline_c_3, jsize len_inline_c_4, jbyte * buf_inline_c_5) { +void inline_c_Foreign_JNI_101_6aefb6e6ad5f3a169ff39bd2c3186b897bcd220f(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jbyteArray array_inline_c_2, jsize start_inline_c_3, jsize len_inline_c_4, jbyte * buf_inline_c_5) { (*env_inline_c_0)->SetByteArrayRegion(env_inline_c_1, array_inline_c_2, start_inline_c_3, len_inline_c_4, buf_inline_c_5) ; } -void inline_c_Foreign_JNI_98_a1e161a18fa39331bad743b7e07b0399b3104242(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jcharArray array_inline_c_2, jsize start_inline_c_3, jsize len_inline_c_4, jchar * buf_inline_c_5) { +void inline_c_Foreign_JNI_102_a1e161a18fa39331bad743b7e07b0399b3104242(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jcharArray array_inline_c_2, jsize start_inline_c_3, jsize len_inline_c_4, jchar * buf_inline_c_5) { (*env_inline_c_0)->SetCharArrayRegion(env_inline_c_1, array_inline_c_2, start_inline_c_3, len_inline_c_4, buf_inline_c_5) ; } -void inline_c_Foreign_JNI_99_4221edb9c7b0c1666f5952fe23aad965e2f58085(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jshortArray array_inline_c_2, jsize start_inline_c_3, jsize len_inline_c_4, jshort * buf_inline_c_5) { +void inline_c_Foreign_JNI_103_4221edb9c7b0c1666f5952fe23aad965e2f58085(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jshortArray array_inline_c_2, jsize start_inline_c_3, jsize len_inline_c_4, jshort * buf_inline_c_5) { (*env_inline_c_0)->SetShortArrayRegion(env_inline_c_1, array_inline_c_2, start_inline_c_3, len_inline_c_4, buf_inline_c_5) ; } -void inline_c_Foreign_JNI_100_0cf86cc89e108bd7ed150e5aad2e7d8d8f95dd7a(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jintArray array_inline_c_2, jsize start_inline_c_3, jsize len_inline_c_4, jint * buf_inline_c_5) { +void inline_c_Foreign_JNI_104_0cf86cc89e108bd7ed150e5aad2e7d8d8f95dd7a(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jintArray array_inline_c_2, jsize start_inline_c_3, jsize len_inline_c_4, jint * buf_inline_c_5) { (*env_inline_c_0)->SetIntArrayRegion(env_inline_c_1, array_inline_c_2, start_inline_c_3, len_inline_c_4, buf_inline_c_5) ; } -void inline_c_Foreign_JNI_101_983cb43fd1962ef866086f1819815a8b05791888(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jlongArray array_inline_c_2, jsize start_inline_c_3, jsize len_inline_c_4, jlong * buf_inline_c_5) { +void inline_c_Foreign_JNI_105_983cb43fd1962ef866086f1819815a8b05791888(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jlongArray array_inline_c_2, jsize start_inline_c_3, jsize len_inline_c_4, jlong * buf_inline_c_5) { (*env_inline_c_0)->SetLongArrayRegion(env_inline_c_1, array_inline_c_2, start_inline_c_3, len_inline_c_4, buf_inline_c_5) ; } -void inline_c_Foreign_JNI_102_26c6b32031e2561eb5fc3b047d493c3a784bbf40(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jfloatArray array_inline_c_2, jsize start_inline_c_3, jsize len_inline_c_4, jfloat * buf_inline_c_5) { +void inline_c_Foreign_JNI_106_26c6b32031e2561eb5fc3b047d493c3a784bbf40(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jfloatArray array_inline_c_2, jsize start_inline_c_3, jsize len_inline_c_4, jfloat * buf_inline_c_5) { (*env_inline_c_0)->SetFloatArrayRegion(env_inline_c_1, array_inline_c_2, start_inline_c_3, len_inline_c_4, buf_inline_c_5) ; } -void inline_c_Foreign_JNI_103_fbded71aa93cca94c495be618b75c7f610619a93(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jdoubleArray array_inline_c_2, jsize start_inline_c_3, jsize len_inline_c_4, jdouble * buf_inline_c_5) { +void inline_c_Foreign_JNI_107_fbded71aa93cca94c495be618b75c7f610619a93(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jdoubleArray array_inline_c_2, jsize start_inline_c_3, jsize len_inline_c_4, jdouble * buf_inline_c_5) { (*env_inline_c_0)->SetDoubleArrayRegion(env_inline_c_1, array_inline_c_2, start_inline_c_3, len_inline_c_4, buf_inline_c_5) ; } -void inline_c_Foreign_JNI_104_5d5355f911ff38accf7df59e4f3407823efa0055(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2, jboolean * xs_inline_c_3) { +void inline_c_Foreign_JNI_108_5d5355f911ff38accf7df59e4f3407823efa0055(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2, jboolean * xs_inline_c_3) { (*env_inline_c_0)->ReleaseBooleanArrayElements(env_inline_c_1, array_inline_c_2, xs_inline_c_3, JNI_ABORT) ; } -void inline_c_Foreign_JNI_105_93701f28f0a45b8531f977f3ad28d48b747bb58c(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2, jbyte * xs_inline_c_3) { +void inline_c_Foreign_JNI_109_93701f28f0a45b8531f977f3ad28d48b747bb58c(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2, jbyte * xs_inline_c_3) { (*env_inline_c_0)->ReleaseByteArrayElements(env_inline_c_1, array_inline_c_2, xs_inline_c_3, JNI_ABORT) ; } -void inline_c_Foreign_JNI_106_d799968701da7f57e4eb07390e1efda373184222(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2, jchar * xs_inline_c_3) { +void inline_c_Foreign_JNI_110_d799968701da7f57e4eb07390e1efda373184222(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2, jchar * xs_inline_c_3) { (*env_inline_c_0)->ReleaseCharArrayElements(env_inline_c_1, array_inline_c_2, xs_inline_c_3, JNI_ABORT) ; } -void inline_c_Foreign_JNI_107_03e0c5a40ab324b1c42f0b70ceaeb6b1605a0ded(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2, jshort * xs_inline_c_3) { +void inline_c_Foreign_JNI_111_03e0c5a40ab324b1c42f0b70ceaeb6b1605a0ded(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2, jshort * xs_inline_c_3) { (*env_inline_c_0)->ReleaseShortArrayElements(env_inline_c_1, array_inline_c_2, xs_inline_c_3, JNI_ABORT) ; } -void inline_c_Foreign_JNI_108_4c2726a53e147cd6eb61733e27bfc599bc883f74(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2, jint * xs_inline_c_3) { +void inline_c_Foreign_JNI_112_4c2726a53e147cd6eb61733e27bfc599bc883f74(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2, jint * xs_inline_c_3) { (*env_inline_c_0)->ReleaseIntArrayElements(env_inline_c_1, array_inline_c_2, xs_inline_c_3, JNI_ABORT) ; } -void inline_c_Foreign_JNI_109_9e1790871e959852cb5032b3f2833c370b81bb0f(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2, jlong * xs_inline_c_3) { +void inline_c_Foreign_JNI_113_9e1790871e959852cb5032b3f2833c370b81bb0f(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2, jlong * xs_inline_c_3) { (*env_inline_c_0)->ReleaseLongArrayElements(env_inline_c_1, array_inline_c_2, xs_inline_c_3, JNI_ABORT) ; } -void inline_c_Foreign_JNI_110_44c06b418c79983d60f09ffc49851077b1feb632(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2, jfloat * xs_inline_c_3) { +void inline_c_Foreign_JNI_114_44c06b418c79983d60f09ffc49851077b1feb632(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2, jfloat * xs_inline_c_3) { (*env_inline_c_0)->ReleaseFloatArrayElements(env_inline_c_1, array_inline_c_2, xs_inline_c_3, JNI_ABORT) ; } -void inline_c_Foreign_JNI_111_94830601ce91790b75e74abe9c9819be2e748762(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2, jdouble * xs_inline_c_3) { +void inline_c_Foreign_JNI_115_94830601ce91790b75e74abe9c9819be2e748762(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobject array_inline_c_2, jdouble * xs_inline_c_3) { (*env_inline_c_0)->ReleaseDoubleArrayElements(env_inline_c_1, array_inline_c_2, xs_inline_c_3, JNI_ABORT) ; } -void inline_c_Foreign_JNI_112_7a962d5f8e6114066dca42386535e4a079022eae(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jstring jstr_inline_c_2, jchar * chars_inline_c_3) { +void inline_c_Foreign_JNI_116_7a962d5f8e6114066dca42386535e4a079022eae(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jstring jstr_inline_c_2, jchar * chars_inline_c_3) { (*env_inline_c_0)->ReleaseStringChars(env_inline_c_1, jstr_inline_c_2, @@ -657,7 +685,7 @@ } -jobject inline_c_Foreign_JNI_113_bb66272284cce01d85b6ec31967e1a66eae7e0c5(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jarray array_inline_c_2, jsize i_inline_c_3) { +jobject inline_c_Foreign_JNI_117_bb66272284cce01d85b6ec31967e1a66eae7e0c5(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jarray array_inline_c_2, jsize i_inline_c_3) { return ( (*env_inline_c_0)->GetObjectArrayElement(env_inline_c_1, array_inline_c_2, @@ -665,7 +693,7 @@ } -void inline_c_Foreign_JNI_114_c069b4edd080791f4858d4a7a48b8c42c99c8e4a(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobjectArray array_inline_c_2, jsize i_inline_c_3, jobject x_inline_c_4) { +void inline_c_Foreign_JNI_118_c069b4edd080791f4858d4a7a48b8c42c99c8e4a(JNIEnv * env_inline_c_0, JNIEnv * env_inline_c_1, jobjectArray array_inline_c_2, jsize i_inline_c_3, jobject x_inline_c_4) { (*env_inline_c_0)->SetObjectArrayElement(env_inline_c_1, array_inline_c_2, diff --git a/src/Foreign/JNI.cpphs b/src/Foreign/JNI.cpphs new file mode 100644 --- /dev/null +++ b/src/Foreign/JNI.cpphs @@ -0,0 +1,839 @@ +-- | Low-level bindings to the Java Native Interface (JNI). +-- +-- Read the +-- +-- for authoritative documentation as to what each of the functions in +-- this module does. The names of the bindings in this module were chosen to +-- match the names of the functions in the JNI spec. +-- +-- All bindings in this module access the JNI via a thread-local variable of +-- type @JNIEnv *@. If the current OS thread has not yet been "attached" to the +-- JVM, it is attached implicitly upon the first call to one of these bindings +-- in the current thread. +-- +-- The 'String' type in this module is the type of JNI strings. See +-- "Foreign.JNI.String". + +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE ViewPatterns #-} + +-- XXX pgmP directive should be redundant. But necessary to workaround +-- https://github.com/haskell/cabal/issues/4278. +{-# OPTIONS_GHC -fno-warn-name-shadowing -pgmPcpphs -optP--cpp #-} + +-- XXX This file uses cpphs for preprocessing instead of the system's native +-- CPP, because the OS X has subtly different whitespace behaviour in the +-- presence of concatenation. + +module Foreign.JNI + ( -- * JNI functions + -- ** VM creation + withJVM + -- ** Class loading + , defineClass + , JNINativeMethod(..) + , registerNatives + -- ** Exceptions + , JVMException(..) + , throw + , throwNew + -- ** Query functions + , findClass + , getFieldID + , getStaticFieldID + , getMethodID + , getStaticMethodID + , getObjectClass + -- ** Reference manipulation + , newGlobalRef + , deleteGlobalRef + , newLocalRef + , deleteLocalRef + , pushLocalFrame + , popLocalFrame + -- ** Field accessor functions + -- *** Get fields + , getObjectField + , getBooleanField + , getIntField + , getLongField + , getCharField + , getShortField + , getByteField + , getDoubleField + , getFloatField + -- *** Get static fields + , getStaticObjectField + , getStaticBooleanField + , getStaticIntField + , getStaticLongField + , getStaticCharField + , getStaticShortField + , getStaticByteField + , getStaticDoubleField + , getStaticFloatField + -- *** Set fields + , setObjectField + , setBooleanField + , setIntField + , setLongField + , setCharField + , setShortField + , setByteField + , setDoubleField + , setFloatField + -- *** Set static fields + , setStaticObjectField + , setStaticBooleanField + , setStaticIntField + , setStaticLongField + , setStaticCharField + , setStaticShortField + , setStaticByteField + , setStaticDoubleField + , setStaticFloatField + -- ** Method invocation + , callObjectMethod + , callBooleanMethod + , callIntMethod + , callLongMethod + , callCharMethod + , callShortMethod + , callByteMethod + , callDoubleMethod + , callFloatMethod + , callVoidMethod + , callStaticObjectMethod + , callStaticVoidMethod + , callStaticBooleanMethod + , callStaticIntMethod + , callStaticLongMethod + , callStaticCharMethod + , callStaticShortMethod + , callStaticByteMethod + , callStaticDoubleMethod + , callStaticFloatMethod + -- ** Object construction + , newObject + , newString + , newObjectArray + , newBooleanArray + , newByteArray + , newCharArray + , newShortArray + , newIntArray + , newLongArray + , newFloatArray + , newDoubleArray + -- ** Array manipulation + , getArrayLength + , getStringLength + , ArrayCopyFailed(..) + , getBooleanArrayElements + , getByteArrayElements + , getCharArrayElements + , getShortArrayElements + , getIntArrayElements + , getLongArrayElements + , getFloatArrayElements + , getDoubleArrayElements + , getStringChars + , setBooleanArrayRegion + , setByteArrayRegion + , setCharArrayRegion + , setShortArrayRegion + , setIntArrayRegion + , setLongArrayRegion + , setFloatArrayRegion + , setDoubleArrayRegion + , releaseBooleanArrayElements + , releaseByteArrayElements + , releaseCharArrayElements + , releaseShortArrayElements + , releaseIntArrayElements + , releaseLongArrayElements + , releaseFloatArrayElements + , releaseDoubleArrayElements + , releaseStringChars + , getObjectArrayElement + , setObjectArrayElement + ) where + +import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar) +import Control.Exception (Exception, bracket, finally, throwIO) +import Control.Monad (join, unless, void, when) +import Data.Choice +import Data.Coerce +import Data.Int +import Data.IORef (IORef, newIORef, readIORef, atomicModifyIORef) +import Data.Word +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.Monoid ((<>)) +import Data.Typeable (Typeable) +import Data.TLS.PThread +import Foreign.C (CChar) +import Foreign.ForeignPtr + ( finalizeForeignPtr + , newForeignPtr_ + , withForeignPtr + ) +import Foreign.JNI.NativeMethod +import Foreign.JNI.Types +import qualified Foreign.JNI.String as JNI +import Foreign.Marshal.Array +import Foreign.Ptr (Ptr, nullPtr) +import GHC.ForeignPtr (newConcForeignPtr) +import qualified Language.C.Inline as C +import qualified Language.C.Inline.Unsafe as CU +import System.IO.Unsafe (unsafePerformIO) +import Prelude hiding (String) + +C.context (C.baseCtx <> C.bsCtx <> jniCtx) + +C.include "" +C.include "" +C.include "" + +-- | A JNI call may cause a (Java) exception to be raised. This module raises it +-- as a Haskell exception wrapping the Java exception. +newtype JVMException = JVMException JThrowable + deriving (Show, Typeable) + +instance Exception JVMException + +-- | Thrown when @GetArrayElements@ returns a null pointer, +-- because it wanted to copy the array contents but couldn't. In this case the +-- JVM doesn't throw OutOfMemory according to the JNI spec. +data ArrayCopyFailed = ArrayCopyFailed + deriving (Show, Typeable) + +instance Exception ArrayCopyFailed + +objectFromPtr :: Ptr (J a) -> IO (J a) +objectFromPtr ptr = J <$> newForeignPtr_ ptr + +-- | Map Java exceptions to Haskell exceptions. +throwIfException :: Ptr JNIEnv -> IO a -> IO a +throwIfException env m = m `finally` do + excptr <- [CU.exp| jthrowable { (*$(JNIEnv *env))->ExceptionOccurred($(JNIEnv *env)) } |] + unless (excptr == nullPtr) $ do + [CU.exp| void { (*$(JNIEnv *env))->ExceptionDescribe($(JNIEnv *env)) } |] + [CU.exp| void { (*$(JNIEnv *env))->ExceptionClear($(JNIEnv *env)) } |] + throwIO . JVMException =<< newGlobalRef =<< objectFromPtr excptr + +-- | Check whether a pointer is null. +throwIfNull :: IO (Ptr a) -> IO (Ptr a) +throwIfNull m = do + ptr <- m + if ptr == nullPtr + then throwIO ArrayCopyFailed + else return ptr + +-- | A read-write lock +-- +-- Concurrent readers are allowed, but only one writer is supported. +newtype RWLock = + RWLock (IORef (Int, RWWantedState)) + -- ^ A count of the held read locks and the wanted state + +-- | The wanted state of the RW +data RWWantedState + = Reading -- ^ There are no writers + | Writing (MVar ()) + -- ^ A writer wants to write, grant no more read locks. The MVar is used + -- to notify the writer when the currently held read locks are released. + +-- | Creates a new read-write lock. +newRWLock :: IO RWLock +newRWLock = RWLock <$> newIORef (0, Reading) + +-- | Tries to acquire a read lock. If this call returns `Do #read`, no writer +-- will be granted a lock before the read lock is released. +tryAcquireReadLock :: RWLock -> IO (Choice "read") +tryAcquireReadLock (RWLock ref) = do + atomicModifyIORef ref $ \case + (!readers, Reading) -> ((readers + 1, Reading), Do #read) + st -> ( st, Don't #read) + +-- | Releases a read lock. +releaseReadLock :: RWLock -> IO () +releaseReadLock (RWLock ref) = do + st <- atomicModifyIORef ref $ + \st@(readers, aim) -> ((readers - 1, aim), st) + case st of + -- Notify the writer if I'm the last reader. + (0, Writing mv) -> putMVar mv () + _ -> return () + +-- | Waits until the current read locks are released and grants a write lock. +acquireWriteLock :: RWLock -> IO () +acquireWriteLock (RWLock ref) = do + mv <- newEmptyMVar + join $ atomicModifyIORef ref $ \case + (0, _) -> ((0, Writing mv), return ()) + st -> ( st, takeMVar mv) + +-- | This lock is used to avoid the JVM from dying before any finalizers +-- deleting global references are finished. +-- +-- Finalizers try to acquire read locks. +-- +-- The JVM acquires a write lock before shutdown. Thence, finalizers fail to +-- acquire read locks and behave as noops. +globalJVMLock :: RWLock +globalJVMLock = unsafePerformIO newRWLock +{-# NOINLINE globalJVMLock #-} + +-- | A global mutable cell holding the TLS variable, whose content is set once +-- for each thread. +envTlsRef :: IORef (TLS (Ptr JNIEnv)) +{-# NOINLINE envTlsRef #-} +envTlsRef = unsafePerformIO $ do + -- It doesn't matter if this computation ends up running twice, say because + -- of lazy blackholing. + !tls <- mkTLS $ [C.block| JNIEnv* { + jsize num_jvms; + JavaVM *jvm; + /* Assume there's at most one JVM. The current JNI spec (2016) says only + * one JVM per process is supported anyways. */ + JNI_GetCreatedJavaVMs(&jvm, 1, &num_jvms); + JNIEnv *env; + + if(!num_jvms) { + fprintf(stderr, "No JVM has been initialized yet.\n"); + exit(EFAULT); + } + + /* Attach as daemon to match GHC's usual semantics for threads, which are + * daemonic. + */ + (*jvm)->AttachCurrentThreadAsDaemon(jvm, (void**)&env, NULL); + return env; } |] + newIORef tls + +-- | Run an action against the appropriate 'JNIEnv'. +-- +-- Each OS thread has its own 'JNIEnv', which this function gives access to. +-- +-- TODO check whether this call is only safe from a (bound) thread. +withJNIEnv :: (Ptr JNIEnv -> IO a) -> IO a +withJNIEnv f = f =<< getTLS =<< readIORef envTlsRef + +useAsCStrings :: [ByteString] -> ([Ptr CChar] -> IO a) -> IO a +useAsCStrings strs m = + foldr (\str k cstrs -> BS.useAsCString str $ \cstr -> k (cstr:cstrs)) m strs [] + +-- | Create a new JVM, with the given arguments. /Can only be called once/. Best +-- practice: use it to wrap your @main@ function. +withJVM :: [ByteString] -> IO a -> IO a +withJVM options action = + bracket ini fini (const action) + where + ini = do + useAsCStrings options $ \cstrs -> do + withArray cstrs $ \(coptions :: Ptr (Ptr CChar)) -> do + let n = fromIntegral (length cstrs) :: C.CInt + [C.block| JavaVM * { + JavaVM *jvm; + JNIEnv *env; + JavaVMInitArgs vm_args; + JavaVMOption *options = malloc(sizeof(JavaVMOption) * $(int n)); + for(int i = 0; i < $(int n); i++) + options[i].optionString = $(char **coptions)[i]; + vm_args.version = JNI_VERSION_1_6; + vm_args.nOptions = $(int n); + vm_args.options = options; + vm_args.ignoreUnrecognized = 0; + JNI_CreateJavaVM(&jvm, (void**)&env, &vm_args); + free(options); + return jvm; } |] + fini jvm = do + acquireWriteLock globalJVMLock + [C.block| void { (*$(JavaVM *jvm))->DestroyJavaVM($(JavaVM *jvm)); } |] + +defineClass + :: Coercible o (J ('Class "java.lang.ClassLoader")) + => JNI.String -- ^ Class name + -> o -- ^ Loader + -> ByteString -- ^ Bytecode buffer + -> IO JClass +defineClass name (coerce -> upcast -> loader) buf = withJNIEnv $ \env -> + throwIfException env $ + JNI.withString name $ \namep -> + objectFromPtr =<< + [CU.exp| jclass { + (*$(JNIEnv *env))->DefineClass($(JNIEnv *env), + $(char *namep), + $fptr-ptr:(jobject loader), + $bs-ptr:buf, + $bs-len:buf) } |] +registerNatives + :: JClass + -> [JNINativeMethod] + -> IO () +registerNatives cls methods = withJNIEnv $ \env -> + throwIfException env $ + withArray methods $ \cmethods -> do + let numMethods = fromIntegral $ length methods + _ <- [CU.exp| jint { + (*$(JNIEnv *env))->RegisterNatives($(JNIEnv *env), + $fptr-ptr:(jclass cls), + $(JNINativeMethod *cmethods), + $(int numMethods)) } |] + return () + +throw :: Coercible o (J a) => o -> IO () +throw (coerce -> upcast -> obj) = withJNIEnv $ \env -> void $ do + [CU.exp| jint { + (*$(JNIEnv *env))->Throw($(JNIEnv *env), + $fptr-ptr:(jobject obj)) } |] + +throwNew :: JClass -> JNI.String -> IO () +throwNew cls msg = withJNIEnv $ \env -> + JNI.withString msg $ \msgp -> void $ do + [CU.exp| jint { + (*$(JNIEnv *env))->ThrowNew($(JNIEnv *env), + $fptr-ptr:(jclass cls), + $(char *msgp)) } |] + +findClass + :: JNI.String -- ^ Class name + -> IO JClass +findClass name = withJNIEnv $ \env -> + throwIfException env $ + JNI.withString name $ \namep -> + objectFromPtr =<< + [CU.exp| jclass { (*$(JNIEnv *env))->FindClass($(JNIEnv *env), $(char *namep)) } |] + +newObject :: JClass -> JNI.String -> [JValue] -> IO JObject +newObject cls sig args = withJNIEnv $ \env -> + throwIfException env $ + withJValues args $ \cargs -> do + constr <- getMethodID cls "" sig + objectFromPtr =<< [CU.exp| jobject { + (*$(JNIEnv *env))->NewObjectA($(JNIEnv *env), + $fptr-ptr:(jclass cls), + $(jmethodID constr), + $(jvalue *cargs)) } |] + +getFieldID + :: JClass -- ^ A class object as returned by 'findClass' + -> JNI.String -- ^ Field name + -> JNI.String -- ^ JNI signature + -> IO JFieldID +getFieldID cls fieldname sig = withJNIEnv $ \env -> + throwIfException env $ + JNI.withString fieldname $ \fieldnamep -> + JNI.withString sig $ \sigp -> + [CU.exp| jfieldID { + (*$(JNIEnv *env))->GetFieldID($(JNIEnv *env), + $fptr-ptr:(jclass cls), + $(char *fieldnamep), + $(char *sigp)) } |] + +getStaticFieldID + :: JClass -- ^ A class object as returned by 'findClass' + -> JNI.String -- ^ Field name + -> JNI.String -- ^ JNI signature + -> IO JFieldID +getStaticFieldID cls fieldname sig = withJNIEnv $ \env -> + throwIfException env $ + JNI.withString fieldname $ \fieldnamep -> + JNI.withString sig $ \sigp -> + [CU.exp| jfieldID { + (*$(JNIEnv *env))->GetStaticFieldID($(JNIEnv *env), + $fptr-ptr:(jclass cls), + $(char *fieldnamep), + $(char *sigp)) } |] + +#define GET_FIELD(name, hs_rettype, c_rettype) \ +get/**/name/**/Field :: Coercible o (J a) => o -> JFieldID -> IO hs_rettype; \ +get/**/name/**/Field (coerce -> upcast -> obj) field = withJNIEnv $ \env -> \ + throwIfException env $ \ + [CU.exp| c_rettype { \ + (*$(JNIEnv *env))->Get/**/name/**/Field($(JNIEnv *env), \ + $fptr-ptr:(jobject obj), \ + $(jfieldID field)) } |] + +getObjectField :: Coercible o (J a) => o -> JFieldID -> IO JObject +getObjectField x y = + let GET_FIELD(Object, (Ptr JObject), jobject) + in objectFromPtr =<< getObjectField x y +GET_FIELD(Boolean, Word8, jboolean) +GET_FIELD(Byte, CChar, jbyte) +GET_FIELD(Char, Word16, jchar) +GET_FIELD(Short, Int16, jshort) +GET_FIELD(Int, Int32, jint) +GET_FIELD(Long, Int64, jlong) +GET_FIELD(Float, Float, jfloat) +GET_FIELD(Double, Double, jdouble) + +#define GET_STATIC_FIELD(name, hs_rettype, c_rettype) \ +getStatic/**/name/**/Field :: JClass -> JFieldID -> IO hs_rettype; \ +getStatic/**/name/**/Field klass field = withJNIEnv $ \env -> \ + throwIfException env $ \ + [CU.exp| c_rettype { \ + (*$(JNIEnv *env))->GetStatic/**/name/**/Field($(JNIEnv *env), \ + $fptr-ptr:(jclass klass), \ + $(jfieldID field)) } |] + +getStaticObjectField :: JClass -> JFieldID -> IO JObject +getStaticObjectField x y = + let GET_STATIC_FIELD(Object, (Ptr JObject), jobject) + in objectFromPtr =<< getStaticObjectField x y +GET_STATIC_FIELD(Boolean, Word8, jboolean) +GET_STATIC_FIELD(Byte, CChar, jbyte) +GET_STATIC_FIELD(Char, Word16, jchar) +GET_STATIC_FIELD(Short, Int16, jshort) +GET_STATIC_FIELD(Int, Int32, jint) +GET_STATIC_FIELD(Long, Int64, jlong) +GET_STATIC_FIELD(Float, Float, jfloat) +GET_STATIC_FIELD(Double, Double, jdouble) + +#define SET_FIELD(name, hs_fieldtype, c_fieldtype) \ +set/**/name/**/Field :: Coercible o (J a) => o -> JFieldID -> hs_fieldtype -> IO (); \ +set/**/name/**/Field (coerce -> upcast -> obj) field x = \ + withJNIEnv $ \env -> \ + throwIfException env $ \ + [CU.block| void { \ + (*$(JNIEnv *env))->Set/**/name/**/Field($(JNIEnv *env), \ + $fptr-ptr:(jobject obj), \ + $(jfieldID field), \ + $(c_fieldtype x)); } |] + +setObjectField :: Coercible o (J a) => o -> JFieldID -> JObject -> IO () +setObjectField x y z = + let SET_FIELD(Object, (Ptr JObject), jobject) + in withForeignPtr (coerce z) (setObjectField x y) +SET_FIELD(Boolean, Word8, jboolean) +SET_FIELD(Byte, CChar, jbyte) +SET_FIELD(Char, Word16, jchar) +SET_FIELD(Short, Int16, jshort) +SET_FIELD(Int, Int32, jint) +SET_FIELD(Long, Int64, jlong) +SET_FIELD(Float, Float, jfloat) +SET_FIELD(Double, Double, jdouble) + +#define SET_STATIC_FIELD(name, hs_fieldtype, c_fieldtype) \ +setStatic/**/name/**/Field :: JClass -> JFieldID -> hs_fieldtype -> IO (); \ +setStatic/**/name/**/Field klass field x = \ + withJNIEnv $ \env -> \ + throwIfException env $ \ + [CU.block| void { \ + (*$(JNIEnv *env))->SetStatic/**/name/**/Field($(JNIEnv *env), \ + $fptr-ptr:(jclass klass), \ + $(jfieldID field), \ + $(c_fieldtype x)); } |] + +setStaticObjectField :: JClass -> JFieldID -> JObject -> IO () +setStaticObjectField x y z = + let SET_STATIC_FIELD(Object, (Ptr JObject), jobject) + in withForeignPtr (coerce z) (setStaticObjectField x y) +SET_STATIC_FIELD(Boolean, Word8, jboolean) +SET_STATIC_FIELD(Byte, CChar, jbyte) +SET_STATIC_FIELD(Char, Word16, jchar) +SET_STATIC_FIELD(Short, Int16, jshort) +SET_STATIC_FIELD(Int, Int32, jint) +SET_STATIC_FIELD(Long, Int64, jlong) +SET_STATIC_FIELD(Float, Float, jfloat) +SET_STATIC_FIELD(Double, Double, jdouble) + +getMethodID + :: JClass -- ^ A class object as returned by 'findClass' + -> JNI.String -- ^ Field name + -> JNI.String -- ^ JNI signature + -> IO JMethodID +getMethodID cls methodname sig = withJNIEnv $ \env -> + throwIfException env $ + JNI.withString methodname $ \methodnamep -> + JNI.withString sig $ \sigp -> + [CU.exp| jmethodID { + (*$(JNIEnv *env))->GetMethodID($(JNIEnv *env), + $fptr-ptr:(jclass cls), + $(char *methodnamep), + $(char *sigp)) } |] + +getStaticMethodID + :: JClass -- ^ A class object as returned by 'findClass' + -> JNI.String -- ^ Field name + -> JNI.String -- ^ JNI signature + -> IO JMethodID +getStaticMethodID cls methodname sig = withJNIEnv $ \env -> + throwIfException env $ + JNI.withString methodname $ \methodnamep -> + JNI.withString sig $ \sigp -> + [CU.exp| jmethodID { + (*$(JNIEnv *env))->GetStaticMethodID($(JNIEnv *env), + $fptr-ptr:(jclass cls), + $(char *methodnamep), + $(char *sigp)) } |] + +getObjectClass :: Coercible o (J ty) => o -> IO JClass +getObjectClass (coerce -> upcast -> obj) = withJNIEnv $ \env -> + objectFromPtr =<< + [CU.exp| jclass { + (*$(JNIEnv *env))->GetObjectClass($(JNIEnv *env), + $fptr-ptr:(jobject obj)) } |] + +-- | Creates a global reference to the object referred to by +-- the given reference. +-- +-- Arranges for a finalizer to call 'deleteGlobalRef' when the +-- global reference is no longer reachable on the Haskell side. +newGlobalRef :: Coercible o (J ty) => o -> IO o +newGlobalRef (coerce -> upcast -> obj) = withJNIEnv $ \env -> do + gobj <- + [CU.exp| jobject { + (*$(JNIEnv *env))->NewGlobalRef($(JNIEnv *env), + $fptr-ptr:(jobject obj)) } |] + coerce <$> J <$> newConcForeignPtr gobj (finalize gobj) + where + finalize gobj = do + bracket (tryAcquireReadLock globalJVMLock) + (\doRead -> when (toBool doRead) $ releaseReadLock globalJVMLock) + $ \doRead -> + when (toBool doRead) $ withJNIEnv $ \env -> + [CU.block| void { (*$(JNIEnv *env))->DeleteGlobalRef($(JNIEnv *env) + ,$(jobject gobj)); + } |] + +deleteGlobalRef :: Coercible o (J ty) => o -> IO () +deleteGlobalRef (coerce -> J p) = finalizeForeignPtr p + +-- NB: Cannot add a finalizer to local references because it may +-- run in a thread where the reference is not valid. +newLocalRef :: Coercible o (J ty) => o -> IO (J ty) +newLocalRef (coerce -> upcast -> obj) = withJNIEnv $ \env -> + unsafeCast <$> (objectFromPtr =<<) + [CU.exp| jobject { + (*$(JNIEnv *env))->NewLocalRef($(JNIEnv *env), + $fptr-ptr:(jobject obj)) } |] + +deleteLocalRef :: Coercible o (J ty) => o -> IO () +deleteLocalRef (coerce -> upcast -> obj) = withJNIEnv $ \env -> + [CU.exp| void { + (*$(JNIEnv *env))->DeleteLocalRef($(JNIEnv *env), + $fptr-ptr:(jobject obj)) } |] + +pushLocalFrame :: Int32 -> IO () +pushLocalFrame (coerce -> capacity) = withJNIEnv $ \env -> + -- We ignore the output as it is always 0 on success and throws an + -- exception otherwise. + throwIfException env $ void $ + [CU.block| jint { + (*$(JNIEnv *env))->PushLocalFrame($(JNIEnv *env), + $(jint capacity)); } |] + +popLocalFrame :: Coercible o (J ty) => o -> IO o +popLocalFrame (coerce -> upcast -> obj) = withJNIEnv $ \env -> + coerce <$> (objectFromPtr =<<) + [CU.exp| jobject { + (*$(JNIEnv *env))->PopLocalFrame($(JNIEnv *env), + $fptr-ptr:(jobject obj)) } |] + +-- Modern CPP does have ## for concatenating strings, but we use the hacky /**/ +-- comment syntax for string concatenation. This is because GHC passes +-- the -traditional flag to the preprocessor by default, which turns off several +-- modern CPP features. + +#define CALL_METHOD(name, hs_rettype, c_rettype) \ +call/**/name/**/Method :: Coercible o (J a) => o -> JMethodID -> [JValue] -> IO hs_rettype; \ +call/**/name/**/Method (coerce -> upcast -> obj) method args = withJNIEnv $ \env -> \ + throwIfException env $ \ + withJValues args $ \cargs -> \ + [C.exp| c_rettype { \ + (*$(JNIEnv *env))->Call/**/name/**/MethodA($(JNIEnv *env), \ + $fptr-ptr:(jobject obj), \ + $(jmethodID method), \ + $(jvalue *cargs)) } |] + +CALL_METHOD(Void, (), void) +callObjectMethod :: Coercible o (J a) => o -> JMethodID -> [JValue] -> IO JObject +callObjectMethod x y z = + let CALL_METHOD(Object, (Ptr JObject), jobject) + in objectFromPtr =<< callObjectMethod x y z +callBooleanMethod :: Coercible o (J a) => o -> JMethodID -> [JValue] -> IO Bool +callBooleanMethod x y z = + let CALL_METHOD(Boolean, Word8, jboolean) + in toEnum . fromIntegral <$> callBooleanMethod x y z +CALL_METHOD(Byte, CChar, jbyte) +CALL_METHOD(Char, Word16, jchar) +CALL_METHOD(Short, Int16, jshort) +CALL_METHOD(Int, Int32, jint) +CALL_METHOD(Long, Int64, jlong) +CALL_METHOD(Float, Float, jfloat) +CALL_METHOD(Double, Double, jdouble) + +#define CALL_STATIC_METHOD(name, hs_rettype, c_rettype) \ +callStatic/**/name/**/Method :: JClass -> JMethodID -> [JValue] -> IO hs_rettype; \ +callStatic/**/name/**/Method cls method args = withJNIEnv $ \env -> \ + throwIfException env $ \ + withJValues args $ \cargs -> \ + [C.exp| c_rettype { \ + (*$(JNIEnv *env))->CallStatic/**/name/**/MethodA($(JNIEnv *env), \ + $fptr-ptr:(jclass cls), \ + $(jmethodID method), \ + $(jvalue *cargs)) } |] + +CALL_STATIC_METHOD(Void, (), void) +callStaticObjectMethod :: JClass -> JMethodID -> [JValue] -> IO JObject +callStaticObjectMethod x y z = + let CALL_STATIC_METHOD(Object, (Ptr JObject), jobject) + in objectFromPtr =<< callStaticObjectMethod x y z +callStaticBooleanMethod :: JClass -> JMethodID -> [JValue] -> IO Bool +callStaticBooleanMethod x y z = + let CALL_STATIC_METHOD(Boolean, Word8, jboolean) + in toEnum . fromIntegral <$> callStaticBooleanMethod x y z +CALL_STATIC_METHOD(Byte, CChar, jbyte) +CALL_STATIC_METHOD(Char, Word16, jchar) +CALL_STATIC_METHOD(Short, Int16, jshort) +CALL_STATIC_METHOD(Int, Int32, jint) +CALL_STATIC_METHOD(Long, Int64, jlong) +CALL_STATIC_METHOD(Float, Float, jfloat) +CALL_STATIC_METHOD(Double, Double, jdouble) + +newObjectArray :: Int32 -> JClass -> IO JObjectArray +newObjectArray sz cls = withJNIEnv $ \env -> + throwIfException env $ + objectFromPtr =<< + [CU.exp| jobjectArray { + (*$(JNIEnv *env))->NewObjectArray($(JNIEnv *env), + $(jsize sz), + $fptr-ptr:(jclass cls), + NULL) } |] + +#define NEW_ARRAY(name, c_rettype) \ +new/**/name/**/Array :: Int32 -> IO J/**/name/**/Array; \ +new/**/name/**/Array sz = withJNIEnv $ \env -> \ + throwIfException env $ \ + objectFromPtr =<< \ + [CU.exp| c_rettype/**/Array { \ + (*$(JNIEnv *env))->New/**/name/**/Array($(JNIEnv *env), \ + $(jsize sz)) } |] + +NEW_ARRAY(Boolean, jboolean) +NEW_ARRAY(Byte, jbyte) +NEW_ARRAY(Char, jchar) +NEW_ARRAY(Short, jshort) +NEW_ARRAY(Int, jint) +NEW_ARRAY(Long, jlong) +NEW_ARRAY(Float, jfloat) +NEW_ARRAY(Double, jdouble) + +newString :: Ptr Word16 -> Int32 -> IO JString +newString ptr len = withJNIEnv $ \env -> + throwIfException env $ + objectFromPtr =<< + [CU.exp| jstring { + (*$(JNIEnv *env))->NewString($(JNIEnv *env), + $(jchar *ptr), + $(jsize len)) } |] + +getArrayLength :: Coercible o (JArray a) => o -> IO Int32 +getArrayLength (coerce -> upcast -> array) = withJNIEnv $ \env -> + [C.exp| jsize { + (*$(JNIEnv *env))->GetArrayLength($(JNIEnv *env), + $fptr-ptr:(jarray array)) } |] + +getStringLength :: JString -> IO Int32 +getStringLength jstr = withJNIEnv $ \env -> + [CU.exp| jsize { + (*$(JNIEnv *env))->GetStringLength($(JNIEnv *env), + $fptr-ptr:(jstring jstr)) } |] + +#define GET_ARRAY_ELEMENTS(name, hs_rettype, c_rettype) \ +get/**/name/**/ArrayElements :: J/**/name/**/Array -> IO (Ptr hs_rettype); \ +get/**/name/**/ArrayElements (upcast -> array) = withJNIEnv $ \env -> \ + throwIfNull $ \ + [CU.exp| c_rettype* { \ + (*$(JNIEnv *env))->Get/**/name/**/ArrayElements($(JNIEnv *env), \ + $fptr-ptr:(jobject array), \ + NULL) } |] + +GET_ARRAY_ELEMENTS(Boolean, Word8, jboolean) +GET_ARRAY_ELEMENTS(Byte, CChar, jbyte) +GET_ARRAY_ELEMENTS(Char, Word16, jchar) +GET_ARRAY_ELEMENTS(Short, Int16, jshort) +GET_ARRAY_ELEMENTS(Int, Int32, jint) +GET_ARRAY_ELEMENTS(Long, Int64, jlong) +GET_ARRAY_ELEMENTS(Float, Float, jfloat) +GET_ARRAY_ELEMENTS(Double, Double, jdouble) + +getStringChars :: JString -> IO (Ptr Word16) +getStringChars jstr = withJNIEnv $ \env -> + throwIfNull $ + [CU.exp| const jchar* { + (*$(JNIEnv *env))->GetStringChars($(JNIEnv *env), + $fptr-ptr:(jstring jstr), + NULL) } |] + +#define SET_ARRAY_REGION(name, hs_argtype, c_argtype) \ +set/**/name/**/ArrayRegion :: J/**/name/**/Array -> Int32 -> Int32 -> Ptr hs_argtype -> IO (); \ +set/**/name/**/ArrayRegion array start len buf = withJNIEnv $ \env -> \ + throwIfException env $ \ + [CU.exp| void { \ + (*$(JNIEnv *env))->Set/**/name/**/ArrayRegion($(JNIEnv *env), \ + $fptr-ptr:(c_argtype/**/Array array), \ + $(jsize start), \ + $(jsize len), \ + $(c_argtype *buf)) } |] + +SET_ARRAY_REGION(Boolean, Word8, jboolean) +SET_ARRAY_REGION(Byte, CChar, jbyte) +SET_ARRAY_REGION(Char, Word16, jchar) +SET_ARRAY_REGION(Short, Int16, jshort) +SET_ARRAY_REGION(Int, Int32, jint) +SET_ARRAY_REGION(Long, Int64, jlong) +SET_ARRAY_REGION(Float, Float, jfloat) +SET_ARRAY_REGION(Double, Double, jdouble) + +#define RELEASE_ARRAY_ELEMENTS(name, hs_argtype, c_argtype) \ +release/**/name/**/ArrayElements :: J/**/name/**/Array -> Ptr hs_argtype -> IO (); \ +release/**/name/**/ArrayElements (upcast -> array) xs = withJNIEnv $ \env -> \ + [CU.exp| void { \ + (*$(JNIEnv *env))->Release/**/name/**/ArrayElements($(JNIEnv *env), \ + $fptr-ptr:(jobject array), \ + $(c_argtype *xs), \ + JNI_ABORT) } |] + +RELEASE_ARRAY_ELEMENTS(Boolean, Word8, jboolean) +RELEASE_ARRAY_ELEMENTS(Byte, CChar, jbyte) +RELEASE_ARRAY_ELEMENTS(Char, Word16, jchar) +RELEASE_ARRAY_ELEMENTS(Short, Int16, jshort) +RELEASE_ARRAY_ELEMENTS(Int, Int32, jint) +RELEASE_ARRAY_ELEMENTS(Long, Int64, jlong) +RELEASE_ARRAY_ELEMENTS(Float, Float, jfloat) +RELEASE_ARRAY_ELEMENTS(Double, Double, jdouble) + +releaseStringChars :: JString -> Ptr Word16 -> IO () +releaseStringChars jstr chars = withJNIEnv $ \env -> + [CU.exp| void { + (*$(JNIEnv *env))->ReleaseStringChars($(JNIEnv *env), + $fptr-ptr:(jstring jstr), + $(jchar *chars)) } |] + +getObjectArrayElement :: Coercible o (JArray a) => o -> Int32 -> IO (J a) +getObjectArrayElement (coerce -> upcast -> array) i = withJNIEnv $ \env -> + unsafeCast <$> (objectFromPtr =<<) + [C.exp| jobject { + (*$(JNIEnv *env))->GetObjectArrayElement($(JNIEnv *env), + $fptr-ptr:(jarray array), + $(jsize i)) } |] + +setObjectArrayElement :: Coercible o (J a) => JObjectArray -> Int32 -> o -> IO () +setObjectArrayElement array i (coerce -> upcast -> x) = withJNIEnv $ \env -> + [C.exp| void { + (*$(JNIEnv *env))->SetObjectArrayElement($(JNIEnv *env), + $fptr-ptr:(jobjectArray array), + $(jsize i), + $fptr-ptr:(jobject x)); } |] diff --git a/src/Foreign/JNI.hs b/src/Foreign/JNI.hs deleted file mode 100644 --- a/src/Foreign/JNI.hs +++ /dev/null @@ -1,686 +0,0 @@ --- | Low-level bindings to the Java Native Interface (JNI). --- --- Read the --- --- for authoritative documentation as to what each of the functions in --- this module does. The names of the bindings in this module were chosen to --- match the names of the functions in the JNI spec. --- --- All bindings in this module access the JNI via a thread-local variable of --- type @JNIEnv *@. If the current OS thread has not yet been "attached" to the --- JVM, it is attached implicitly upon the first call to one of these bindings --- in the current thread. --- --- The 'String' type in this module is the type of JNI strings. See "Foreign.JNI.String". -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE ExplicitNamespaces #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE ViewPatterns #-} - -{-# OPTIONS_GHC -fno-warn-name-shadowing #-} - -module Foreign.JNI - ( -- * JNI functions - -- ** VM creation - withJVM - -- ** Class loading - , defineClass - , JNINativeMethod(..) - , registerNatives - -- ** Exceptions - , throw - , throwNew - -- ** Query functions - , findClass - , getFieldID - , getStaticFieldID - , getMethodID - , getStaticMethodID - , getObjectClass - -- ** Reference manipulation - , newGlobalRef - , deleteGlobalRef - -- ** Field accessor functions - -- *** Get fields - , getObjectField - , getBooleanField - , getIntField - , getLongField - , getCharField - , getShortField - , getByteField - , getDoubleField - , getFloatField - -- *** Get static fields - , getStaticObjectField - , getStaticBooleanField - , getStaticIntField - , getStaticLongField - , getStaticCharField - , getStaticShortField - , getStaticByteField - , getStaticDoubleField - , getStaticFloatField - -- *** Set fields - , setObjectField - , setBooleanField - , setIntField - , setLongField - , setCharField - , setShortField - , setByteField - , setDoubleField - , setFloatField - -- *** Set static fields - , setStaticObjectField - , setStaticBooleanField - , setStaticIntField - , setStaticLongField - , setStaticCharField - , setStaticShortField - , setStaticByteField - , setStaticDoubleField - , setStaticFloatField - -- ** Method invocation - , callObjectMethod - , callBooleanMethod - , callIntMethod - , callLongMethod - , callCharMethod - , callShortMethod - , callByteMethod - , callDoubleMethod - , callFloatMethod - , callVoidMethod - , callStaticObjectMethod - , callStaticVoidMethod - , callStaticBooleanMethod - , callStaticIntMethod - , callStaticLongMethod - , callStaticCharMethod - , callStaticShortMethod - , callStaticByteMethod - , callStaticDoubleMethod - , callStaticFloatMethod - -- ** Object construction - , newObject - , newString - , newObjectArray - , newBooleanArray - , newByteArray - , newCharArray - , newShortArray - , newIntArray - , newLongArray - , newFloatArray - , newDoubleArray - -- ** Array manipulation - , getArrayLength - , getStringLength - , getBooleanArrayElements - , getByteArrayElements - , getCharArrayElements - , getShortArrayElements - , getIntArrayElements - , getLongArrayElements - , getFloatArrayElements - , getDoubleArrayElements - , getStringChars - , setBooleanArrayRegion - , setByteArrayRegion - , setCharArrayRegion - , setShortArrayRegion - , setIntArrayRegion - , setLongArrayRegion - , setFloatArrayRegion - , setDoubleArrayRegion - , releaseBooleanArrayElements - , releaseByteArrayElements - , releaseCharArrayElements - , releaseShortArrayElements - , releaseIntArrayElements - , releaseLongArrayElements - , releaseFloatArrayElements - , releaseDoubleArrayElements - , releaseStringChars - , getObjectArrayElement - , setObjectArrayElement - ) where - -import Control.Exception (Exception, bracket, finally, throwIO) -import Control.Monad (unless, void) -import Data.Coerce -import Data.Int -import Data.IORef (IORef, newIORef, readIORef) -import Data.Word -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS -import Data.Monoid ((<>)) -import Data.Typeable (Typeable) -import Data.TLS.PThread -import Foreign.C (CChar) -import Foreign.JNI.NativeMethod -import Foreign.JNI.Types -import qualified Foreign.JNI.String as JNI -import Foreign.Marshal.Array -import Foreign.Ptr (Ptr, nullPtr) -import qualified Language.C.Inline as C -import qualified Language.C.Inline.Unsafe as CU -import System.IO.Unsafe (unsafePerformIO) -import Prelude hiding (String) - -C.context (C.baseCtx <> C.bsCtx <> jniCtx) - -C.include "" -C.include "" -C.include "" - -data JavaException = JavaException JThrowable - deriving (Show, Typeable) - -instance Exception JavaException - --- | Thrown when @GetArrayElements@ returns a null pointer, --- because it wanted to copy the array contents but couldn't. In this case the --- JVM doesn't throw OutOfMemory according to the JNI spec. -data ArrayCopyFailed = ArrayCopyFailed - deriving (Show, Typeable) - -instance Exception ArrayCopyFailed - --- | Map Java exceptions to Haskell exceptions. -throwIfException :: Ptr JNIEnv -> IO a -> IO a -throwIfException env m = m `finally` do - J excptr <- [CU.exp| jthrowable { (*$(JNIEnv *env))->ExceptionOccurred($(JNIEnv *env)) } |] - unless (excptr == nullPtr) $ do - [CU.exp| void { (*$(JNIEnv *env))->ExceptionDescribe($(JNIEnv *env)) } |] - [CU.exp| void { (*$(JNIEnv *env))->ExceptionClear($(JNIEnv *env)) } |] - throwIO $ JavaException (J excptr) - --- | Check whether a pointer is null. -throwIfNull :: IO (Ptr a) -> IO (Ptr a) -throwIfNull m = do - ptr <- m - if ptr == nullPtr - then throwIO ArrayCopyFailed - else return ptr - --- | A global mutable cell holding the TLS variable, whose content is set once --- for each thread. -envTlsRef :: IORef (TLS (Ptr JNIEnv)) -{-# NOINLINE envTlsRef #-} -envTlsRef = unsafePerformIO $ do - -- It doesn't matter if this computation ends up running twice, say because - -- of lazy blackholing. - !tls <- mkTLS $ [C.block| JNIEnv* { - jsize num_jvms; - JavaVM *jvm; - /* Assume there's at most one JVM. The current JNI spec (2016) says only - * one JVM per process is supported anyways. */ - JNI_GetCreatedJavaVMs(&jvm, 1, &num_jvms); - JNIEnv *env; - - if(!num_jvms) { - fprintf(stderr, "No JVM has been initialized yet.\n"); - exit(EFAULT); - } - - /* Attach as daemon to match GHC's usual semantics for threads, which are - * daemonic. - */ - (*jvm)->AttachCurrentThreadAsDaemon(jvm, (void**)&env, NULL); - return env; } |] - newIORef tls - --- | Run an action against the appropriate 'JNIEnv'. --- --- Each OS thread has its own 'JNIEnv', which this function gives access to. --- --- TODO check whether this call is only safe from a (bound) thread. -withJNIEnv :: (Ptr JNIEnv -> IO a) -> IO a -withJNIEnv f = f =<< getTLS =<< readIORef envTlsRef - -useAsCStrings :: [ByteString] -> ([Ptr CChar] -> IO a) -> IO a -useAsCStrings strs m = - foldr (\str k cstrs -> BS.useAsCString str $ \cstr -> k (cstr:cstrs)) m strs [] - --- | Create a new JVM, with the given arguments. /Can only be called once/. Best --- practice: use it to wrap your @main@ function. -withJVM :: [ByteString] -> IO a -> IO a -withJVM options action = - bracket ini fini (const action) - where - ini = do - useAsCStrings options $ \cstrs -> do - withArray cstrs $ \(coptions :: Ptr (Ptr CChar)) -> do - let n = fromIntegral (length cstrs) :: C.CInt - [C.block| JavaVM * { - JavaVM *jvm; - JNIEnv *env; - JavaVMInitArgs vm_args; - JavaVMOption *options = malloc(sizeof(JavaVMOption) * $(int n)); - for(int i = 0; i < $(int n); i++) - options[i].optionString = $(char **coptions)[i]; - vm_args.version = JNI_VERSION_1_6; - vm_args.nOptions = $(int n); - vm_args.options = options; - vm_args.ignoreUnrecognized = 0; - JNI_CreateJavaVM(&jvm, (void**)&env, &vm_args); - free(options); - return jvm; } |] - fini jvm = [C.block| void { (*$(JavaVM *jvm))->DestroyJavaVM($(JavaVM *jvm)); } |] - -defineClass - :: Coercible o (J ('Class "java.lang.ClassLoader")) - => JNI.String -- ^ Class name - -> o -- ^ Loader - -> ByteString -- ^ Bytecode buffer - -> IO JClass -defineClass name (coerce -> upcast -> loader) buf = withJNIEnv $ \env -> - throwIfException env $ - JNI.withString name $ \namep -> - [CU.exp| jclass { - (*$(JNIEnv *env))->DefineClass($(JNIEnv *env), - $(char *namep), - $(jobject loader), - $bs-ptr:buf, - $bs-len:buf) } |] -registerNatives - :: JClass - -> [JNINativeMethod] - -> IO () -registerNatives cls methods = withJNIEnv $ \env -> - throwIfException env $ - withArray methods $ \cmethods -> do - let numMethods = fromIntegral $ length methods - _ <- [CU.exp| jint { - (*$(JNIEnv *env))->RegisterNatives($(JNIEnv *env), - $(jclass cls), - $(JNINativeMethod *cmethods), - $(int numMethods)) } |] - return () - -throw :: Coercible o (J a) => o -> IO () -throw (coerce -> upcast -> obj) = withJNIEnv $ \env -> void $ do - [CU.exp| jint { - (*$(JNIEnv *env))->Throw($(JNIEnv *env), - $(jobject obj)) } |] - -throwNew :: JClass -> JNI.String -> IO () -throwNew cls msg = withJNIEnv $ \env -> - JNI.withString msg $ \msgp -> void $ do - [CU.exp| jint { - (*$(JNIEnv *env))->ThrowNew($(JNIEnv *env), - $(jclass cls), - $(char *msgp)) } |] - -findClass - :: JNI.String -- ^ Class name - -> IO JClass -findClass name = withJNIEnv $ \env -> - throwIfException env $ - JNI.withString name $ \namep -> - [CU.exp| jclass { (*$(JNIEnv *env))->FindClass($(JNIEnv *env), $(char *namep)) } |] - -newObject :: JClass -> JNI.String -> [JValue] -> IO JObject -newObject cls sig args = withJNIEnv $ \env -> - throwIfException env $ - withArray args $ \cargs -> do - constr <- getMethodID cls "" sig - [CU.exp| jobject { - (*$(JNIEnv *env))->NewObjectA($(JNIEnv *env), - $(jclass cls), - $(jmethodID constr), - $(jvalue *cargs)) } |] - -getFieldID - :: JClass -- ^ A class object as returned by 'findClass' - -> JNI.String -- ^ Field name - -> JNI.String -- ^ JNI signature - -> IO JFieldID -getFieldID cls fieldname sig = withJNIEnv $ \env -> - throwIfException env $ - JNI.withString fieldname $ \fieldnamep -> - JNI.withString sig $ \sigp -> - [CU.exp| jfieldID { - (*$(JNIEnv *env))->GetFieldID($(JNIEnv *env), - $(jclass cls), - $(char *fieldnamep), - $(char *sigp)) } |] - -getStaticFieldID - :: JClass -- ^ A class object as returned by 'findClass' - -> JNI.String -- ^ Field name - -> JNI.String -- ^ JNI signature - -> IO JFieldID -getStaticFieldID cls fieldname sig = withJNIEnv $ \env -> - throwIfException env $ - JNI.withString fieldname $ \fieldnamep -> - JNI.withString sig $ \sigp -> - [CU.exp| jfieldID { - (*$(JNIEnv *env))->GetStaticFieldID($(JNIEnv *env), - $(jclass cls), - $(char *fieldnamep), - $(char *sigp)) } |] - -#define GET_FIELD(name, hs_rettype, c_rettype) \ -get/**/name/**/Field :: Coercible o (J a) => o -> JFieldID -> IO hs_rettype; \ -get/**/name/**/Field (coerce -> upcast -> obj) field = withJNIEnv $ \env -> \ - throwIfException env $ \ - [CU.exp| c_rettype { \ - (*$(JNIEnv *env))->Get/**/name/**/Field($(JNIEnv *env), \ - $(jobject obj), \ - $(jfieldID field)) } |] - -GET_FIELD(Object, JObject, jobject) -GET_FIELD(Boolean, Word8, jboolean) -GET_FIELD(Byte, CChar, jbyte) -GET_FIELD(Char, Word16, jchar) -GET_FIELD(Short, Int16, jshort) -GET_FIELD(Int, Int32, jint) -GET_FIELD(Long, Int64, jlong) -GET_FIELD(Float, Float, jfloat) -GET_FIELD(Double, Double, jdouble) - -#define GET_STATIC_FIELD(name, hs_rettype, c_rettype) \ -getStatic/**/name/**/Field :: JClass -> JFieldID -> IO hs_rettype; \ -getStatic/**/name/**/Field klass field = withJNIEnv $ \env -> \ - throwIfException env $ \ - [CU.exp| c_rettype { \ - (*$(JNIEnv *env))->GetStatic/**/name/**/Field($(JNIEnv *env), \ - $(jclass klass), \ - $(jfieldID field)) } |] - -GET_STATIC_FIELD(Object, JObject, jobject) -GET_STATIC_FIELD(Boolean, Word8, jboolean) -GET_STATIC_FIELD(Byte, CChar, jbyte) -GET_STATIC_FIELD(Char, Word16, jchar) -GET_STATIC_FIELD(Short, Int16, jshort) -GET_STATIC_FIELD(Int, Int32, jint) -GET_STATIC_FIELD(Long, Int64, jlong) -GET_STATIC_FIELD(Float, Float, jfloat) -GET_STATIC_FIELD(Double, Double, jdouble) - -#define SET_FIELD(name, hs_fieldtype, c_fieldtype) \ -set/**/name/**/Field :: Coercible o (J a) => o -> JFieldID -> hs_fieldtype -> IO (); \ -set/**/name/**/Field (coerce -> upcast -> obj) field x = \ - withJNIEnv $ \env -> \ - throwIfException env $ \ - [CU.block| void { \ - (*$(JNIEnv *env))->Set/**/name/**/Field($(JNIEnv *env), \ - $(jobject obj), \ - $(jfieldID field), \ - $(c_fieldtype x)); } |] - -SET_FIELD(Object, JObject, jobject) -SET_FIELD(Boolean, Word8, jboolean) -SET_FIELD(Byte, CChar, jbyte) -SET_FIELD(Char, Word16, jchar) -SET_FIELD(Short, Int16, jshort) -SET_FIELD(Int, Int32, jint) -SET_FIELD(Long, Int64, jlong) -SET_FIELD(Float, Float, jfloat) -SET_FIELD(Double, Double, jdouble) - -#define SET_STATIC_FIELD(name, hs_fieldtype, c_fieldtype) \ -setStatic/**/name/**/Field :: JClass -> JFieldID -> hs_fieldtype -> IO (); \ -setStatic/**/name/**/Field klass field x = \ - withJNIEnv $ \env -> \ - throwIfException env $ \ - [CU.block| void { \ - (*$(JNIEnv *env))->SetStatic/**/name/**/Field($(JNIEnv *env), \ - $(jclass klass), \ - $(jfieldID field), \ - $(c_fieldtype x)); } |] - -SET_STATIC_FIELD(Object, JObject, jobject) -SET_STATIC_FIELD(Boolean, Word8, jboolean) -SET_STATIC_FIELD(Byte, CChar, jbyte) -SET_STATIC_FIELD(Char, Word16, jchar) -SET_STATIC_FIELD(Short, Int16, jshort) -SET_STATIC_FIELD(Int, Int32, jint) -SET_STATIC_FIELD(Long, Int64, jlong) -SET_STATIC_FIELD(Float, Float, jfloat) -SET_STATIC_FIELD(Double, Double, jdouble) - -getMethodID - :: JClass -- ^ A class object as returned by 'findClass' - -> JNI.String -- ^ Field name - -> JNI.String -- ^ JNI signature - -> IO JMethodID -getMethodID cls methodname sig = withJNIEnv $ \env -> - throwIfException env $ - JNI.withString methodname $ \methodnamep -> - JNI.withString sig $ \sigp -> - [CU.exp| jmethodID { - (*$(JNIEnv *env))->GetMethodID($(JNIEnv *env), - $(jclass cls), - $(char *methodnamep), - $(char *sigp)) } |] - -getStaticMethodID - :: JClass -- ^ A class object as returned by 'findClass' - -> JNI.String -- ^ Field name - -> JNI.String -- ^ JNI signature - -> IO JMethodID -getStaticMethodID cls methodname sig = withJNIEnv $ \env -> - throwIfException env $ - JNI.withString methodname $ \methodnamep -> - JNI.withString sig $ \sigp -> - [CU.exp| jmethodID { - (*$(JNIEnv *env))->GetStaticMethodID($(JNIEnv *env), - $(jclass cls), - $(char *methodnamep), - $(char *sigp)) } |] - -getObjectClass :: Coercible o (J ty) => o -> IO JClass -getObjectClass (coerce -> upcast -> obj) = withJNIEnv $ \env -> - [CU.exp| jclass { - (*$(JNIEnv *env))->GetObjectClass($(JNIEnv *env), - $(jobject obj)) } |] - -newGlobalRef :: Coercible o (J ty) => o -> IO o -newGlobalRef (coerce -> upcast -> obj) = withJNIEnv $ \env -> - fmap coerce $ - [CU.exp| jobject { - (*$(JNIEnv *env))->NewGlobalRef($(JNIEnv *env), - $(jobject obj)) } |] - -deleteGlobalRef :: Coercible o (J ty) => o -> IO () -deleteGlobalRef (coerce -> upcast -> obj) = withJNIEnv $ \env -> - [CU.block| void { - (*$(JNIEnv *env))->DeleteGlobalRef($(JNIEnv *env), - $(jobject obj)); } |] - --- Modern CPP does have ## for concatenating strings, but we use the hacky /**/ --- comment syntax for string concatenation. This is because GHC passes --- the -traditional flag to the preprocessor by default, which turns off several --- modern CPP features. - -#define CALL_METHOD(name, hs_rettype, c_rettype) \ -call/**/name/**/Method :: Coercible o (J a) => o -> JMethodID -> [JValue] -> IO hs_rettype; \ -call/**/name/**/Method (coerce -> upcast -> obj) method args = withJNIEnv $ \env -> \ - throwIfException env $ \ - withArray args $ \cargs -> \ - [C.exp| c_rettype { \ - (*$(JNIEnv *env))->Call/**/name/**/MethodA($(JNIEnv *env), \ - $(jobject obj), \ - $(jmethodID method), \ - $(jvalue *cargs)) } |] - -CALL_METHOD(Void, (), void) -CALL_METHOD(Object, JObject, jobject) -callBooleanMethod :: Coercible o (J a) => o -> JMethodID -> [JValue] -> IO Bool -callBooleanMethod x y z = - let CALL_METHOD(Boolean, Word8, jboolean) - in toEnum . fromIntegral <$> callBooleanMethod x y z -CALL_METHOD(Byte, CChar, jbyte) -CALL_METHOD(Char, Word16, jchar) -CALL_METHOD(Short, Int16, jshort) -CALL_METHOD(Int, Int32, jint) -CALL_METHOD(Long, Int64, jlong) -CALL_METHOD(Float, Float, jfloat) -CALL_METHOD(Double, Double, jdouble) - -#define CALL_STATIC_METHOD(name, hs_rettype, c_rettype) \ -callStatic/**/name/**/Method :: JClass -> JMethodID -> [JValue] -> IO hs_rettype; \ -callStatic/**/name/**/Method cls method args = withJNIEnv $ \env -> \ - throwIfException env $ \ - withArray args $ \cargs -> \ - [C.exp| c_rettype { \ - (*$(JNIEnv *env))->CallStatic/**/name/**/MethodA($(JNIEnv *env), \ - $(jclass cls), \ - $(jmethodID method), \ - $(jvalue *cargs)) } |] - -CALL_STATIC_METHOD(Void, (), void) -CALL_STATIC_METHOD(Object, JObject, jobject) -callStaticBooleanMethod :: JClass -> JMethodID -> [JValue] -> IO Bool -callStaticBooleanMethod x y z = - let CALL_STATIC_METHOD(Boolean, Word8, jboolean) - in toEnum . fromIntegral <$> callStaticBooleanMethod x y z -CALL_STATIC_METHOD(Byte, CChar, jbyte) -CALL_STATIC_METHOD(Char, Word16, jchar) -CALL_STATIC_METHOD(Short, Int16, jshort) -CALL_STATIC_METHOD(Int, Int32, jint) -CALL_STATIC_METHOD(Long, Int64, jlong) -CALL_STATIC_METHOD(Float, Float, jfloat) -CALL_STATIC_METHOD(Double, Double, jdouble) - -newObjectArray :: Int32 -> JClass -> IO JObjectArray -newObjectArray sz cls = withJNIEnv $ \env -> - throwIfException env $ - [CU.exp| jobjectArray { - (*$(JNIEnv *env))->NewObjectArray($(JNIEnv *env), - $(jsize sz), - $(jclass cls), - NULL) } |] - -#define NEW_ARRAY(name, c_rettype) \ -new/**/name/**/Array :: Int32 -> IO J/**/name/**/Array; \ -new/**/name/**/Array sz = withJNIEnv $ \env -> \ - throwIfException env $ \ - [CU.exp| c_rettype/**/Array { \ - (*$(JNIEnv *env))->New/**/name/**/Array($(JNIEnv *env), \ - $(jsize sz)) } |] - -NEW_ARRAY(Boolean, jboolean) -NEW_ARRAY(Byte, jbyte) -NEW_ARRAY(Char, jchar) -NEW_ARRAY(Short, jshort) -NEW_ARRAY(Int, jint) -NEW_ARRAY(Long, jlong) -NEW_ARRAY(Float, jfloat) -NEW_ARRAY(Double, jdouble) - -newString :: Ptr Word16 -> Int32 -> IO JString -newString ptr len = withJNIEnv $ \env -> - throwIfException env $ - [CU.exp| jstring { - (*$(JNIEnv *env))->NewString($(JNIEnv *env), - $(jchar *ptr), - $(jsize len)) } |] - -getArrayLength :: Coercible o (JArray a) => o -> IO Int32 -getArrayLength (coerce -> upcast -> array) = withJNIEnv $ \env -> - [C.exp| jsize { - (*$(JNIEnv *env))->GetArrayLength($(JNIEnv *env), - $(jarray array)) } |] - -getStringLength :: JString -> IO Int32 -getStringLength jstr = withJNIEnv $ \env -> - [CU.exp| jsize { - (*$(JNIEnv *env))->GetStringLength($(JNIEnv *env), - $(jstring jstr)) } |] - -#define GET_ARRAY_ELEMENTS(name, hs_rettype, c_rettype) \ -get/**/name/**/ArrayElements :: J/**/name/**/Array -> IO (Ptr hs_rettype); \ -get/**/name/**/ArrayElements (upcast -> array) = withJNIEnv $ \env -> \ - throwIfNull $ \ - [CU.exp| c_rettype* { \ - (*$(JNIEnv *env))->Get/**/name/**/ArrayElements($(JNIEnv *env), \ - $(jobject array), \ - NULL) } |] - -GET_ARRAY_ELEMENTS(Boolean, Word8, jboolean) -GET_ARRAY_ELEMENTS(Byte, CChar, jbyte) -GET_ARRAY_ELEMENTS(Char, Word16, jchar) -GET_ARRAY_ELEMENTS(Short, Int16, jshort) -GET_ARRAY_ELEMENTS(Int, Int32, jint) -GET_ARRAY_ELEMENTS(Long, Int64, jlong) -GET_ARRAY_ELEMENTS(Float, Float, jfloat) -GET_ARRAY_ELEMENTS(Double, Double, jdouble) - -getStringChars :: JString -> IO (Ptr Word16) -getStringChars jstr = withJNIEnv $ \env -> - throwIfNull $ - [CU.exp| const jchar* { - (*$(JNIEnv *env))->GetStringChars($(JNIEnv *env), - $(jstring jstr), - NULL) } |] - -#define SET_ARRAY_REGION(name, hs_argtype, c_argtype) \ -set/**/name/**/ArrayRegion :: J/**/name/**/Array -> Int32 -> Int32 -> Ptr hs_argtype -> IO (); \ -set/**/name/**/ArrayRegion array start len buf = withJNIEnv $ \env -> \ - throwIfException env $ \ - [CU.exp| void { \ - (*$(JNIEnv *env))->Set/**/name/**/ArrayRegion($(JNIEnv *env), \ - $(c_argtype/**/Array array), \ - $(jsize start), \ - $(jsize len), \ - $(c_argtype *buf)) } |] - -SET_ARRAY_REGION(Boolean, Word8, jboolean) -SET_ARRAY_REGION(Byte, CChar, jbyte) -SET_ARRAY_REGION(Char, Word16, jchar) -SET_ARRAY_REGION(Short, Int16, jshort) -SET_ARRAY_REGION(Int, Int32, jint) -SET_ARRAY_REGION(Long, Int64, jlong) -SET_ARRAY_REGION(Float, Float, jfloat) -SET_ARRAY_REGION(Double, Double, jdouble) - -#define RELEASE_ARRAY_ELEMENTS(name, hs_argtype, c_argtype) \ -release/**/name/**/ArrayElements :: J/**/name/**/Array -> Ptr hs_argtype -> IO (); \ -release/**/name/**/ArrayElements (upcast -> array) xs = withJNIEnv $ \env -> \ - [CU.exp| void { \ - (*$(JNIEnv *env))->Release/**/name/**/ArrayElements($(JNIEnv *env), \ - $(jobject array), \ - $(c_argtype *xs), \ - JNI_ABORT) } |] - -RELEASE_ARRAY_ELEMENTS(Boolean, Word8, jboolean) -RELEASE_ARRAY_ELEMENTS(Byte, CChar, jbyte) -RELEASE_ARRAY_ELEMENTS(Char, Word16, jchar) -RELEASE_ARRAY_ELEMENTS(Short, Int16, jshort) -RELEASE_ARRAY_ELEMENTS(Int, Int32, jint) -RELEASE_ARRAY_ELEMENTS(Long, Int64, jlong) -RELEASE_ARRAY_ELEMENTS(Float, Float, jfloat) -RELEASE_ARRAY_ELEMENTS(Double, Double, jdouble) - -releaseStringChars :: JString -> Ptr Word16 -> IO () -releaseStringChars jstr chars = withJNIEnv $ \env -> - [CU.exp| void { - (*$(JNIEnv *env))->ReleaseStringChars($(JNIEnv *env), - $(jstring jstr), - $(jchar *chars)) } |] - -getObjectArrayElement :: Coercible o (JArray a) => o -> Int32 -> IO (J a) -getObjectArrayElement (coerce -> upcast -> array) i = withJNIEnv $ \env -> unsafeCast <$> - [C.exp| jobject { - (*$(JNIEnv *env))->GetObjectArrayElement($(JNIEnv *env), - $(jarray array), - $(jsize i)) } |] - -setObjectArrayElement :: Coercible o (J a) => JObjectArray -> Int32 -> o -> IO () -setObjectArrayElement array i (coerce -> upcast -> x) = withJNIEnv $ \env -> - [C.exp| void { - (*$(JNIEnv *env))->SetObjectArrayElement($(JNIEnv *env), - $(jobjectArray array), - $(jsize i), - $(jobject x)); } |] diff --git a/src/Foreign/JNI/Types.hs b/src/Foreign/JNI/Types.hs --- a/src/Foreign/JNI/Types.hs +++ b/src/Foreign/JNI/Types.hs @@ -38,6 +38,7 @@ , JMethodID(..) , JFieldID(..) , JValue(..) + , withJValues -- * JNI defined object types , JObject , JClass @@ -63,7 +64,7 @@ import Data.ByteString.Builder (Builder) import Data.Char (chr, ord) import Data.Int -import Data.Map (fromList) +import qualified Data.Map as Map import Data.Monoid ((<>)) import Data.Singletons ( Sing @@ -74,16 +75,23 @@ #endif ) import Data.Singletons.TypeLits (KnownSymbol, symbolVal) -import Data.String (fromString) import Data.Word import Foreign.C (CChar) +import Foreign.ForeignPtr + ( ForeignPtr + , castForeignPtr + , newForeignPtr_ + , withForeignPtr + ) import Foreign.JNI.NativeMethod import qualified Foreign.JNI.String as JNI +import Foreign.Marshal.Alloc (allocaBytesAligned) import Foreign.Ptr import Foreign.Storable (Storable(..)) import GHC.TypeLits (Symbol) import Language.C.Types (TypeSpecifier(TypeName)) -import Language.C.Inline.Context (Context(..)) +import Language.C.Inline.Context (Context(..), fptrCtx) +import System.IO.Unsafe (unsafePerformIO) -- | A JVM instance. newtype JVM = JVM_ (Ptr JVM) @@ -122,9 +130,9 @@ instance IsReferenceType ty => IsReferenceType ('Generic ty tys) data instance Sing (a :: JType) where - SClass :: JNI.String -> Sing ('Class sym) - SIface :: JNI.String -> Sing ('Iface sym) - SPrim :: JNI.String -> Sing ('Prim sym) + SClass :: String -> Sing ('Class sym) + SIface :: String -> Sing ('Iface sym) + SPrim :: String -> Sing ('Prim sym) SArray :: Sing ty -> Sing ('Array ty) SGeneric :: Sing ty -> Sing tys -> Sing ('Generic ty tys) SVoid :: Sing 'Void @@ -132,11 +140,11 @@ -- XXX SingI constraint temporary hack because GHC 7.10 has trouble inferring -- this constraint in 'signature'. instance (KnownSymbol sym, SingI sym) => SingI ('Class (sym :: Symbol)) where - sing = SClass $ fromString $ symbolVal (undefined :: proxy sym) + sing = SClass $ symbolVal (undefined :: proxy sym) instance (KnownSymbol sym, SingI sym) => SingI ('Iface (sym :: Symbol)) where - sing = SIface $ fromString $ symbolVal (undefined :: proxy sym) + sing = SIface $ symbolVal (undefined :: proxy sym) instance (KnownSymbol sym, SingI sym) => SingI ('Prim (sym :: Symbol)) where - sing = SPrim $ fromString $ symbolVal (undefined :: proxy sym) + sing = SPrim $ symbolVal (undefined :: proxy sym) instance SingI ty => SingI ('Array ty) where sing = SArray sing instance (SingI ty, SingI tys) => SingI ('Generic ty tys) where @@ -148,14 +156,14 @@ type a <> g = 'Generic a g -- | Type indexed Java Objects. -newtype J (a :: JType) = J (Ptr (J a)) - deriving (Eq, Show, Storable) +newtype J (a :: JType) = J (ForeignPtr (J a)) + deriving (Eq, Show) type role J representational -- | The null reference. jnull :: J a -jnull = J nullPtr +jnull = J $ unsafePerformIO $ newForeignPtr_ nullPtr -- | Any object can be cast to @Object@. upcast :: J a -> JObject @@ -163,7 +171,7 @@ -- | Unsafe type cast. Should only be used to downcast. unsafeCast :: J a -> J b -unsafeCast (J x) = J (castPtr x) +unsafeCast (J x) = J (castForeignPtr x) -- | Parameterize the type of an object, making its type a /generic type/. generic :: J a -> J (a <> g) @@ -205,25 +213,42 @@ (JLong x) == (JLong y) = x == y (JFloat x) == (JFloat y) = x == y (JDouble x) == (JDouble y) = x == y - (JObject (J x)) == (JObject (J y)) = castPtr x == castPtr y + (JObject (J x)) == (JObject (J y)) = castForeignPtr x == castForeignPtr y _ == _ = False -instance Storable JValue where - sizeOf _ = 8 - alignment _ = 8 +sizeOfJValue, alignmentJValue :: Int +sizeOfJValue = 8 +alignmentJValue = 8 - poke p (JBoolean x) = poke (castPtr p) x - poke p (JByte x) = poke (castPtr p) x - poke p (JChar x) = poke (castPtr p) x - poke p (JShort x) = poke (castPtr p) x - poke p (JInt x) = poke (castPtr p) x - poke p (JLong x) = poke (castPtr p) x - poke p (JFloat x) = poke (castPtr p) x - poke p (JDouble x) = poke (castPtr p) x - poke p (JObject x) = poke (castPtr p :: Ptr (J a)) x +-- | @withJValue jvalues f@ provides a pointer to an array containing the given +-- @jvalues@. +-- +-- The array is valid only while evaluating @f@. +withJValues :: [JValue] -> (Ptr JValue -> IO a) -> IO a +withJValues args f = + allocaBytesAligned (sizeOfJValue * length args) alignmentJValue $ \p -> + foldr (.) id (zipWith (withJValueOff p) [0..] args) (f p) - peek _ = error "Storable JValue: undefined peek" +-- @withJValueOff p n jvalue io@ writes the given @jvalue@ to @p `plusPtr` n@ +-- and runs @io@. +-- +-- The jvalue is guaranteed to stay valid while @io@ evaluates. +withJValueOff :: Ptr JValue -> Int -> JValue -> IO a -> IO a +withJValueOff p n jvalue io = case jvalue of + JBoolean x -> pokeByteOff (castPtr p) offset x >> io + JByte x -> pokeByteOff (castPtr p) offset x >> io + JChar x -> pokeByteOff (castPtr p) offset x >> io + JShort x -> pokeByteOff (castPtr p) offset x >> io + JInt x -> pokeByteOff (castPtr p) offset x >> io + JLong x -> pokeByteOff (castPtr p) offset x >> io + JFloat x -> pokeByteOff (castPtr p) offset x >> io + JDouble x -> pokeByteOff (castPtr p) offset x >> io + JObject (J x) -> withForeignPtr x $ \xp -> + pokeByteOff (castPtr p) offset xp >> io + where + offset = n * sizeOfJValue + -- | Get the Java type of a value. #if MIN_VERSION_singletons(2,2,0) jtypeOf :: JValue -> SomeSing JType @@ -257,9 +282,10 @@ referenceTypeName (SGeneric ty@(SIface _) _) = referenceTypeName ty referenceTypeName _ = error "referenceTypeName: Impossible." -classSymbolBuilder :: JNI.String -> Builder +classSymbolBuilder :: String -> Builder classSymbolBuilder sym = - Prim.primMapByteStringFixed (subst Prim.>$< Prim.word8) (JNI.toByteString sym) + Prim.primMapByteStringFixed (subst Prim.>$< Prim.word8) + (JNI.toByteString $ JNI.fromChars sym) where subst (chr . fromIntegral -> '.') = fromIntegral (ord '/') subst x = x @@ -275,7 +301,7 @@ signatureBuilder (SPrim "long") = Builder.char7 'J' signatureBuilder (SPrim "float") = Builder.char7 'F' signatureBuilder (SPrim "double") = Builder.char7 'D' -signatureBuilder (SPrim sym) = error $ "Unknown primitive: " ++ show sym +signatureBuilder (SPrim sym) = error $ "Unknown primitive: " ++ sym signatureBuilder (SArray ty) = Builder.char7 '[' <> signatureBuilder ty signatureBuilder (SGeneric ty _) = signatureBuilder ty signatureBuilder SVoid = Builder.char7 'V' @@ -317,7 +343,7 @@ type JDoubleArray = JArray ('Prim "double") jniCtx :: Context -jniCtx = mempty { ctxTypesTable = fromList tytab } +jniCtx = mempty { ctxTypesTable = Map.fromList tytab } <> fptrCtx where tytab = [ -- Primitive types @@ -330,20 +356,20 @@ , (TypeName "jfloat", [t| Float |]) , (TypeName "jdouble", [t| Double |]) -- Reference types - , (TypeName "jobject", [t| JObject |]) - , (TypeName "jclass", [t| JClass |]) - , (TypeName "jstring", [t| JString |]) - , (TypeName "jarray", [t| JObject |]) - , (TypeName "jobjectArray", [t| JObjectArray |]) - , (TypeName "jbooleanArray", [t| JBooleanArray |]) - , (TypeName "jbyteArray", [t| JByteArray |]) - , (TypeName "jcharArray", [t| JCharArray |]) - , (TypeName "jshortArray", [t| JShortArray |]) - , (TypeName "jintArray", [t| JIntArray |]) - , (TypeName "jlongArray", [t| JLongArray |]) - , (TypeName "jfloatArray", [t| JFloatArray |]) - , (TypeName "jdoubleArray", [t| JDoubleArray |]) - , (TypeName "jthrowable", [t| JThrowable |]) + , (TypeName "jobject", [t| Ptr JObject |]) + , (TypeName "jclass", [t| Ptr JClass |]) + , (TypeName "jstring", [t| Ptr JString |]) + , (TypeName "jarray", [t| Ptr JObject |]) + , (TypeName "jobjectArray", [t| Ptr JObjectArray |]) + , (TypeName "jbooleanArray", [t| Ptr JBooleanArray |]) + , (TypeName "jbyteArray", [t| Ptr JByteArray |]) + , (TypeName "jcharArray", [t| Ptr JCharArray |]) + , (TypeName "jshortArray", [t| Ptr JShortArray |]) + , (TypeName "jintArray", [t| Ptr JIntArray |]) + , (TypeName "jlongArray", [t| Ptr JLongArray |]) + , (TypeName "jfloatArray", [t| Ptr JFloatArray |]) + , (TypeName "jdoubleArray", [t| Ptr JDoubleArray |]) + , (TypeName "jthrowable", [t| Ptr JThrowable |]) -- Internal types , (TypeName "JavaVM", [t| JVM |]) , (TypeName "JNIEnv", [t| JNIEnv |])