Rework functional interface unification again (#11544)

* [jvm] rework functional interface unification again

see #11390

* add test

see #11236

* lazily check functional interface lut if there's no value

see #11549

src-json/meta.json

@@ -336,6 +336,12 @@
 		"targets": ["TAbstractField"],
 		"links": ["https://haxe.org/manual/types-abstract-implicit-casts.html"]
 	},
+	{
+		"name": "FunctionalInterface",
+		"metadata": ":functionalInterface",
+		"doc": "Mark an interface as a functional interface",
+		"platforms": ["jvm"]
+	},
 	{
 		"name": "FunctionCode",
 		"metadata": ":functionCode",

src/codegen/javaModern.ml

@@ -993,6 +993,16 @@ module Converter = struct
 			in
 			add_meta (Meta.Annotation,args,p)
 		end;
+		List.iter (fun attr -> match attr with
+			| AttrVisibleAnnotations ann ->
+				List.iter (function
+					| { ann_type = TObject( (["java";"lang"], "FunctionalInterface"), [] ) } ->
+						add_meta (Meta.FunctionalInterface,[],p);
+					| _ -> ()
+				) ann
+			| _ ->
+				()
+		) jc.jc_attributes;
 		let d = {
 			d_name = (class_name,p);
 			d_doc = None;

src/context/abstractCast.ml

@@ -87,10 +87,19 @@ and do_check_cast ctx uctx tleft eright p =
 						loop2 a.a_to
 					end
 				| TInst(c,tl), TFun _ when has_class_flag c CFunctionalInterface ->
-					let cf = ctx.g.functional_interface_lut#find c.cl_path in
+					let cf = try
+						snd (ctx.com.functional_interface_lut#find c.cl_path)
+					with Not_found -> match TClass.get_singular_interface_field c.cl_ordered_fields with
+						| None ->
+							raise Not_found
+						| Some cf ->
+							ctx.com.functional_interface_lut#add c.cl_path (c,cf);
+							cf
+					in
 					let map = apply_params c.cl_params tl in
 					let monos = Monomorph.spawn_constrained_monos map cf.cf_params in
-					unify_raise_custom uctx eright.etype (map (apply_params cf.cf_params monos cf.cf_type)) p;
+					unify_raise_custom native_unification_context eright.etype (map (apply_params cf.cf_params monos cf.cf_type)) p;
+					if has_mono tright then raise_typing_error ("Cannot use this function as a functional interface because it has unknown types: " ^ (s_type (print_context()) tright)) p;
 					eright
 				| _ ->
 					raise Not_found

src/context/common.ml

@@ -407,6 +407,7 @@ type context = {
 	mutable modules : Type.module_def list;
 	mutable types : Type.module_type list;
 	mutable resources : (string,string) Hashtbl.t;
+	functional_interface_lut : (path,(tclass * tclass_field)) lookup;
 	(* target-specific *)
 	mutable flash_version : float;
 	mutable neko_lib_paths : string list;
@@ -845,6 +846,7 @@ let create compilation_step cs version args display_mode =
 		has_error = false;
 		report_mode = RMNone;
 		is_macro_context = false;
+		functional_interface_lut = new Lookup.hashtbl_lookup;
 		hxb_reader_api = None;
 		hxb_reader_stats = HxbReader.create_hxb_reader_stats ();
 		hxb_writer_config = None;
@@ -901,6 +903,7 @@ let clone com is_macro_context =
 		hxb_reader_api = None;
 		hxb_reader_stats = HxbReader.create_hxb_reader_stats ();
 		std = null_class;
+		functional_interface_lut = new Lookup.hashtbl_lookup;
 		empty_class_path = new ClassPath.directory_class_path "" User;
 		class_paths = new ClassPaths.class_paths;
 	}

src/context/typecore.ml

@@ -120,7 +120,6 @@ type typer_globals = {
 	mutable complete : bool;
 	mutable type_hints : (module_def_display * pos * t) list;
 	mutable load_only_cached_modules : bool;
-	functional_interface_lut : (path,tclass_field) lookup;
 	mutable return_partial_type : bool;
 	mutable build_count : int;
 	mutable t_dynamic_def : Type.t;

src/core/tOther.ml

@@ -431,6 +431,26 @@ module TClass = struct
 			cf.cf_expr <- Some e;
 			c.cl_init <- Some cf
 
+	let get_singular_interface_field fields =
+		let is_normal_field cf =
+			not (has_class_field_flag cf CfDefault) && match cf.cf_kind with
+				| Method MethNormal -> true
+				| _ -> false
+		in
+		let rec loop o l = match l with
+			| cf :: l ->
+				if is_normal_field cf then begin
+					if o = None then
+						loop (Some cf) l
+					else
+						None
+				end else
+					loop o l
+			| [] ->
+				o
+		in
+		loop None fields
+
 	let add_cl_init c e =
 		modify_cl_init c e true
 

src/core/tUnification.ml

@@ -66,6 +66,17 @@ let default_unification_context = {
 	strict_field_kind       = false;
 }
 
+(* Unify like targets (e.g. Java) probably would. *)
+let native_unification_context = {
+	allow_transitive_cast = false;
+	allow_abstract_cast   = false;
+	allow_dynamic_to_cast = false;
+	equality_kind         = EqStrict;
+	equality_underlying   = false;
+	allow_arg_name_mismatch = true;
+	strict_field_kind       = false;
+}
+
 module Monomorph = struct
 	let create () = {
 		tm_type = None;

src/generators/genjvm.ml

@@ -60,6 +60,7 @@ type generation_context = {
 	t_exception : Type.t;
 	t_throwable : Type.t;
 	anon_identification : jsignature tanon_identification;
+	mutable functional_interfaces : (tclass * tclass_field * JvmFunctions.JavaFunctionalInterface.t) list;
 	mutable preprocessor : jsignature preprocessor;
 	default_export_config : export_config;
 	typed_functions : JvmFunctions.typed_functions;
@@ -417,10 +418,31 @@ let generate_equals_function (jc : JvmClass.builder) jsig_arg =
 	save();
 	jm_equals,load
 
-let create_field_closure gctx jc path_this jm name jsig =
+let associate_functional_interfaces gctx f t =
+	if not (has_mono t) then begin
+		List.iter (fun (c,cf,jfi) ->
+			let c_monos = Monomorph.spawn_constrained_monos (fun t -> t) c.cl_params in
+			let map t = apply_params c.cl_params c_monos t in
+			let cf_monos = Monomorph.spawn_constrained_monos map cf.cf_params in
+			try
+				Type.unify_custom native_unification_context t (apply_params cf.cf_params cf_monos (map cf.cf_type));
+				ignore(List.map follow cf_monos);
+				f#add_functional_interface jfi (List.map (jsignature_of_type gctx) c_monos)
+			with Unify_error _ ->
+				()
+		) gctx.functional_interfaces
+	end
+
+let create_field_closure gctx jc path_this jm name jsig t =
 	let jsig_this = object_path_sig path_this in
 	let context = ["this",jsig_this] in
 	let wf = new JvmFunctions.typed_function gctx.typed_functions (FuncMember(path_this,name)) jc jm context in
+	begin match t with
+		| None ->
+			()
+		| Some t ->
+			associate_functional_interfaces gctx wf t
+	end;
 	let jc_closure = wf#get_class in
 	ignore(wf#generate_constructor true);
 	let args,ret = match jsig with
@@ -461,12 +483,12 @@ let create_field_closure gctx jc path_this jm name jsig =
 	write_class gctx 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 create_field_closure gctx jc path_this jm name jsig f t =
 	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
+		let closure_path = create_field_closure gctx jc path_this jm name jsig t in
 		Hashtbl.add gctx.closure_paths (path_this,name,jsig) closure_path;
 		closure_path
 	in
@@ -576,6 +598,7 @@ class texpr_to_jvm
 			| _ -> None
 		in
 		let wf = new JvmFunctions.typed_function gctx.typed_functions (FuncLocal name) jc jm context in
+		associate_functional_interfaces gctx wf e.etype;
 		let jc_closure = wf#get_class in
 		ignore(wf#generate_constructor (env <> []));
 		let filter = match ret with
@@ -659,12 +682,13 @@ class texpr_to_jvm
 		| None ->
 			default();
 
-	method read_static_closure (path : path) (name : string) (args : (string * jsignature) list) (ret : jsignature option) =
+	method read_static_closure (path : path) (name : string) (args : (string * jsignature) list) (ret : jsignature option) (t : Type.t) =
 		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 (FuncStatic(path,name)) jc jm [] in
+			associate_functional_interfaces gctx wf t;
 			let jc_closure = wf#get_class in
 			ignore(wf#generate_constructor false);
 			let jm_invoke = wf#generate_invoke args ret [] in
@@ -691,7 +715,7 @@ class texpr_to_jvm
 				| TFun(tl,tr) -> List.map (fun (n,_,t) -> n,self#vtype t) tl,(return_of_type gctx tr)
 				| _ -> die "" __LOC__
 			in
-			self#read_static_closure path cf.cf_name args ret
+			self#read_static_closure path cf.cf_name args ret cf.cf_type
 		in
 		let dynamic_read s =
 			self#texpr rvalue_any e1;
@@ -738,7 +762,7 @@ class texpr_to_jvm
 			else
 				create_field_closure gctx jc c.cl_path jm cf.cf_name (self#vtype cf.cf_type) (fun () ->
 					self#texpr rvalue_any e1;
-				)
+				) (Some cf.cf_type)
 
 	method read_write ret ak e (f : unit -> unit) =
 		let apply dup =
@@ -2209,7 +2233,7 @@ let generate_dynamic_access gctx (jc : JvmClass.builder) fields is_anon =
 			begin match kind,jsig with
 				| Method (MethNormal | MethInline),TMethod(args,_) ->
 					if gctx.dynamic_level >= 2 then begin
-						create_field_closure gctx jc jc#get_this_path jm name jsig (fun () -> jm#load_this)
+						create_field_closure gctx jc jc#get_this_path jm name jsig (fun () -> jm#load_this) None
 					end else begin
 						jm#load_this;
 						jm#string name;
@@ -2942,7 +2966,7 @@ module Preprocessor = struct
 		end else if fst mt.mt_path = [] then
 			mt.mt_path <- make_root mt.mt_path
 
-	let check_single_method_interface gctx c =
+	let check_functional_interface gctx c =
 		let rec loop m l = match l with
 			| [] ->
 				m
@@ -2961,7 +2985,8 @@ module Preprocessor = struct
 		| Some cf ->
 			match jsignature_of_type gctx cf.cf_type with
 			| TMethod(args,ret) ->
-				JvmFunctions.JavaFunctionalInterfaces.add args ret c.cl_path cf.cf_name (List.map extract_param_name (c.cl_params @ cf.cf_params));
+				let jfi = JvmFunctions.JavaFunctionalInterface.create args ret c.cl_path cf.cf_name (List.map extract_param_name (c.cl_params @ cf.cf_params)) in
+				gctx.functional_interfaces <- (c,cf,jfi) :: gctx.functional_interfaces;
 			| _ ->
 				()
 
@@ -2993,8 +3018,10 @@ module Preprocessor = struct
 		List.iter (fun mt ->
 			match mt with
 			| TClassDecl c ->
-				if not (has_class_flag c CInterface) then gctx.preprocessor#preprocess_class c
-				else check_single_method_interface gctx c;
+				if not (has_class_flag c CInterface) then
+					gctx.preprocessor#preprocess_class c
+				else if has_class_flag c CFunctionalInterface then
+					check_functional_interface gctx c
 			| _ -> ()
 		) gctx.com.types;
 		(* find typedef-interface implementations *)
@@ -3070,6 +3097,7 @@ let generate jvm_flag com =
 		timer = new Timer.timer ["generate";"java"];
 		jar_compression_level = compression_level;
 		dynamic_level = dynamic_level;
+		functional_interfaces = [];
 	} in
 	gctx.preprocessor <- new preprocessor com.basic (jsignature_of_type gctx);
 	gctx.typedef_interfaces <- new typedef_interfaces gctx.preprocessor#get_infos anon_identification;

src/generators/jvm/jvmFunctions.ml

@@ -285,7 +285,7 @@ type typed_function_kind =
 	| FuncMember of jpath * string
 	| FuncStatic of jpath * string
 
-module JavaFunctionalInterfaces = struct
+module JavaFunctionalInterface = struct
 	type t = {
 		jargs: jsignature list;
 		jret : jsignature option;
@@ -302,9 +302,7 @@ module JavaFunctionalInterfaces = struct
 		"jparams",String.concat ", " jfi.jparams;
 	]
 
-	let java_functional_interfaces = DynArray.create ()
-
-	let add args ret path name params =
+	let create args ret path name params =
 		let jfi = {
 			jargs = args;
 			jret = ret;
@@ -312,83 +310,9 @@ module JavaFunctionalInterfaces = struct
 			jname = name;
 			jparams = params;
 		} in
-		DynArray.add java_functional_interfaces jfi
-
-	let unify jfi args ret =
-		let params = ref [] in
-		let rec unify jsig1 jsig2 = match jsig1,jsig2 with
-			| TObject _,TObject((["java";"lang"],"Object"),[]) ->
-				true
-			| TObject(path1,params1),TObject(path2,params2) ->
-				path1 = path2 &&
-				unify_params params1 params2
-			| TTypeParameter n,jsig
-			| jsig,TTypeParameter n ->
-				List.mem_assoc n !params || begin
-					params := (n,jsig) :: !params;
-					true
-				end
-			| _ ->
-				jsig1 = jsig2
-		and unify_params params1 params2 = match params1,params2 with
-			| [],_
-			| _,[] ->
-				(* Assume raw type, I guess? *)
-				true
-			| param1 :: params1,param2 :: params2 ->
-				match param1,param2 with
-				| TAny,_
-				| _,TAny ->
-					(* Is this correct in both directions? *)
-					unify_params params1 params2
-				| TType(_,jsig1),TType(_,jsig2) ->
-					(* TODO: wildcard? *)
-					unify jsig1 jsig2 && unify_params params1 params2
-		in
-		let rec loop want have = match want,have with
-			| [],[] ->
-				let params = List.map (fun s ->
-					try
-						TType(WNone,List.assoc s !params)
-					with Not_found ->
-						TAny
-				) jfi.jparams in
-				Some (jfi,params)
-			| want1 :: want,have1 :: have ->
-				if unify have1 want1 then loop want have
-				else None
-			| _ ->
-				None
-		in
-		match jfi.jret,ret with
-		| None,None ->
-			loop jfi.jargs args
-		| Some jsig1,Some jsig2 ->
-			if unify jsig2 jsig1 then loop jfi.jargs args
-			else None
-		| _ ->
-			None
-
-
-	let find_compatible args ret filter =
-		DynArray.fold_left (fun acc jfi ->
-			if filter = [] || List.mem jfi.jpath filter then begin
-				if jfi.jparams = [] then begin
-					if jfi.jargs = args && jfi.jret = ret then
-						(jfi,[]) :: acc
-					else
-						acc
-				end else match unify jfi args ret with
-					| Some x ->
-						x :: acc
-					| None ->
-						acc
-			end else
-				acc
-		) [] java_functional_interfaces
+		jfi
 end
 
-open JavaFunctionalInterfaces
 open JvmGlobals
 
 class typed_function
@@ -400,6 +324,8 @@ class typed_function
 
 = object(self)
 
+	val mutable functional_interfaces = []
+
 	val jc_closure =
 		let name = match kind with
 			| FuncLocal s ->
@@ -431,6 +357,10 @@ class typed_function
 		jm_ctor#return;
 		jm_ctor
 
+	method add_functional_interface (jfi : JavaFunctionalInterface.t) (params : jsignature list) =
+		let params = List.map (fun jsig -> TType(WNone,jsig)) params in
+		functional_interfaces <- (jfi,params) :: functional_interfaces
+
 	method generate_invoke (args : (string * jsignature) list) (ret : jsignature option) (functional_interface_filter : jpath list) =
 		let arg_sigs = List.map snd args in
 		let meth = functions#register_signature arg_sigs ret in
@@ -455,19 +385,16 @@ class typed_function
 				functions#make_forward_method jc_closure jm_invoke_next meth_from meth_to;
 			end
 		in
-		let check_functional_interfaces meth =
-			let l = JavaFunctionalInterfaces.find_compatible meth.dargs meth.dret functional_interface_filter in
-			List.iter (fun (jfi,params) ->
-				add_interface jfi.jpath params;
-				let msig = method_sig jfi.jargs jfi.jret in
-				if not (jc_closure#has_method jfi.jname msig) then begin
-					let jm_invoke_next = spawn_invoke_next jfi.jname msig false in
-					functions#make_forward_method_jsig jc_closure jm_invoke_next meth.name jfi.jargs jfi.jret meth.dargs meth.dret
-				end
-			) l
-		in
+		let open JavaFunctionalInterface in
+		List.iter (fun (jfi,params) ->
+			add_interface jfi.jpath params;
+			let msig = method_sig jfi.jargs jfi.jret in
+			if not (jc_closure#has_method jfi.jname msig) then begin
+				let jm_invoke_next = spawn_invoke_next jfi.jname msig false in
+				functions#make_forward_method_jsig jc_closure jm_invoke_next meth.name jfi.jargs jfi.jret meth.dargs meth.dret
+			end
+		) functional_interfaces;
 		let rec loop meth =
-			check_functional_interfaces meth;
 			begin match meth.next with
 			| Some meth_next ->
 				spawn_forward_function meth_next meth true;

src/typing/typeloadFields.ml

@@ -1602,28 +1602,12 @@ let finalize_class cctx =
 	) cctx.delayed_expr
 
 let check_functional_interface ctx c =
-	let is_normal_field cf =
-		(* TODO: more? *)
-		not (has_class_field_flag cf CfDefault)
-	in
-	let rec loop o l = match l with
-		| cf :: l ->
-			if is_normal_field cf then begin
-				if o = None then
-					loop (Some cf) l
-				else
-					None
-			end else
-				loop o l
-		| [] ->
-			o
-	in
-	match loop None c.cl_ordered_fields with
+	match TClass.get_singular_interface_field c.cl_ordered_fields with
 	| None ->
 		()
 	| Some cf ->
 		add_class_flag c CFunctionalInterface;
-		ctx.g.functional_interface_lut#add c.cl_path cf
+		ctx.com.functional_interface_lut#add c.cl_path (c,cf)
 
 let init_class ctx_c cctx c p herits fields =
 	let com = ctx_c.com in
@@ -1746,7 +1730,7 @@ let init_class ctx_c cctx c p herits fields =
 			a.a_unops <- List.rev a.a_unops;
 			a.a_array <- List.rev a.a_array;
 		| None ->
-			if (has_class_flag c CInterface) && com.platform = Jvm then check_functional_interface ctx_c c;
+			if (has_class_flag c CFunctionalInterface) && com.platform = Jvm then check_functional_interface ctx_c c;
 	end;
 	c.cl_ordered_statics <- List.rev c.cl_ordered_statics;
 	c.cl_ordered_fields <- List.rev c.cl_ordered_fields;

src/typing/typeloadModule.ml

@@ -318,6 +318,12 @@ module ModuleLevel = struct
 			| ((EClass d, p),TClassDecl c) ->
 				c.cl_params <- type_type_params ctx_m TPHType c.cl_path p d.d_params;
 				if Meta.has Meta.Generic c.cl_meta && c.cl_params <> [] then c.cl_kind <- KGeneric;
+				if Meta.has Meta.FunctionalInterface c.cl_meta then begin
+					if not (has_class_flag c CInterface) then
+						raise_typing_error "@:functionalInterface is only allowed on interfaces, as the name implies" c.cl_name_pos
+					else
+						add_class_flag c CFunctionalInterface
+				end;
 				if Meta.has Meta.GenericBuild c.cl_meta then begin
 					if ctx_m.com.is_macro_context then raise_typing_error "@:genericBuild cannot be used in macros" c.cl_pos;
 					c.cl_kind <- KGenericBuild d.d_data;

src/typing/typerEntry.ml

@@ -27,7 +27,6 @@ let create com macros =
 			return_partial_type = false;
 			build_count = 0;
 			t_dynamic_def = t_dynamic;
-			functional_interface_lut = new Lookup.pmap_lookup;
 			do_macro = MacroContext.type_macro;
 			do_load_macro = MacroContext.load_macro';
 			do_load_module = TypeloadModule.load_module;

tests/misc/java/projects/Issue11014/Main.hx

@@ -1,3 +1,4 @@
+@:functionalInterface
 interface MathOperation {
 	function perform(a:Int, b:Int):Int;
 }

tests/misc/java/projects/Issue11014/compile.hxml.stdout

@@ -1,4 +1,4 @@
-Main.hx:17: Add: 12
-Main.hx:20: Subtract: 4
-Main.hx:23: Multiply: 32
-Main.hx:28: Divide: 2
+Main.hx:18: Add: 12
+Main.hx:21: Subtract: 4
+Main.hx:24: Multiply: 32
+Main.hx:29: Divide: 2

tests/misc/java/projects/Issue11054/pack/ItemGroupEvents.java

@@ -1,6 +1,7 @@
 package pack;
 
 public final class ItemGroupEvents {
+	@FunctionalInterface
 	public interface ModifyEntries {
 		void modifyEntries(int entries);
 	}

tests/unit/src/unit/issues/Issue11054.hx

@@ -10,10 +10,12 @@ private abstract class Robot<T> {
 	}
 }
 
+@:functionalInterface
 private interface IGreetRobot {
 	function greet<T>(robot:Robot<T>):Void;
 }
 
+@:functionalInterface
 private interface IMathOperation {
 	function operate(a:Int, b:Int):Int;
 }
@@ -51,7 +53,7 @@ class Issue11054 extends Test {
 		});
 
 		var called = false;
-		robot2.performTask(function(target) {
+		robot2.performTask(function(target:Robot<Dynamic>) {
 			called = true;
 		});
 		t(called);

tests/unit/src/unit/issues/Issue11236.hx

@@ -0,0 +1,30 @@
+package unit.issues;
+
+#if jvm
+import haxe.Int64;
+import java.lang.Runnable;
+import java.util.concurrent.Executors;
+import java.util.concurrent.TimeUnit;
+
+private final exec = Executors.newSingleThreadScheduledExecutor();
+private var called = false;
+
+private function schedule(f:() -> Void)
+	exec.schedule(f, 0, TimeUnit.MILLISECONDS);
+
+private function greeter():Void {
+	called = true;
+	exec.shutdown();
+}
+#end
+
+class Issue11236 extends Test {
+	#if jvm
+	function test() {
+		schedule(greeter);
+
+		t(exec.awaitTermination(Int64.ofInt(1), TimeUnit.SECONDS));
+		t(called);
+	}
+	#end
+}