[jvm] implement typed functions (#9208)

* [jvm] mess

* [jvm] get unit tests green

* [jvm] avoid problems with ancient OCaml versions

* [jvm] generate VarArgs and ClosureDispatch

* [jvm] don't generate reflection information on interfaces

* [jvm] remove unused code

* [jvm] remove waneck

src/generators/genjvm.ml

@@ -73,6 +73,8 @@ type generation_context = {
 	mutable anon_identification : jsignature tanon_identification;
 	mutable preprocessor : jsignature preprocessor;
 	default_export_config : export_config;
+	typed_functions : JvmFunctions.typed_functions;
+	closure_paths : (path * string * jsignature,path) Hashtbl.t;
 	mutable typedef_interfaces : jsignature typedef_interfaces;
 	mutable current_field_info : field_generation_info option;
 }
@@ -363,68 +365,63 @@ let generate_equals_function (jc : JvmClass.builder) jsig_arg =
 	save();
 	jm_equals,load
 
-class closure_context (jsig : jsignature) = object(self)
-	val lut = Hashtbl.create 0
-	val sigs = DynArray.create()
-
-	method add (var_id : int) (var_name : string) (var_sig : jsignature) =
-		DynArray.add sigs ((var_id,var_name),var_sig);
-		Hashtbl.add lut var_id (var_sig,var_name)
-
-	method get (code : JvmCode.builder) (var_id : int) =
-		let var_sig,var_name = Hashtbl.find lut var_id in
-		if DynArray.length sigs > 1 then begin
-			(-1),
-			(fun () ->
-				code#aload jsig 0;
-				let offset = code#get_pool#add_field self#get_path var_name var_sig FKField in
-				code#getfield offset jsig var_sig
-			),
-			(fun () ->
-				code#aload jsig 0;
-				let offset = code#get_pool#add_field self#get_path var_name var_sig FKField in
-				code#putfield offset jsig var_sig
-			)
-		end else begin
-			(-1),
-			(fun () ->
-				code#aload jsig 0;
-			),
+let create_field_closure gctx jc path_this jm name jsig =
+	let jsig_this = object_path_sig path_this in
+	let context = ["this",jsig_this] in
+	let wf = new JvmFunctions.typed_function gctx.typed_functions jc jm context in
+	let jc_closure = wf#get_class in
+	ignore(wf#generate_constructor true);
+	let args,ret = match jsig with
+		| TMethod(args,ret) ->
+			List.mapi (fun i jsig -> (Printf.sprintf "arg%i" i,jsig)) args,ret
+		| _ ->
+			assert false
+	in
+	let jm_invoke = wf#generate_invoke args ret in
+	let vars = List.map (fun (name,jsig) ->
+		jm_invoke#add_local name jsig VarArgument
+	) args in
+	jm_invoke#finalize_arguments;
+	jm_invoke#load_this;
+	jm_invoke#getfield jc_closure#get_this_path "this" jsig_this;
+	List.iter (fun (_,load,_) ->
+		load();
+	) vars;
+	jm_invoke#invokevirtual path_this name (method_sig (List.map snd args) ret);
+	jm_invoke#return;
+	(* equals *)
+	begin
+		let jm_equals,load = generate_equals_function jc_closure object_sig in
+		let code = jm_equals#get_code in
+		jm_equals#load_this;
+		jm_equals#getfield jc_closure#get_this_path "this" jsig_this;
+		load();
+		jm_equals#getfield jc_closure#get_this_path "this" jsig_this;
+		jm_equals#if_then
+			(fun () -> code#if_acmp_eq_ref jc_closure#get_jsig jc_closure#get_jsig)
 			(fun () ->
-				code#aload jsig 0;
-			)
-		end
-
-	method get_constructor_sig =
-		method_sig (List.map snd (DynArray.to_list sigs)) None
-
-	method get_jsig = jsig
-	method get_path = match jsig with TObject(path,_) -> path | _ -> assert false
-
-	method get_args = DynArray.to_list sigs
-end
-
-let create_context_class gctx jc jm name vl = match vl with
-	| [(vid,vname,vsig)] ->
-		let jsig = get_boxed_type vsig in
-		let ctx_class = new closure_context jsig in
-		ctx_class#add vid vname jsig;
-		ctx_class
-	| _ ->
-		let jc = jc#spawn_inner_class (Some jm) object_path None in
-		let path = jc#get_this_path in
-		let ctx_class = new closure_context (object_path_sig path) in
-		let jsigs = List.map (fun (_,_,vsig) -> vsig) vl in
-		let jm_ctor = jc#spawn_method "<init>" (method_sig jsigs None) [MPublic] in
-		jm_ctor#load_this;
-		jm_ctor#call_super_ctor ConstructInit (method_sig [] None);
-		List.iter2 (fun (vid,vname,vtype) jsig ->
-			jm_ctor#add_argument_and_field vname jsig;
-			ctx_class#add vid vname jsig;
-		) vl jsigs;
-		jm_ctor#get_code#return_void;
-		write_class gctx.jar path (jc#export_class gctx.default_export_config);
-		ctx_class
+				code#bconst false;
+				jm_equals#return;
+			);
+		code#bconst true;
+		jm_equals#return;
+	end;
+	write_class gctx.jar jc_closure#get_this_path (jc_closure#export_class gctx.default_export_config);
+	jc_closure#get_this_path
+
+let create_field_closure gctx jc path_this jm name jsig f =
+	let jsig_this = object_path_sig path_this in
+	let closure_path = try
+		Hashtbl.find gctx.closure_paths (path_this,name,jsig)
+	with Not_found ->
+		let closure_path = create_field_closure gctx jc path_this jm name jsig in
+		Hashtbl.add gctx.closure_paths (path_this,name,jsig) closure_path;
+		closure_path
+	in
+	jm#construct ConstructInit closure_path (fun () ->
+		f();
+		[jsig_this]
+	)
 
 let rvalue_any = RValue None
 let rvalue_sig jsig = RValue (Some jsig)
@@ -461,14 +458,24 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
 		slot,load,store
 
 	method get_local_by_id (vid,vname) =
-		if vid = 0 then
+		if vid = 0 && env = None then
 			(0,(fun () -> jm#load_this),(fun () -> assert false))
 		else try
 			Hashtbl.find local_lookup vid
 		with Not_found -> try
 			begin match env with
 			| Some env ->
-				env#get code vid
+				let name,jsig = List.assoc vid env in
+				(-1,
+					(fun () ->
+						jm#load_this;
+						jm#getfield jc#get_this_path name jsig
+					),
+					(fun () ->
+						jm#load_this;
+						jm#putfield jc#get_this_path name jsig
+					)
+				)
 			| None ->
 				raise Not_found
 			end
@@ -478,8 +485,8 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
 	method get_local v =
 		self#get_local_by_id (v.v_id,v.v_name)
 
-	method set_context (ctx : closure_context) =
-		env <- Some ctx
+	method set_env (env' : (int * (string * jsignature)) list) =
+		env <- Some env'
 
 	(* casting *)
 
@@ -493,69 +500,67 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
 		| RValue (Some jsig) -> jm#cast jsig
 		| _ -> self#cast t
 
+	method make_static_closure_field (name : string) (jc_closure : JvmClass.builder) =
+		let jm_init = jc_closure#get_static_init_method in
+		let jf_closure = jc_closure#spawn_field name jc_closure#get_jsig [FdStatic;FdPublic] in
+		jm_init#construct ConstructInit jc_closure#get_this_path (fun () -> []);
+		jm_init#putstatic jc_closure#get_this_path jf_closure#get_name jf_closure#get_jsig;
+
 	method tfunction e tf =
-		let name = jc#get_next_closure_name in
-		let outside = match Texpr.collect_captured_vars e with
-			| [],false ->
-				None
-			| vl,accesses_this ->
-				let vl = List.map (fun v -> v.v_id,v.v_name,jsignature_of_type gctx v.v_type) vl in
-				let vl = if accesses_this then (0,"this",jc#get_jsig) :: vl else vl in
-				let ctx_class = create_context_class gctx jc jm name vl in
-				Some ctx_class
-		in
-		let jsig =
-			let args = List.map (fun (v,cto) ->
-				if cto <> None then v.v_type <- self#mknull v.v_type;
-				self#vtype v.v_type
+		let outside,accesses_this = Texpr.collect_captured_vars e in
+		let env = List.map (fun v ->
+			v.v_id,(v.v_name,self#vtype v.v_type)
+		) outside in
+		let env = if accesses_this then ((0,("this",jc#get_jsig)) :: env) else env in
+		let context = List.map snd env in
+		let wf = new JvmFunctions.typed_function gctx.typed_functions jc jm context in
+		let jc_closure = wf#get_class in
+		ignore(wf#generate_constructor (env <> []));
+		let args,ret =
+			let args = List.map (fun (v,eo) ->
+				(* TODO: Can we do this differently? *)
+				if eo <> None then v.v_type <- self#mknull v.v_type;
+				v.v_name,self#vtype v.v_type
 			) tf.tf_args in
-			let args = match outside with
-				| None -> args
-				| Some ctx_class -> ctx_class#get_jsig :: args
-			in
-			method_sig args (if ExtType.is_void (follow tf.tf_type) then None else Some (self#vtype tf.tf_type))
+			args,(return_of_type gctx tf.tf_type)
 		in
-		begin
-			let jm = jc#spawn_method name jsig [MPublic;MStatic] in
-			let handler = new texpr_to_jvm gctx jc jm (return_of_type gctx tf.tf_type) in
-			begin match outside with
-			| None -> ()
-			| Some ctx_class ->
-				handler#set_context ctx_class;
-				let name = match ctx_class#get_args with
-					| [(_,name),_] -> name
-					| _ -> "_hx_ctx"
-				in
-				ignore(handler#add_named_local name ctx_class#get_jsig)
-			end;
-			let inits = List.map (fun (v,cto) ->
-				let _,load,save = handler#add_local v VarArgument in
-				match cto with
-				| Some e when (match e.eexpr with TConst TNull -> false | _ -> true) ->
-					let f () =
-						load();
-						let jsig = self#vtype v.v_type in
-						jm#if_then
-							(fun () -> jm#get_code#if_nonnull_ref jsig)
-							(fun () ->
-								handler#texpr (rvalue_sig jsig) e;
-								jm#cast jsig;
-								save();
-							)
-					in
-					Some f
-				| _ ->
-					None
-			) tf.tf_args in
-			jm#finalize_arguments;
-			List.iter (function
-				| None -> ()
-				| Some f -> f()
-			) inits;
-			handler#texpr RReturn tf.tf_expr;
+		let jm_invoke = wf#generate_invoke args ret in
+		let handler = new texpr_to_jvm gctx jc_closure jm_invoke ret in
+		handler#set_env env;
+		let args = List.map (fun (v,eo) ->
+			handler#add_local v VarArgument,v,eo
+		) tf.tf_args in
+		jm_invoke#finalize_arguments;
+		List.iter (fun ((_,load,save),v,eo) -> match eo with
+			| Some e when (match e.eexpr with TConst TNull -> false | _ -> true) ->
+				load();
+				let jsig = self#vtype v.v_type in
+				jm_invoke#if_then
+					(fun () -> jm_invoke#get_code#if_nonnull_ref jsig)
+					(fun () ->
+						handler#texpr (rvalue_sig jsig) e;
+						jm_invoke#cast jsig;
+						save();
+					)
+			| _ ->
+				()
+		) args;
+		handler#texpr RReturn tf.tf_expr;
+		begin match env with
+		| [] ->
+			let name = snd jc_closure#get_this_path in
+			self#make_static_closure_field name jc_closure;
+			jm#getstatic jc_closure#get_this_path name (object_path_sig jc_closure#get_this_path);
+		| _ ->
+			jm#construct ConstructInit jc_closure#get_this_path (fun () ->
+				(List.map (fun (id,(name,jsig)) ->
+					let _,load,_ = self#get_local_by_id (id,name) in
+					load();
+					jsig
+				) env);
+			);
 		end;
-		jm#read_closure true jc#get_this_path name jsig;
-		outside
+		write_class gctx.jar jc_closure#get_this_path (jc_closure#export_class gctx.default_export_config);
 
 	(* access *)
 
@@ -591,16 +596,49 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
 		| None ->
 			default();
 
+	method read_static_closure (path : path) (name : string) (args : (string * jsignature) list) (ret : jsignature option) =
+		let jsig = method_sig (List.map snd args) ret in
+		let closure_path = try
+			Hashtbl.find gctx.closure_paths (path,name,jsig)
+		with Not_found ->
+			let wf = new JvmFunctions.typed_function gctx.typed_functions jc jm [] in
+			let jc_closure = wf#get_class in
+			ignore(wf#generate_constructor false);
+			let jm_invoke = wf#generate_invoke args ret in
+			let vars = List.map (fun (name,jsig) ->
+				jm_invoke#add_local name jsig VarArgument
+			) args in
+			jm_invoke#finalize_arguments;
+			List.iter (fun (_,load,_) ->
+				load();
+			) vars;
+			jm_invoke#invokestatic path name (method_sig (List.map snd args) ret);
+			jm_invoke#return;
+			Hashtbl.add gctx.closure_paths (path,name,jsig) jc_closure#get_this_path;
+			(* Static init *)
+			self#make_static_closure_field name jc_closure;
+			write_class gctx.jar jc_closure#get_this_path (jc_closure#export_class gctx.default_export_config);
+			jc_closure#get_this_path;
+		in
+		jm#getstatic closure_path name (object_path_sig closure_path);
+
 	method read cast e1 fa =
+		let read_static_closure path cf =
+			let args,ret = match follow cf.cf_type with
+				| TFun(tl,tr) -> List.map (fun (n,_,t) -> n,self#vtype t) tl,(return_of_type gctx tr)
+				| _ -> assert false
+			in
+			self#read_static_closure path cf.cf_name args ret
+		in
 		match fa with
 		| FStatic({cl_path = (["java";"lang"],"Math")},({cf_name = "NaN" | "POSITIVE_INFINITY" | "NEGATIVE_INFINITY"} as cf)) ->
 			jm#getstatic double_path cf.cf_name TDouble
 		| FStatic({cl_path = (["java";"lang"],"Math")},({cf_name = "isNaN" | "isFinite"} as cf)) ->
-			jm#read_closure true double_path cf.cf_name (jsignature_of_type gctx cf.cf_type);
+			read_static_closure double_path cf;
 		| FStatic({cl_path = (["java";"lang"],"String")},({cf_name = "fromCharCode"} as cf)) ->
-			jm#read_closure true (["haxe";"jvm"],"StringExt") cf.cf_name (jsignature_of_type gctx cf.cf_type);
+			read_static_closure (["haxe";"jvm"],"StringExt") cf
 		| FStatic(c,({cf_kind = Method (MethNormal | MethInline)} as cf)) ->
-			jm#read_closure true c.cl_path cf.cf_name (jsignature_of_type gctx cf.cf_type);
+			read_static_closure c.cl_path cf
 		| FStatic(c,cf) ->
 			jm#getstatic c.cl_path cf.cf_name (self#vtype cf.cf_type);
 			cast();
@@ -629,10 +667,9 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
 			jm#invokestatic haxe_jvm_path "readField" (method_sig [object_sig;string_sig] (Some object_sig));
 			cast();
 		| FClosure((Some(c,_)),cf) ->
-			let jsig = self#vtype cf.cf_type in
-			jm#read_closure false c.cl_path cf.cf_name jsig;
-			self#texpr rvalue_any e1;
-			jm#invokevirtual method_handle_path "bindTo" (method_sig [object_sig] (Some method_handle_sig));
+			create_field_closure gctx jc c.cl_path jm cf.cf_name (self#vtype cf.cf_type) (fun () ->
+				self#texpr rvalue_any e1;
+			)
 
 	method read_write ret ak e (f : unit -> unit) =
 		let apply dup =
@@ -1343,9 +1380,10 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
 
 	method call ret tr e1 el =
 		let invoke t =
-			jm#cast method_handle_sig;
+			jm#cast haxe_function_sig;
 			let tl,tr = self#call_arguments t el in
-			jm#invokevirtual method_handle_path "invoke" (method_sig tl tr);
+			let meth = gctx.typed_functions#register_signature tl tr in
+			jm#invokevirtual haxe_function_path meth.name (method_sig meth.dargs meth.dret);
 			tr
 		in
 		let tro = match (Texpr.skip e1).eexpr with
@@ -1555,21 +1593,8 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
 				| _ -> assert false
 			end
 		| _ ->
-			let rec has_unknown_args jsig =
-				is_dynamic_at_runtime jsig || match jsig with
-					| TMethod(jsigs,_) -> List.exists has_unknown_args jsigs
-					| _ -> false
-			in
-			if has_unknown_args (jsignature_of_type gctx e1.etype) then begin
-				self#texpr rvalue_any e1;
-				jm#cast method_handle_sig;
-				self#new_native_array object_sig el;
-				jm#invokestatic haxe_jvm_path "call" (method_sig [method_handle_sig;array_sig object_sig] (Some object_sig));
-				Some object_sig
-			end else begin
-				self#texpr rvalue_any e1;
-				invoke e1.etype;
-			end
+			self#texpr rvalue_any e1;
+			invoke e1.etype;
 		in
 		match need_val ret,tro with
 		| false,Some _ -> code#pop
@@ -1749,8 +1774,9 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
 			let t = object_path_sig path in
 			code#ldc offset (TObject(java_class_path,[TType(WNone,t)]))
 		| TMethod _ ->
-			let offset = pool#add_path method_handle_path in
-			code#ldc offset (TObject(java_class_path,[TType(WNone,method_handle_sig)]))
+			assert false
+			(* let offset = pool#add_path method_handle_path in
+			code#ldc offset (TObject(java_class_path,[TType(WNone,method_handle_sig)])) *)
 		| TTypeParameter _ ->
 			let offset = pool#add_path object_path in
 			code#ldc offset (TObject(java_class_path,[TType(WNone,object_sig)]))
@@ -1920,30 +1946,7 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
 			jm#return;
 			jm#set_terminated true;
 		| TFunction tf ->
-			begin match self#tfunction e tf with
-			| None ->
-				()
-			| Some ctx_class ->
-				begin match ctx_class#get_args with
-				| [(arg,jsig)] ->
-					let _,load,_ = self#get_local_by_id arg in
-					load();
-					self#expect_reference_type;
-					jm#invokevirtual method_handle_path "bindTo" (method_sig [object_sig] (Some method_handle_sig));
-				| args ->
-					let f () =
-						let tl = List.map (fun (arg,jsig) ->
-							let _,load,_ = self#get_local_by_id arg in
-							load();
-							jm#cast jsig;
-							jsig
-						) args in
-						tl
-					in
-					jm#construct ConstructInit ctx_class#get_path f;
-					jm#invokevirtual method_handle_path "bindTo" (method_sig [object_sig] (Some method_handle_sig));
-				end
-			end
+			self#tfunction e tf
 		| TArrayDecl el when not (need_val ret) ->
 			List.iter (self#texpr ret) el
 		| TArrayDecl el ->
@@ -2132,9 +2135,9 @@ let generate_dynamic_access gctx (jc : JvmClass.builder) fields is_anon =
 			[hash],(fun () ->
 				begin match kind with
 					| Method (MethNormal | MethInline) ->
-						jm#read_closure false jc#get_this_path name jsig;
-						jm#load_this;
-						jm#invokevirtual method_handle_path "bindTo" (method_sig [object_sig] (Some method_handle_sig));
+						create_field_closure gctx jc jc#get_this_path jm name jsig (fun () ->
+							jm#load_this
+						)
 					| _ ->
 						jm#load_this;
 						jm#getfield jc#get_this_path name jsig;
@@ -2570,7 +2573,7 @@ class tclass_to_jvm gctx c = object(self)
 			self#handle_relation_type_params;
 		end;
 		self#generate_signature;
-		if not (Meta.has Meta.NativeGen c.cl_meta) then
+		if not (Meta.has Meta.NativeGen c.cl_meta) && not c.cl_interface then
 			generate_dynamic_access gctx jc (List.map (fun cf -> cf.cf_name,jsignature_of_type gctx cf.cf_type,cf.cf_kind) c.cl_ordered_fields) false;
 		self#generate_annotations;
 		jc#add_attribute (AttributeSourceFile (jc#get_pool#add_string c.cl_pos.pfile));
@@ -2830,6 +2833,8 @@ let generate com =
 		anon_identification = anon_identification;
 		preprocessor = Obj.magic ();
 		typedef_interfaces = Obj.magic ();
+		typed_functions = new JvmFunctions.typed_functions;
+		closure_paths = Hashtbl.create 0;
 		current_field_info = None;
 		default_export_config = {
 			export_debug = true;
@@ -2928,11 +2933,19 @@ let generate com =
 				List.iter (fun ((_,load,_),_) ->
 					load();
 				) locals;
-				let jr = if ExtType.is_void (follow tr) then None else Some (jsignature_of_type gctx tr) in
-				jm#invokevirtual method_handle_path "invoke" (method_sig (List.map snd locals) jr);
+				let jret = return_of_type gctx tr in
+				let meth = gctx.typed_functions#register_signature (List.map snd locals) jret in
+				jm#invokevirtual haxe_function_path meth.name (method_sig meth.dargs meth.dret);
+				Option.may jm#cast jret;
 				jm#return
 			) c.cl_ordered_fields
 		end;
 		write_class gctx.jar path (jc#export_class gctx.default_export_config)
 	) gctx.anon_identification#get_anons;
+	let jc_function = gctx.typed_functions#generate in
+	write_class gctx.jar jc_function#get_this_path (jc_function#export_class gctx.default_export_config);
+	let jc_varargs = gctx.typed_functions#generate_var_args in
+	write_class gctx.jar jc_varargs#get_this_path (jc_varargs#export_class gctx.default_export_config);
+	let jc_closure_dispatch = gctx.typed_functions#generate_closure_dispatch in
+	write_class gctx.jar jc_closure_dispatch#get_this_path (jc_closure_dispatch#export_class gctx.default_export_config);
 	Zip.close_out gctx.jar

src/generators/jvm/jvmClass.ml

@@ -63,7 +63,7 @@ class builder path_this path_super = object(self)
 			jm
 
 	method get_next_closure_name =
-		let name = Printf.sprintf "hx_closure$%i" closure_count in
+		let name = Printf.sprintf "Closure$%i" closure_count in
 		closure_count <- closure_count + 1;
 		name
 

src/generators/jvm/jvmCode.ml

@@ -133,7 +133,7 @@ class builder pool = object(self)
 			match js,js' with
 			| (TObject _ | TTypeParameter _),(TObject _ | TTypeParameter _ | TArray _) -> () (* TODO ??? *)
 			| TMethod _,TMethod _ -> ()
-			| TMethod _,TObject((["java";"lang";"invoke"],"MethodHandle"),[]) -> ()
+			| TMethod _,TObject(path,[]) when path = NativeSignatures.haxe_function_path -> ()
 			| TTypeParameter _,TMethod _ -> ()
 			| TObject _,TMethod _ -> ()
 			| TMethod _,TObject _ -> ()

src/generators/jvm/jvmFunctions.ml

@@ -0,0 +1,330 @@
+open JvmSignature
+open NativeSignatures
+
+type signature_classification =
+	| CByte
+	| CChar
+	| CDouble
+	| CFloat
+	| CInt
+	| CLong
+	| CShort
+	| CBool
+	| CObject
+
+type method_signature = {
+	arity : int;
+	name : string;
+	has_nonobject : bool;
+	sort_string : string;
+	cargs : signature_classification list;
+	cret : signature_classification option;
+	dargs : jsignature list;
+	dret : jsignature option;
+	mutable next : method_signature option;
+}
+
+let string_of_classification = function
+	| CByte -> "Byte"
+	| CChar -> "Char"
+	| CDouble -> "Double"
+	| CFloat -> "Float"
+	| CInt -> "Int"
+	| CLong -> "Long"
+	| CShort -> "Short"
+	| CBool -> "Bool"
+	| CObject -> "Object"
+
+let classify = function
+	| TByte -> CByte
+	| TChar -> CChar
+	| TDouble -> CDouble
+	| TFloat -> CFloat
+	| TInt -> CInt
+	| TLong -> CLong
+	| TShort -> CShort
+	| TBool -> CBool
+	| TObject _
+	| TObjectInner _
+	| TArray _
+	| TMethod _
+	| TTypeParameter _
+	| TUninitialized _ -> CObject
+
+let declassify = function
+	| CByte -> TByte
+	| CChar -> TChar
+	| CDouble -> TDouble
+	| CFloat -> TFloat
+	| CInt -> TInt
+	| CLong -> TLong
+	| CShort -> TShort
+	| CBool -> TBool
+	| CObject -> object_path_sig object_path
+
+class typed_functions = object(self)
+	val signatures = Hashtbl.create 0
+	val mutable max_arity = 0
+
+	method register_signature (tl : jsignature list) (tr : jsignature option) =
+		let cl = List.map classify tl in
+		let cr = Option.map classify tr in
+		self#get_signature cl cr
+
+	method objectify (meth : method_signature) =
+		let cl_objects = List.map (fun _ -> CObject) meth.cargs in
+		self#get_signature cl_objects meth.cret
+
+	method private get_signature
+		(cl : signature_classification list)
+		(cr : signature_classification option)
+	=
+		try
+			Hashtbl.find signatures (cl,cr)
+		with Not_found ->
+			self#do_register_signature cl cr
+
+	method private do_register_signature
+		(cl : signature_classification list)
+		(cr : signature_classification option)
+	=
+		let to_string (cl,cr) =
+			Printf.sprintf "[%s] %s"
+				(String.concat ", " (List.map string_of_classification cl))
+				(Option.map_default string_of_classification "CVoid" cr)
+		in
+		let suffix = Option.map_default string_of_classification "Void" cr in
+		let meth = {
+			arity = List.length cl;
+			name = Printf.sprintf "invoke%s" suffix;
+			has_nonobject = List.exists (function CObject -> false | _ -> true) cl;
+			sort_string = to_string (cl,cr);
+			cargs = cl;
+			cret = cr;
+			dargs = List.map declassify cl;
+			dret = Option.map declassify cr;
+			next = None;
+		} in
+		if meth.arity > max_arity then max_arity <- meth.arity;
+		Hashtbl.add signatures (meth.cargs,meth.cret) meth;
+		(* If the method has something that's not java.lang.Object, the next method is one where all arguments are
+		   of type java.lang.Object. *)
+		if meth.has_nonobject then begin
+			let meth_objects = self#objectify meth in
+			meth.next <- Some meth_objects;
+		(* Otherwise, if the method has a return type that's not java.lang.Object, the next method is one that returns
+		   java.lang.Object. *)
+		end else begin match cr with
+			| Some CObject ->
+				()
+			| _ ->
+				meth.next <- Some (self#get_signature meth.cargs (Some CObject))
+		end;
+		meth
+
+	method make_forward_method
+		(jc : JvmClass.builder)
+		(jm : JvmMethod.builder)
+		(meth_from : method_signature)
+		(meth_to : method_signature)
+	=
+		let args = List.mapi (fun i jsig ->
+			jm#add_local (Printf.sprintf "arg%i" i) jsig VarArgument
+		) meth_from.dargs in
+		jm#finalize_arguments;
+		jm#load_this;
+		let rec loop loads jsigs = match loads,jsigs with
+			| (_,load,_) :: loads,jsig :: jsigs ->
+				load();
+				jm#cast jsig;
+				loop loads jsigs
+			| [],jsig :: jsigs ->
+				jm#load_default_value jsig;
+				loop [] jsigs
+			| [],[] ->
+				()
+			| _,[] ->
+				assert false
+		in
+		loop args meth_to.dargs;
+		jm#invokevirtual jc#get_this_path meth_to.name (method_sig meth_to.dargs meth_to.dret);
+		begin match meth_from.dret,meth_to.dret with
+		| None,None ->
+			()
+		| Some jsig,Some _ ->
+			jm#cast jsig;
+		| None,Some jsig ->
+			jm#get_code#pop
+		| Some jsig,None ->
+			jm#load_default_value jsig;
+		end;
+		jm#return;
+
+	method generate_invoke_dynamic (jc : JvmClass.builder) =
+		let array_sig = TArray(object_sig,None) in
+		let jm = jc#spawn_method "invokeDynamic" (method_sig [array_sig] (Some object_sig)) [MPublic] in
+		let _,load,_ = jm#add_local "args" array_sig VarArgument in
+		jm#finalize_arguments;
+		load();
+		jm#get_code#arraylength array_sig;
+		let cases = ExtList.List.init max_arity (fun i ->
+			[Int32.of_int i],(fun () ->
+				jm#load_this;
+				let args = ExtList.List.init i (fun index ->
+					load();
+					jm#get_code#iconst (Int32.of_int index);
+					jm#get_code#aaload array_sig object_sig;
+					object_sig
+				) in
+				jm#invokevirtual jc#get_this_path "invokeObject" (method_sig args (Some object_sig));
+				jm#return;
+			)
+		) in
+		let def = (fun () ->
+			jm#string "Invalid call";
+			jm#invokestatic (["haxe";"jvm"],"Exception") "wrap" (method_sig [object_sig] (Some exception_sig));
+			jm#get_code#athrow;
+			jm#set_terminated true;
+		) in
+		ignore(jm#int_switch true cases (Some def));
+
+	method generate_closure_dispatch =
+		let jc = new JvmClass.builder (["haxe";"jvm"],"ClosureDispatch") haxe_function_path in
+		jc#add_access_flag 1; (* public *)
+		let jm_ctor = jc#spawn_method "<init>" (method_sig [] None) [MPublic] in
+		jm_ctor#finalize_arguments;
+		jm_ctor#load_this;
+		jm_ctor#call_super_ctor ConstructInit (method_sig [] None);
+		jm_ctor#return;
+		let rec loop args i =
+			let jsig = method_sig args (Some object_sig) in
+			let jm = jc#spawn_method "invokeObject" jsig [MPublic] in
+			let vars = ExtList.List.init i (fun i ->
+				jm#add_local (Printf.sprintf "arg%i" i) object_sig VarArgument
+			) in
+			jm#load_this;
+			jm#new_native_array object_sig (List.map (fun (_,load,_) () -> load()) vars);
+			jm#invokevirtual haxe_function_path "invokeDynamic" (method_sig [array_sig object_sig] (Some object_sig));
+			jm#return;
+			if i < max_arity then loop (object_sig :: args) (i + 1)
+		in
+		loop [] 0;
+		jc
+
+	method generate_var_args =
+		let jc = new JvmClass.builder (["haxe";"jvm"],"VarArgs") haxe_function_path in
+		jc#add_access_flag 1; (* public *)
+		let jm_ctor = jc#spawn_method "<init>" (method_sig [haxe_function_sig] None) [MPublic] in
+		jm_ctor#add_argument_and_field "func" haxe_function_sig;
+		jm_ctor#finalize_arguments;
+		jm_ctor#load_this;
+		jm_ctor#call_super_ctor ConstructInit (method_sig [] None);
+		jm_ctor#return;
+		let rec loop args i =
+			let jsig = method_sig args (Some object_sig) in
+			let jm = jc#spawn_method "invokeObject" jsig [MPublic] in
+			let vars = ExtList.List.init i (fun i ->
+				jm#add_local (Printf.sprintf "arg%i" i) object_sig VarArgument
+			) in
+			jm#load_this;
+			jm#getfield jc#get_this_path "func" haxe_function_sig;
+			jm#new_native_array object_sig (List.map (fun (_,load,_) () -> load()) vars);
+			jm#invokestatic (["haxe";"root"],"Array") "ofNative" (method_sig [array_sig object_sig] (Some (object_path_sig (["haxe";"root"],"Array"))));
+			jm#invokevirtual haxe_function_path "invokeObject" (method_sig [object_sig] (Some object_sig));
+			jm#return;
+			if i < max_arity then loop (object_sig :: args) (i + 1)
+		in
+		loop [] 0;
+		jc
+
+	method generate =
+		let l = Hashtbl.fold (fun _ v acc -> v :: acc) signatures [] in
+		let l = List.sort (fun meth1 meth2 -> compare (meth1.arity,meth1.sort_string) (meth2.arity,meth2.sort_string)) l in
+		let jc = new JvmClass.builder haxe_function_path object_path in
+		jc#add_access_flag 1; (* public *)
+		List.iter (fun meth ->
+			let jm = jc#spawn_method meth.name (method_sig meth.dargs meth.dret) [MPublic] in
+			begin match meth.next with
+			| Some meth_next ->
+				self#make_forward_method jc jm meth meth_next;
+			| None when meth.arity < max_arity && not meth.has_nonobject ->
+				let meth_next = self#get_signature (CObject :: meth.cargs) meth.cret in
+				self#make_forward_method jc jm meth meth_next
+			| None ->
+				List.iteri (fun i jsig ->
+					ignore(jm#add_local (Printf.sprintf "arg%i" i) jsig VarArgument)
+				) meth.dargs;
+				jm#finalize_arguments;
+				begin match meth.dret with
+				| Some jsig -> jm#load_default_value jsig
+				| None -> ()
+				end;
+				jm#return;
+			end;
+		) l;
+		let jm_ctor = jc#spawn_method "<init>" (method_sig [] None) [MPublic] in
+		jm_ctor#load_this;
+		jm_ctor#call_super_ctor ConstructInit (method_sig [] None);
+		jm_ctor#return;
+		self#generate_invoke_dynamic jc;
+		jc
+end
+
+
+class typed_function
+	(functions : typed_functions)
+	(host_class : JvmClass.builder)
+	(host_method : JvmMethod.builder)
+	(context : (string * jsignature) list)
+
+= object(self)
+
+	val jc_closure =
+		let jc = host_class#spawn_inner_class None haxe_function_path (Some host_class#get_next_closure_name) in
+		jc#add_access_flag 0x10; (* final *)
+		jc
+
+	method get_class = jc_closure
+
+	method generate_constructor (public : bool) =
+		let context_sigs = List.map snd context in
+		let jm_ctor = jc_closure#spawn_method "<init>" (method_sig context_sigs None) (if public then [MPublic] else []) in
+		List.iter (fun (name,jsig) ->
+			jm_ctor#add_argument_and_field name jsig;
+		) context;
+		jm_ctor#load_this;
+		jm_ctor#call_super_ctor ConstructInit (method_sig [] None);
+		jm_ctor#return;
+		jm_ctor
+
+	method generate_invoke (args : (string * jsignature) list) (ret : jsignature option)=
+		let arg_sigs = List.map snd args in
+		let meth = functions#register_signature arg_sigs ret in
+		let jsig_invoke = method_sig arg_sigs ret in
+		let jm_invoke = jc_closure#spawn_method meth.name jsig_invoke [MPublic] in
+		let rec loop meth =
+			begin match meth.next with
+			| Some meth_next ->
+				let jm_invoke_next = jc_closure#spawn_method meth_next.name (method_sig meth_next.dargs meth_next.dret) [MPublic] in
+				functions#make_forward_method jc_closure jm_invoke_next meth_next meth;
+				loop meth_next;
+			| None ->
+				()
+			end;
+		in
+		let return_differs = match meth.dret,ret with
+			| None,None -> false
+			| Some jsig1,Some jsig2 -> not (equals_at_runtime jsig1 jsig2)
+			| _ -> true
+		in
+		let meth = if not (List.for_all2 equals_at_runtime meth.dargs arg_sigs) || return_differs then begin
+			let meth_prev = meth in
+			let meth = {meth with dargs = arg_sigs; dret = ret} in
+			meth.next <- Some meth_prev;
+			meth
+		end else
+			meth
+		in
+		loop meth;
+		jm_invoke
+end

src/generators/jvm/jvmMethod.ml

@@ -78,7 +78,7 @@ module NativeArray = struct
 		| TInt -> primitive 10
 		| TLong -> primitive 11
 		| TObject(path,_) -> reference path
-		| TMethod _ -> reference NativeSignatures.method_handle_path
+		| TMethod _ -> reference NativeSignatures.haxe_function_path
 		| TTypeParameter _ -> reference NativeSignatures.object_path
 		| TArray _ ->
 			let offset = pool#add_type (generate_signature false je) in
@@ -301,15 +301,6 @@ class builder jc name jsig = object(self)
 			NativeArray.write code jasig jsig
 		) fl
 
-	(** Adds a closure to method [name] ob [path] with signature [jsig_method] to the constant pool.
-
-	    Also emits an instruction to load the closure.
-	**)
-	method read_closure is_static path name jsig_method =
-		let offset = code#get_pool#add_field path name jsig_method FKMethod in
-		let offset = code#get_pool#add (ConstMethodHandle((if is_static then 6 else 5), offset)) in
-		code#ldc offset jsig_method
-
 	(**
 		Emits a return instruction.
 	**)
@@ -558,7 +549,7 @@ class builder jc name jsig = object(self)
 		| TObject(path,_),TTypeParameter _ ->
 			code#checkcast path
 		| TMethod _,_ ->
-			code#checkcast (["java";"lang";"invoke"],"MethodHandle");
+			code#checkcast NativeSignatures.haxe_function_path;
 		| TArray(jsig1,_),TArray(jsig2,_) when jsig1 = jsig2 ->
 			()
 		| TArray _,_ ->

src/generators/jvm/jvmSignature.ml

@@ -49,127 +49,6 @@ and jsignature =
 (* ( jsignature list ) ReturnDescriptor (| V | jsignature) *)
 and jmethod_signature = jsignature list * jsignature option
 
-let s_wildcard = function
-	| WExtends -> "WExtends"
-	| WSuper -> "WSuper"
-	| WNone -> "WNone"
-
-let rec s_signature_kind = function
-	| TByte -> "TByte"
-	| TChar -> "TChar"
-	| TDouble -> "TDouble"
-	| TFloat -> "TFloat"
-	| TInt -> "TInt"
-	| TLong -> "TLong"
-	| TShort -> "TShort"
-	| TBool -> "TBool"
-	| TObject(path,params) -> Printf.sprintf "TObject(%s,[%s])" (Globals.s_type_path path) (String.concat "," (List.map s_signature_param_kind params))
-	| TObjectInner _ -> "TObjectInner"
-	| TArray(jsig,io) -> Printf.sprintf "TArray(%s,%s)" (s_signature_kind jsig) (Option.map_default string_of_int "None" io)
-	| TMethod(jsigs,jsig) -> Printf.sprintf "TMethod([%s],%s)" (String.concat "," (List.map s_signature_kind jsigs)) (Option.map_default s_signature_kind "None" jsig)
-	| TTypeParameter name -> Printf.sprintf "TTypeParameter(%s)" name
-	| TUninitialized io -> Printf.sprintf "TUninitilaized(%s)" (Option.map_default string_of_int "None" io)
-
-and s_signature_param_kind = function
-	| TAny -> "TAny"
-	| TType(wc,jsig) -> Printf.sprintf "TType(%s,%s)" (s_wildcard wc) (s_signature_kind jsig)
-
-let encode_path (pack,name) =
-	String.concat "/" (pack @ [name])
-
-let rec write_param full ch param = match param with
-	| TAny -> write_byte ch (Char.code '*')
-	| TType(w, s) ->
-		begin match w with
-			| WExtends -> write_byte ch (Char.code '+')
-			| WSuper -> write_byte ch (Char.code '-')
-			| WNone -> ()
-		end;
-		write_signature full ch s
-
-and write_signature full ch jsig = match jsig with
-	| TByte -> write_byte ch (Char.code 'B')
-	| TChar -> write_byte ch (Char.code 'C')
-	| TDouble -> write_byte ch (Char.code 'D')
-	| TFloat -> write_byte ch (Char.code 'F')
-	| TInt -> write_byte ch (Char.code 'I')
-	| TLong -> write_byte ch (Char.code 'J')
-	| TShort -> write_byte ch (Char.code 'S')
-	| TBool -> write_byte ch (Char.code 'Z')
-	| TObject(path, params) ->
-		write_byte ch (Char.code 'L');
-		write_string ch (encode_path path);
-		if params <> [] && full then begin
-			write_byte ch (Char.code '<');
-			List.iter (write_param full ch) params;
-			write_byte ch (Char.code '>')
-		end;
-		write_byte ch (Char.code ';')
-	| TObjectInner(pack, inners) ->
-		write_byte ch (Char.code 'L');
-		List.iter (fun p ->
-			write_string ch p;
-			write_byte ch (Char.code '/')
-		) pack;
-		let first = ref true in
-		List.iter (fun (name,params) ->
-			(if !first then first := false else write_byte ch (Char.code '.'));
-			write_string ch name;
-			if params <> [] then begin
-				write_byte ch (Char.code '<');
-				List.iter (write_param full ch) params;
-				write_byte ch (Char.code '>')
-			end;
-		) inners;
-		write_byte ch (Char.code ';')
-	| TArray(s,size) ->
-		write_byte ch (Char.code '[');
-		begin match size with
-			| Some size ->
-				write_string ch (string_of_int size);
-			| None -> ()
-		end;
-		write_signature full ch s
-	| TMethod _ ->
-		write_signature full ch (TObject((["java";"lang";"invoke"],"MethodHandle"),[]))
-	| TTypeParameter name ->
-		if full then begin
-			write_byte ch (Char.code 'T');
-			write_string ch name;
-			write_byte ch (Char.code ';')
-		end else
-			write_string ch "Ljava/lang/Object;"
-	| TUninitialized io ->
-		write_string ch "uninitialized";
-		match io with
-		| None -> write_string ch " this"
-		| Some i -> write_string ch (Printf.sprintf "(%i)" i)
-
-let generate_signature full jsig =
-	let ch = IO.output_bytes () in
-	write_signature full ch jsig;
-	Bytes.unsafe_to_string (IO.close_out ch)
-
-let generate_method_signature full jsig =
-	let ch = IO.output_bytes () in
-	begin match jsig with
-	| TMethod(args, ret) ->
-		write_byte ch (Char.code '(');
-		List.iter (write_signature full ch) args;
-		write_byte ch (Char.code ')');
-		begin match ret with
-			| None -> write_byte ch (Char.code 'V')
-			| Some jsig -> write_signature full ch jsig
-		end
-	| _ ->
-		write_signature full ch jsig;
-	end;
-	Bytes.unsafe_to_string (IO.close_out ch)
-
-let signature_size = function
-	| TDouble | TLong -> 2
-	| _ -> 1
-
 module NativeSignatures = struct
 	let object_path = ["java";"lang"],"Object"
 	let object_sig = TObject(object_path,[])
@@ -183,9 +62,6 @@ module NativeSignatures = struct
 	let character_path = ["java";"lang"],"Character"
 	let character_sig = TObject(character_path,[])
 
-	let method_handle_path = (["java";"lang";"invoke"],"MethodHandle")
-	let method_handle_sig = TObject(method_handle_path,[])
-
 	let method_type_path = (["java";"lang";"invoke"],"MethodType")
 	let method_type_sig = TObject(method_type_path,[])
 
@@ -230,6 +106,9 @@ module NativeSignatures = struct
 	let haxe_empty_constructor_path = (["haxe";"jvm"],"EmptyConstructor")
 	let haxe_empty_constructor_sig = TObject(haxe_empty_constructor_path,[])
 
+	let haxe_function_path = (["haxe";"jvm"],"Function")
+	let haxe_function_sig = TObject(haxe_function_path,[])
+
 	let void_path = ["java";"lang"],"Void"
 	let void_sig = TObject(void_path,[])
 
@@ -300,4 +179,147 @@ module NativeSignatures = struct
 			true
 		| _ ->
 			false
-end
+end
+
+let equals_at_runtime jsig1 jsig2 = match jsig1,jsig2 with
+	| TByte,TByte
+	| TChar,TChar
+	| TDouble,TDouble
+	| TFloat,TFloat
+	| TInt,TInt
+	| TLong,TLong
+	| TShort,TShort
+	| TBool,TBool
+	| TObjectInner _,TObjectInner _
+	| TArray _,TArray _
+	| TMethod _,TMethod _
+	| TTypeParameter _,TTypeParameter _
+	| TUninitialized _,TUninitialized _ ->
+		true
+	| TObject(path1,_),TObject(path2,_) ->
+		path1 = path2
+	| TObject(path,_),TTypeParameter _
+	| TTypeParameter _,TObject(path,_) ->
+		path = NativeSignatures.object_path
+	| _ -> false
+
+let s_wildcard = function
+	| WExtends -> "WExtends"
+	| WSuper -> "WSuper"
+	| WNone -> "WNone"
+
+let rec s_signature_kind = function
+	| TByte -> "TByte"
+	| TChar -> "TChar"
+	| TDouble -> "TDouble"
+	| TFloat -> "TFloat"
+	| TInt -> "TInt"
+	| TLong -> "TLong"
+	| TShort -> "TShort"
+	| TBool -> "TBool"
+	| TObject(path,params) -> Printf.sprintf "TObject(%s,[%s])" (Globals.s_type_path path) (String.concat "," (List.map s_signature_param_kind params))
+	| TObjectInner _ -> "TObjectInner"
+	| TArray(jsig,io) -> Printf.sprintf "TArray(%s,%s)" (s_signature_kind jsig) (Option.map_default string_of_int "None" io)
+	| TMethod(jsigs,jsig) -> Printf.sprintf "TMethod([%s],%s)" (String.concat "," (List.map s_signature_kind jsigs)) (Option.map_default s_signature_kind "None" jsig)
+	| TTypeParameter name -> Printf.sprintf "TTypeParameter(%s)" name
+	| TUninitialized io -> Printf.sprintf "TUninitilaized(%s)" (Option.map_default string_of_int "None" io)
+
+and s_signature_param_kind = function
+	| TAny -> "TAny"
+	| TType(wc,jsig) -> Printf.sprintf "TType(%s,%s)" (s_wildcard wc) (s_signature_kind jsig)
+
+let encode_path (pack,name) =
+	String.concat "/" (pack @ [name])
+
+let rec write_param full ch param = match param with
+	| TAny -> write_byte ch (Char.code '*')
+	| TType(w, s) ->
+		begin match w with
+			| WExtends -> write_byte ch (Char.code '+')
+			| WSuper -> write_byte ch (Char.code '-')
+			| WNone -> ()
+		end;
+		write_signature full ch s
+
+and write_signature full ch jsig = match jsig with
+	| TByte -> write_byte ch (Char.code 'B')
+	| TChar -> write_byte ch (Char.code 'C')
+	| TDouble -> write_byte ch (Char.code 'D')
+	| TFloat -> write_byte ch (Char.code 'F')
+	| TInt -> write_byte ch (Char.code 'I')
+	| TLong -> write_byte ch (Char.code 'J')
+	| TShort -> write_byte ch (Char.code 'S')
+	| TBool -> write_byte ch (Char.code 'Z')
+	| TObject(path, params) ->
+		write_byte ch (Char.code 'L');
+		write_string ch (encode_path path);
+		if params <> [] && full then begin
+			write_byte ch (Char.code '<');
+			List.iter (write_param full ch) params;
+			write_byte ch (Char.code '>')
+		end;
+		write_byte ch (Char.code ';')
+	| TObjectInner(pack, inners) ->
+		write_byte ch (Char.code 'L');
+		List.iter (fun p ->
+			write_string ch p;
+			write_byte ch (Char.code '/')
+		) pack;
+		let first = ref true in
+		List.iter (fun (name,params) ->
+			(if !first then first := false else write_byte ch (Char.code '.'));
+			write_string ch name;
+			if params <> [] then begin
+				write_byte ch (Char.code '<');
+				List.iter (write_param full ch) params;
+				write_byte ch (Char.code '>')
+			end;
+		) inners;
+		write_byte ch (Char.code ';')
+	| TArray(s,size) ->
+		write_byte ch (Char.code '[');
+		begin match size with
+			| Some size ->
+				write_string ch (string_of_int size);
+			| None -> ()
+		end;
+		write_signature full ch s
+	| TMethod _ ->
+		write_signature full ch NativeSignatures.haxe_function_sig
+	| TTypeParameter name ->
+		if full then begin
+			write_byte ch (Char.code 'T');
+			write_string ch name;
+			write_byte ch (Char.code ';')
+		end else
+			write_string ch "Ljava/lang/Object;"
+	| TUninitialized io ->
+		write_string ch "uninitialized";
+		match io with
+		| None -> write_string ch " this"
+		| Some i -> write_string ch (Printf.sprintf "(%i)" i)
+
+let generate_signature full jsig =
+	let ch = IO.output_bytes () in
+	write_signature full ch jsig;
+	Bytes.unsafe_to_string (IO.close_out ch)
+
+let generate_method_signature full jsig =
+	let ch = IO.output_bytes () in
+	begin match jsig with
+	| TMethod(args, ret) ->
+		write_byte ch (Char.code '(');
+		List.iter (write_signature full ch) args;
+		write_byte ch (Char.code ')');
+		begin match ret with
+			| None -> write_byte ch (Char.code 'V')
+			| Some jsig -> write_signature full ch jsig
+		end
+	| _ ->
+		write_signature full ch jsig;
+	end;
+	Bytes.unsafe_to_string (IO.close_out ch)
+
+let signature_size = function
+	| TDouble | TLong -> 2
+	| _ -> 1

src/generators/jvm/jvmVerificationTypeInfo.ml

@@ -37,7 +37,7 @@ let of_signature pool jsig = match jsig with
     | TLong -> VLong
     | TDouble -> VDouble
     | TObject(path,_) -> VObject (pool#add_path path)
-	| TMethod _ -> VObject (pool#add_path (["java";"lang";"invoke"],"MethodHandle"))
+	| TMethod _ -> VObject (pool#add_path NativeSignatures.haxe_function_path)
 	| TArray _ -> VObject (pool#add_path ([],generate_signature false jsig))
 	| TTypeParameter _ -> VObject (pool#add_path (["java";"lang"],"Object"))
 	| TUninitialized (Some i) -> VUninitialized i

std/jvm/Closure.hx

@@ -0,0 +1,65 @@
+package jvm;
+
+import java.NativeArray;
+import java.lang.reflect.Method;
+
+@:native("haxe.jvm.Closure")
+@:nativeGen
+@:keep
+class Closure extends ClosureDispatch {
+	public var context:Dynamic;
+	public var method:Method;
+
+	var isStatic:Bool;
+	var params:NativeArray<java.lang.Class<Dynamic>>;
+
+	public function new(context:Null<Dynamic>, method:Method) {
+		super();
+		this.context = context;
+		this.method = method;
+		isStatic = method.getModifiers() & java.lang.reflect.Modifier.STATIC != 0;
+		params = method.getParameterTypes();
+	}
+
+	public function bindTo(context:Dynamic) {
+		return new Closure(context, method);
+	}
+
+	override public function equals(other:java.lang.Object) {
+		if (!Jvm.instanceof(other, Closure)) {
+			return false;
+		}
+		var other:Closure = cast other;
+		return context == other.context && method == other.method;
+	}
+
+	public override function invokeDynamic(args:NativeArray<Dynamic>):Dynamic {
+		if (isStatic && context != null) {
+			var newArgs = new NativeArray(args.length + 1);
+			haxe.ds.Vector.blit(cast args, 0, cast newArgs, 1, args.length);
+			newArgs[0] = context;
+			args = newArgs;
+		}
+		var args = switch (jvm.Jvm.unifyCallArguments(args, params, true)) {
+			case Some(args):
+				args;
+			case None:
+				args;
+		};
+		try {
+			return method.invoke(context, args);
+		} catch (e:java.lang.reflect.InvocationTargetException) {
+			throw e.getCause();
+		}
+	}
+}
+
+@:native("haxe.jvm.ClosureDispatch")
+extern class ClosureDispatch extends Function {}
+
+@:native("haxe.jvm.VarArgs")
+extern class VarArgs extends Function {
+	var func:Function;
+
+	public function new(func:Function):Void;
+}

std/jvm/Function.hx

@@ -0,0 +1,12 @@
+package jvm;
+
+import java.NativeArray;
+
+@:native("haxe.jvm.Function")
+@:nativeGen
+extern class Function {
+	public function new():Void;
+	public function invokeDynamic(args:NativeArray<Dynamic>):Dynamic;
+	public function equals(other:java.lang.Object):Bool;
+	public function invokeObject(arg1:java.lang.Object):java.lang.Object;
+}

std/jvm/Jvm.hx

@@ -143,12 +143,8 @@ class Jvm {
 		return Some(callArgs);
 	}
 
-	static public function call(mh:java.lang.invoke.MethodHandle, args:NativeArray<Dynamic>) {
-		var params = mh.type().parameterArray();
-		return switch (unifyCallArguments(args, params, true)) {
-			case Some(args): mh.invokeWithArguments(args);
-			case None: mh.invokeWithArguments(args);
-		}
+	static public function call(func:jvm.Function, args:NativeArray<Dynamic>) {
+		return func.invokeDynamic(args);
 	}
 
 	// casts
@@ -297,11 +293,11 @@ class Jvm {
 				var methods = cl.getMethods();
 				for (m in methods) {
 					if (m.getName() == name) {
-						var method = java.lang.invoke.MethodHandles.lookup().unreflect(m);
+						var context = null;
 						if (!isStatic || cl == cast java.lang.Class) {
-							method = method.bindTo(obj);
+							context = obj;
 						}
-						return method;
+						return new jvm.Closure(context, m);
 					}
 				}
 				if (isStatic) {
@@ -329,27 +325,27 @@ class Jvm {
 				case "length":
 					return (obj : String).length;
 				case "charAt":
-					return (cast jvm.StringExt.charAt : java.lang.invoke.MethodHandle).bindTo(obj);
+					return (readFieldNoObject(jvm.StringExt, "charAt") : Closure).bindTo(obj);
 				case "charCodeAt":
-					return (cast jvm.StringExt.charCodeAt : java.lang.invoke.MethodHandle).bindTo(obj);
+					return (readFieldNoObject(jvm.StringExt, "charCodeAt") : Closure).bindTo(obj);
 				case "indexOf":
-					return (cast jvm.StringExt.indexOf : java.lang.invoke.MethodHandle).bindTo(obj);
+					return (readFieldNoObject(jvm.StringExt, "indexOf") : Closure).bindTo(obj);
 				case "iterator":
 					return function() return new haxe.iterators.StringIterator(obj);
 				case "keyValueIterator":
 					return function() return new haxe.iterators.StringKeyValueIterator(obj);
 				case "lastIndexOf":
-					return (cast jvm.StringExt.lastIndexOf : java.lang.invoke.MethodHandle).bindTo(obj);
+					return (readFieldNoObject(jvm.StringExt, "lastIndexOf") : Closure).bindTo(obj);
 				case "split":
-					return (cast jvm.StringExt.split : java.lang.invoke.MethodHandle).bindTo(obj);
+					return (readFieldNoObject(jvm.StringExt, "split") : Closure).bindTo(obj);
 				case "substr":
-					return (cast jvm.StringExt.substr : java.lang.invoke.MethodHandle).bindTo(obj);
+					return (readFieldNoObject(jvm.StringExt, "substr") : Closure).bindTo(obj);
 				case "substring":
-					return (cast jvm.StringExt.substring : java.lang.invoke.MethodHandle).bindTo(obj);
+					return (readFieldNoObject(jvm.StringExt, "substring") : Closure).bindTo(obj);
 				case "toLowerCase":
-					return (cast jvm.StringExt.toLowerCase : java.lang.invoke.MethodHandle).bindTo(obj);
+					return (readFieldNoObject(jvm.StringExt, "toLowerCase") : Closure).bindTo(obj);
 				case "toUpperCase":
-					return (cast jvm.StringExt.toUpperCase : java.lang.invoke.MethodHandle).bindTo(obj);
+					return (readFieldNoObject(jvm.StringExt, "toUpperCase") : Closure).bindTo(obj);
 			}
 		}
 		return readFieldNoObject(obj, name);

std/jvm/_std/Reflect.hx

@@ -84,7 +84,7 @@ class Reflect {
 	}
 
 	public static function isFunction(f:Dynamic):Bool {
-		return Jvm.instanceof(f, java.lang.invoke.MethodHandle);
+		return Jvm.instanceof(f, jvm.Function);
 	}
 
 	public static function compare<T>(a:T, b:T):Int {
@@ -120,15 +120,13 @@ class Reflect {
 		if (c1 != (f2 : java.lang.Object).getClass()) {
 			return false;
 		}
-		try {
-			var arg0 = c1.getDeclaredField("argL0");
-			arg0.setAccessible(true);
-			var arg1 = c1.getDeclaredField("argL1");
-			arg1.setAccessible(true);
-			return arg0.get(f1) == arg0.get(f2) && arg1.get(f1) == arg1.get(f2);
-		} catch (_:Dynamic) {
-			return false;
+		if (Std.is(f1, jvm.Function)) {
+			if (!Std.is(f2, jvm.Function)) {
+				return false;
+			}
+			return (f1 : jvm.Function).equals(f2);
 		}
+		return false;
 	}
 
 	public static function isObject(v:Dynamic):Bool {
@@ -144,7 +142,7 @@ class Reflect {
 		if (Jvm.instanceof(v, java.lang.Boolean.BooleanClass)) {
 			return false;
 		}
-		if (Jvm.instanceof(v, java.lang.invoke.MethodHandle)) {
+		if (Jvm.instanceof(v, jvm.Function)) {
 			return false;
 		}
 		return true;
@@ -174,9 +172,6 @@ class Reflect {
 
 	@:overload(function(f:Array<Dynamic>->Void):Dynamic {})
 	public static function makeVarArgs(f:Array<Dynamic>->Dynamic):Dynamic {
-		var fAdapt = function(args:java.NativeArray<Dynamic>) {
-			return f(@:privateAccess Array.ofNative(args));
-		}
-		return (cast fAdapt : java.lang.invoke.MethodHandle).asVarargsCollector(cast java.NativeArray);
+		return new jvm.Closure.VarArgs((cast f : jvm.Function));
 	}
 }

std/jvm/_std/Type.hx

@@ -260,7 +260,7 @@ class Type {
 		if (Jvm.instanceof(v, jvm.DynamicObject)) {
 			return TObject;
 		}
-		if (Jvm.instanceof(v, java.lang.invoke.MethodHandle)) {
+		if (Jvm.instanceof(v, jvm.Function)) {
 			return TFunction;
 		}
 		var c = (cast v : java.lang.Object).getClass();