[jvm] generate interface-per-typedef (#9195)

* [jvm] implement nadako-interfaces

* [jvm] fix bad path

* [jvm] rewrite everything

* [jvm] don't get murdered by Null<T> wrapping

* [jvm] make global context available to jsignature_of_type

* [jvm] use nadako-interfaces as signature

* [jvm] don't be TLazy

* [jvm] apply anon optimization to field writes as well

* [jvm] remove nadako

* [jvm] clean up a bit

src/generators/genjvm.ml

@@ -73,6 +73,7 @@ type generation_context = {
 	mutable anon_identification : jsignature tanon_identification;
 	mutable preprocessor : jsignature preprocessor;
 	default_export_config : export_config;
+	mutable typedef_interfaces : jsignature typedef_interfaces;
 	mutable current_field_info : field_generation_info option;
 }
 
@@ -160,7 +161,11 @@ let rec jsignature_of_type gctx stack t =
 		jsig
 	) tl) (if ExtType.is_void (follow tr) then None else Some (jsignature_of_type tr))
 	| TAnon an -> object_sig
-	| TType(td,tl) -> jsignature_of_type (apply_params td.t_params tl td.t_type)
+	| TType(td,tl) ->
+		begin match gctx.typedef_interfaces#get_interface_class td.t_path with
+		| Some c -> TObject(c.cl_path,[])
+		| None -> jsignature_of_type (apply_params td.t_params tl td.t_type)
+		end
 	| TLazy f -> jsignature_of_type (lazy_type f)
 
 and jtype_argument_of_type gctx stack t =
@@ -169,6 +174,11 @@ and jtype_argument_of_type gctx stack t =
 let jsignature_of_type gctx t =
 	jsignature_of_type gctx [] t
 
+let convert_fields gctx fields =
+	let l = PMap.foldi (fun s cf acc -> (s,cf) :: acc) fields [] in
+	let l = List.sort (fun (s1,_) (s2,_) -> compare s1 s2) l in
+	List.map (fun (s,cf) -> s,jsignature_of_type gctx cf.cf_type) l
+
 module AnnotationHandler = struct
 	let generate_annotations builder meta =
 		let parse_path e =
@@ -526,6 +536,27 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
 	method write_native_array vta vte =
 		NativeArray.write code vta vte
 
+	method read_anon_field cast t cf =
+		let default () =
+			jm#string cf.cf_name;
+			jm#invokestatic haxe_jvm_path "readField" (method_sig [object_sig;string_sig] (Some object_sig));
+			cast();
+		in
+		match gctx.anon_identification#identify true t with
+		| Some {t_path=path} ->
+			code#dup;
+			code#instanceof path;
+			jm#if_then_else
+				(fun () -> code#if_ref CmpEq)
+				(fun () ->
+					jm#cast (object_path_sig path);
+					jm#getfield path cf.cf_name (self#vtype cf.cf_type);
+					cast();
+				)
+				(fun () -> default());
+		| None ->
+			default();
+
 	method read cast e1 fa =
 		match fa with
 		| FStatic({cl_path = (["java";"lang"],"Math")},({cf_name = "NaN" | "POSITIVE_INFINITY" | "NEGATIVE_INFINITY"} as cf)) ->
@@ -555,29 +586,9 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
 			let offset = pool#add_field en.e_path ef.ef_name jsig FKField in
 			code#getstatic offset jsig;
 			cast();
-		| FAnon ({cf_name = s} as cf) ->
+		| FAnon cf ->
 			self#texpr rvalue_any e1;
-			let default () =
-				jm#string s;
-				jm#invokestatic haxe_jvm_path "readField" (method_sig [object_sig;string_sig] (Some object_sig));
-				cast();
-			in
-			begin match follow e1.etype with
-			| TAnon an ->
-				let path,_ = gctx.anon_identification#identify an.a_fields in
-				code#dup;
-				code#instanceof path;
-				jm#if_then_else
-					(fun () -> code#if_ref CmpEq)
-					(fun () ->
-						jm#cast (object_path_sig path);
-						jm#getfield path s (self#vtype cf.cf_type);
-						cast();
-					)
-					(fun () -> default());
-			| _ ->
-				default();
-			end
+			self#read_anon_field cast e1.etype cf;
 		| FDynamic s | FInstance(_,_,{cf_name = s}) | FEnum(_,{ef_name = s}) | FClosure(Some({cl_interface = true},_),{cf_name = s}) | FClosure(None,{cf_name = s}) ->
 			self#texpr rvalue_any e1;
 			jm#string s;
@@ -595,6 +606,18 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
 			f();
 			if ret <> RVoid && ak <> AKPost then dup();
 		in
+		let default s t =
+			if ak <> AKNone then code#dup;
+			jm#string s;
+			if ak <> AKNone then begin
+				code#dup_x1;
+				jm#invokestatic haxe_jvm_path "readField" (method_sig [object_sig;string_sig] (Some object_sig));
+				self#cast_expect ret t;
+			end;
+			apply (fun () -> code#dup_x2);
+			self#cast (self#mknull t);
+			jm#invokestatic haxe_jvm_path "writeField" (method_sig [object_sig;string_sig;object_sig] None)
+		in
 		match (Texpr.skip e).eexpr with
 		| TLocal v ->
 			let _,load,store = self#get_local v in
@@ -616,18 +639,35 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
 			apply (fun () -> code#dup_x1);
 			self#cast cf.cf_type;
 			jm#putfield c.cl_path cf.cf_name jsig_cf
-		| TField(e1,(FDynamic s | FAnon {cf_name = s} | FInstance(_,_,{cf_name = s}))) ->
+		| TField(e1,FAnon cf) ->
 			self#texpr rvalue_any e1;
-			if ak <> AKNone then code#dup;
-			jm#string s;
-			if ak <> AKNone then begin
-				code#dup_x1;
-				jm#invokestatic haxe_jvm_path "readField" (method_sig [object_sig;string_sig] (Some object_sig));
-				self#cast_expect ret e.etype;
-			end;
-			apply (fun () -> code#dup_x2);
-			self#cast (self#mknull e.etype);
-			jm#invokestatic haxe_jvm_path "writeField" (method_sig [object_sig;string_sig;object_sig] None)
+			begin match gctx.anon_identification#identify true e1.etype with
+			| Some {t_path=path} ->
+				code#dup;
+				code#instanceof path;
+				let jsig_cf = self#vtype cf.cf_type in
+				jm#if_then_else
+					(fun () -> code#if_ref CmpEq)
+					(fun () ->
+						jm#cast (object_path_sig path);
+						if ak <> AKNone then begin
+							code#dup;
+							jm#getfield path cf.cf_name jsig_cf;
+						end;
+						apply (fun () -> code#dup_x1);
+						jm#cast jsig_cf;
+						jm#putfield path cf.cf_name jsig_cf;
+					)
+					(fun () ->
+						default cf.cf_name cf.cf_type;
+						if ret <> RVoid then jm#cast jsig_cf;
+					);
+			| None ->
+				default cf.cf_name cf.cf_type;
+			end
+		| TField(e1,(FDynamic s | FInstance(_,_,{cf_name = s}))) ->
+			self#texpr rvalue_any e1;
+			default s e.etype;
 		| TArray(e1,e2) ->
 			begin match follow e1.etype with
 				| TInst({cl_path = (["haxe";"root"],"Array")} as c,[t]) ->
@@ -1261,6 +1301,12 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
 
 	method call ret tr e1 el =
 		let retype tr = match tr with None -> [] | Some t -> [t] in
+		let invoke t =
+			jm#cast method_handle_sig;
+			let tl,tr = self#call_arguments t el in
+			jm#invokevirtual method_handle_path "invoke" (method_sig tl tr);
+			tr
+		in
 		let tro = match (Texpr.skip e1).eexpr with
 		| TField(_,FStatic({cl_path = ["haxe";"jvm"],"Jvm"},({cf_name = "referenceEquals"} as cf))) ->
 			let tl,tr = self#call_arguments cf.cf_type el in
@@ -1409,6 +1455,29 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
 			let tr = self#vtype tr in
 			jm#invokestatic en.e_path ef.ef_name (method_sig tl (Some tr));
 			Some tr
+		| TField(e11,FAnon cf) ->
+			begin match gctx.anon_identification#identify false e11.etype with
+			| Some {t_path=path_anon} ->
+				begin match gctx.typedef_interfaces#get_interface_class path_anon with
+				| Some c ->
+					let c,_,cf = raw_class_field (fun cf -> cf.cf_type) c [] cf.cf_name in
+					let path_inner = match c with
+						| Some(c,_) -> c.cl_path
+						| _ -> assert false
+					in
+					self#texpr rvalue_any e11;
+					let tl,tr = self#call_arguments cf.cf_type el in
+					jm#invokeinterface path_inner cf.cf_name (self#vtype cf.cf_type);
+					Option.may jm#cast tr;
+					tr
+				| None ->
+					self#texpr rvalue_any e1;
+					invoke e1.etype
+				end
+			| None ->
+				self#texpr rvalue_any e1;
+				invoke e1.etype
+			end
 		| TConst TSuper ->
 			let c,cf = match gctx.current_field_info with
 				| Some ({super_call_fields = hd :: tl} as info) ->
@@ -1493,10 +1562,7 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
 				Some object_sig
 			end else begin
 				self#texpr rvalue_any e1;
-				jm#cast method_handle_sig;
-				let tl,tr = self#call_arguments e1.etype el in
-				jm#invokevirtual method_handle_path "invoke" (method_sig tl tr);
-				tr
+				invoke e1.etype;
 			end
 		in
 		match ret = RVoid,tro with
@@ -1964,12 +2030,16 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
 				jm#set_terminated true
 			end
 		| TObjectDecl fl ->
-			begin match follow e.etype with
+			let td = gctx.anon_identification#identify true e.etype in
+			begin match follow e.etype,td with
 			(* The guard is here because in the case of quoted fields like `"a-b"`, the field is not part of the
 			   type. In this case we have to do full dynamic construction. *)
-			| TAnon an when List.for_all (fun ((name,_,_),_) -> PMap.mem name an.a_fields) fl ->
-				let path,fl' = gctx.anon_identification#identify an.a_fields in
-				jm#construct ConstructInit path (fun () ->
+			| TAnon an,Some td when List.for_all (fun ((name,_,_),_) -> PMap.mem name an.a_fields) fl ->
+				let fl' = match follow td.t_type with
+					| TAnon an -> convert_fields gctx an.a_fields
+					| _ -> assert false
+				in
+				jm#construct ConstructInit td.t_path (fun () ->
 					(* We have to respect declaration order, so let's temp var where necessary *)
 					let rec loop fl fl' ok acc = match fl,fl' with
 						| ((name,_,_),e) :: fl,(name',jsig) :: fl' ->
@@ -2000,8 +2070,9 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
 					in
 					let vars = loop fl fl' true [] in
 					let vars = List.sort (fun (name1,_) (name2,_) -> compare name1 name2) vars in
-					List.iter (fun (_,load) ->
+					List.iter (fun (name,load) ->
 						load();
+						if List.mem_assoc name fl' then jm#cast (List.assoc name fl')
 					) vars;
 					List.map snd fl';
 				)
@@ -2650,6 +2721,16 @@ module Preprocessor = struct
 		["haxe";"root"],snd path
 
 	let preprocess gctx =
+		(* go through com.modules so we can also pick up private typedefs *)
+		List.iter (fun m ->
+			List.iter (fun mt -> match mt with
+				| TTypeDecl td ->
+					gctx.anon_identification#identify_typedef td
+				| _ ->
+					()
+			) m.m_types
+		) gctx.com.modules;
+		(* preprocess classes *)
 		List.iter (fun mt ->
 			match mt with
 			| TClassDecl c ->
@@ -2658,6 +2739,13 @@ module Preprocessor = struct
 			| TEnumDecl en ->
 				if fst en.e_path = [] then en.e_path <- make_root en.e_path;
 			| _ -> ()
+		) gctx.com.types;
+		(* find typedef-interface implementations *)
+		List.iter (fun mt -> match mt with
+			| TClassDecl c when debug_path c.cl_path && not c.cl_interface && not c.cl_extern ->
+				gctx.typedef_interfaces#process_class c;
+			| _ ->
+				()
 		) gctx.com.types
 end
 
@@ -2681,21 +2769,23 @@ let generate com =
 	let jar_name = if com.debug then jar_name ^ "-Debug" else jar_name in
 	let jar_dir = add_trailing_slash com.file in
 	let jar_path = Printf.sprintf "%s%s.jar" jar_dir jar_name in
+	let anon_identification = new tanon_identification haxe_dynamic_object_path in
 	let gctx = {
 		com = com;
 		jar = Zip.open_out jar_path;
 		t_exception = TInst(resolve_class com (["java";"lang"],"Exception"),[]);
 		t_throwable = TInst(resolve_class com (["java";"lang"],"Throwable"),[]);
-		anon_identification = Obj.magic ();
+		anon_identification = anon_identification;
 		preprocessor = Obj.magic ();
+		typedef_interfaces = Obj.magic ();
 		current_field_info = None;
 		default_export_config = {
 			export_debug = com.debug;
 		}
 	} in
-	let anon_identification = new tanon_identification haxe_dynamic_object_path (jsignature_of_type gctx) in
 	gctx.anon_identification <- anon_identification;
-	gctx.preprocessor <- new preprocessor com.basic anon_identification (jsignature_of_type gctx);
+	gctx.preprocessor <- new preprocessor com.basic (jsignature_of_type gctx);
+	gctx.typedef_interfaces <- new typedef_interfaces anon_identification;
 	Std.finally (Timer.timer ["generate";"java";"preprocess"]) Preprocessor.preprocess gctx;
 	let class_paths = ExtList.List.filter_map (fun java_lib ->
 		if java_lib#has_flag NativeLibraries.FlagIsStd then None
@@ -2725,7 +2815,13 @@ let generate com =
 		Zip.add_entry v gctx.jar filename;
 	) com.resources;
 	List.iter (generate_module_type gctx) com.types;
-	Hashtbl.iter (fun fields path ->
+	Hashtbl.iter (fun _ c -> generate_module_type gctx (TClassDecl c)) gctx.typedef_interfaces#get_interfaces;
+	Hashtbl.iter (fun path td ->
+		let fields = match follow td.t_type with
+			| TAnon an -> an.a_fields
+			| _ -> assert false
+		in
+		let fields = convert_fields gctx fields in
 		let jc = new JvmClass.builder path haxe_dynamic_object_path in
 		jc#add_access_flag 0x1;
 		begin
@@ -2758,6 +2854,33 @@ let generate com =
 			jm_fields#get_code#return_value string_map_sig
 		end;
 		generate_dynamic_access gctx jc (List.map (fun (name,jsig) -> name,jsig,Var {v_write = AccNormal;v_read = AccNormal}) fields) true;
+		begin match gctx.typedef_interfaces#get_interface_class path with
+		| None ->
+			()
+		| Some c ->
+			jc#add_interface c.cl_path;
+			List.iter (fun cf ->
+				let jsig_cf = jsignature_of_type gctx cf.cf_type in
+				let jm = jc#spawn_method cf.cf_name jsig_cf [MPublic] in
+				let tl,tr = match follow cf.cf_type with
+					| TFun(tl,tr) -> tl,tr
+					| _ -> assert false
+				in
+				let locals = List.map (fun (n,_,t) ->
+					let jsig = jsignature_of_type gctx t in
+					jm#add_local n jsig VarArgument,jsig
+				) tl in
+				jm#finalize_arguments;
+				jm#load_this;
+				jm#getfield path cf.cf_name jsig_cf;
+				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);
+				jm#return
+			) c.cl_ordered_fields
+		end;
 		write_class gctx.jar path (jc#export_class gctx.default_export_config)
-	) gctx.anon_identification#get_lut;
+	) gctx.anon_identification#get_anons;
 	Zip.close_out gctx.jar

src/generators/genshared.ml

@@ -108,39 +108,108 @@ let find_overload_rec is_ctor map_type c cf el =
 		| Some (_,_,(c,cf,tl)) -> Some (c,cf,tl)
 		| None -> Some(c,cf,List.map snd cf.cf_params)
 
-class ['a] tanon_identification (empty_path : string list * string) (convert : Type.t -> 'a) = object(self)
-	val lut = Hashtbl.create 0
-	val path_lut = Hashtbl.create 0
+exception Typedef_result of tdef
+
+class ['a] tanon_identification (empty_path : string list * string) =
+	let is_normal_anon an = match !(an.a_status) with
+		| Closed | Const | Opened -> true
+		| _ -> false
+	in
+object(self)
+
+	val td_anons = Hashtbl.create 0
 	val mutable num = 0
 
-	method get_lut = lut
+	method get_anons = td_anons
 
-	method convert_fields (fields : (string,tclass_field) PMap.t) =
-		let l = PMap.fold (fun cf acc -> cf :: acc) fields [] in
-		let l = List.sort (fun cf1 cf2 -> compare cf1.cf_name cf2.cf_name) l in
-		List.map (fun cf -> cf.cf_name,convert cf.cf_type) l
+	method unify (tc : Type.t) (td : tdef) =
+		let monos = List.map (fun _ -> mk_mono()) td.t_params in
+		let ta = apply_params td.t_params monos td.t_type in
+		begin match follow tc,follow ta with
+		| TInst(c,tl) as t1,(TAnon an as t2) ->
+			Type.unify t1 t2
+		| TAnon an1,TAnon an2 ->
+			Type.type_eq EqDoNotFollowNull tc ta;
+		| _ ->
+			raise (Unify_error [])
+		end;
+		(* Check if we applied Void to a return type parameter... (#3463) *)
+		List.iter (fun t -> match follow t with
+			| TMono r ->
+				Monomorph.bind r t_dynamic
+			| t ->
+				if Type.ExtType.is_void t then raise(Unify_error [])
+		) monos;
 
-	method identify (fields : (string,tclass_field) PMap.t) =
-		if PMap.is_empty fields then
-			empty_path,[]
-		else begin
-			let l = self#convert_fields fields in
-			try
-				Hashtbl.find lut l,l
+	method find_compatible (tc : Type.t) =
+		try
+			Hashtbl.iter (fun _ td ->
+				try
+					self#unify tc td;
+					raise (Typedef_result td)
+				with Unify_error _ ->
+					()
+			) td_anons;
+			raise Not_found
+		with Typedef_result td ->
+			td
+
+	method identify_typedef (td : tdef) =
+		let rec loop t = match t with
+			| TAnon an when is_normal_anon an && not (PMap.is_empty an.a_fields) ->
+				Hashtbl.replace td_anons td.t_path td;
+			| TMono {tm_type = Some t} ->
+				loop t
+			| TLazy f ->
+				loop (lazy_type f)
+			| t ->
+				()
+		in
+		loop td.t_type
+
+	method identify (accept_anons : bool) (t : Type.t) =
+		match t with
+		| TType(td,tl) ->
+			begin try
+				Some (Hashtbl.find td_anons td.t_path)
+			with Not_found ->
+				self#identify accept_anons (apply_params td.t_params tl td.t_type)
+			end
+		| TMono {tm_type = Some t} ->
+			self#identify accept_anons t
+		| TAbstract(a,tl) when not (Meta.has Meta.CoreType a.a_meta) ->
+			self#identify accept_anons (Abstract.get_underlying_type a tl)
+		| TAbstract({a_path=([],"Null")},[t]) ->
+			self#identify accept_anons t
+		| TLazy f ->
+			self#identify accept_anons (lazy_type f)
+		| TAnon an when accept_anons ->
+			PMap.iter (fun _ cf ->
+				Gencommon.replace_mono cf.cf_type
+			) an.a_fields;
+			begin try
+				Some (self#find_compatible t)
 			with Not_found ->
 				let id = num in
 				num <- num + 1;
 				let path = (["haxe";"generated"],Printf.sprintf "Anon%i" id) in
-				Hashtbl.add lut l path;
-				path,l
-		end
-
-	method identify_as path (fields : (string,tclass_field) PMap.t) =
-		if not (PMap.is_empty fields) && not (Hashtbl.mem path_lut path) then begin
-			let fields = self#convert_fields fields in
-			Hashtbl.add lut fields path;
-			Hashtbl.add path_lut path path;
-		end
+				let td = {
+					t_path = path;
+					t_module = null_module;
+					t_pos = null_pos;
+					t_name_pos = null_pos;
+					t_doc = None;
+					t_private = false;
+					t_params = [];
+					t_using = [];
+					t_type = t;
+					t_meta = [];
+				} in
+				Hashtbl.replace td_anons td.t_path td;
+				Some td
+			end;
+		| _ ->
+			None
 end
 
 type field_generation_info = {
@@ -151,17 +220,7 @@ type field_generation_info = {
 	mutable super_call_fields : (tclass * tclass_field) list;
 }
 
-class ['a] preprocessor (basic : basic_types) (anon_identification : 'a tanon_identification) (convert : Type.t -> 'a) =
-	let is_normal_anon an = match !(an.a_status) with
-		| Closed | Const | Opened -> true
-		| _ -> false
-	in
-	let check_anon e = match e.etype,follow e.etype with
-		| TType(td,_),TAnon an when is_normal_anon an ->
-			ignore(anon_identification#identify_as td.t_path an.a_fields)
-		| _ ->
-			()
-	in
+class ['a] preprocessor (basic : basic_types) (convert : Type.t -> 'a) =
 	let make_native cf =
 		cf.cf_meta <- (Meta.NativeGen,[],null_pos) :: cf.cf_meta
 	in
@@ -245,7 +304,6 @@ class ['a] preprocessor (basic : basic_types) (anon_identification : 'a tanon_id
 				end
 		in
 		let rec loop e =
-			check_anon e;
 			begin match e.eexpr with
 			| TBinop(OpAssign,{eexpr = TField({eexpr = TConst TThis},FInstance(_,_,cf))},e2) when is_on_current_class cf->
 				(* Assigning this.field = value is fine if field is declared on our current class *)
@@ -272,15 +330,8 @@ class ['a] preprocessor (basic : basic_types) (anon_identification : 'a tanon_id
 			super_call_fields = DynArray.to_list super_call_fields;
 		}
 
-	method preprocess_expr e =
-		let rec loop e =
-			check_anon e;
-			Type.iter loop e
-		in
-		loop e
-
 	method check_overrides c = match c.cl_overrides with
-		| []->
+		| [] ->
 			()
 		| fields ->
 			let csup,map_type = match c.cl_super with
@@ -316,16 +367,9 @@ class ['a] preprocessor (basic : basic_types) (anon_identification : 'a tanon_id
 			) fields
 
 	method preprocess_class (c : tclass) =
-		let field cf = match cf.cf_expr with
-			| None ->
-				()
-			| Some e ->
-				self#preprocess_expr e
-		in
 		let has_dynamic_instance_method = ref false in
 		let has_field_init = ref false in
 		let field mtype cf =
-			List.iter field (cf :: cf.cf_overloads);
 			match mtype with
 			| MConstructor ->
 				()
@@ -382,3 +426,76 @@ class ['a] preprocessor (basic : basic_types) (anon_identification : 'a tanon_id
 			in
 			List.iter field (cf :: cf.cf_overloads)
 end
+
+class ['a] typedef_interfaces (anon_identification : 'a tanon_identification) = object(self)
+
+	val lut = Hashtbl.create 0
+	val interfaces = Hashtbl.create 0
+
+	method get_interface_class (path : path) =
+		try Some (Hashtbl.find interfaces path)
+		with Not_found -> None
+
+	method get_interfaces = interfaces
+
+	method process_class (c : tclass) =
+		if not (Hashtbl.mem lut c.cl_path) then
+			self#do_process_class c
+
+	method private implements (path_class : path) (path_interface : path) =
+		try
+			let l = Hashtbl.find lut path_class in
+			List.exists (fun c -> c.cl_path = path_interface) l
+		with Not_found ->
+			false
+
+	method private implements_recursively (c : tclass) (path : path) =
+		self#implements c.cl_path path || match c.cl_super with
+			| Some (c,_) -> self#implements_recursively c path
+			| None -> false
+
+	method private make_interface_class (td : tdef) =
+		let path_inner = (fst td.t_path,snd td.t_path ^ "$Interface") in
+		try
+			Hashtbl.find interfaces path_inner
+		with Not_found ->
+			let fields = match follow td.t_type with
+				| TAnon an ->
+					PMap.foldi (fun name cf acc -> match cf.cf_kind with
+						| Method (MethNormal | MethInline) ->
+							PMap.add name cf acc
+						| _ ->
+							acc
+					) an.a_fields PMap.empty
+				| _ ->
+					assert false
+			in
+			if PMap.is_empty fields then raise (Unify_error []);
+			let c = mk_class null_module path_inner null_pos null_pos in
+			c.cl_interface <- true;
+			c.cl_fields <- fields;
+			c.cl_ordered_fields <- PMap.fold (fun cf acc -> cf :: acc) fields [];
+			Hashtbl.replace interfaces td.t_path c;
+			c
+
+	method private do_process_class (c : tclass) =
+		begin match c.cl_super with
+			| Some(c,_) -> self#process_class c
+			| None -> ()
+		end;
+		let tc = TInst(c,List.map snd c.cl_params) in
+		let l = Hashtbl.fold (fun _ td acc ->
+			let path = td.t_path in
+			let path_inner = (fst path,snd path ^ "$Interface") in
+			try
+				if self#implements_recursively c path_inner then raise (Unify_error []);
+				anon_identification#unify tc td;
+				let ci = self#make_interface_class td in
+				c.cl_implements <- (ci,[]) :: c.cl_implements;
+				(* print_endline (Printf.sprintf "%s IMPLEMENTS %s" (s_type_path c.cl_path) (s_type_path path_inner)); *)
+				(ci :: acc)
+			with Unify_error _ ->
+				acc
+		) anon_identification#get_anons [] in
+		Hashtbl.add lut c.cl_path l
+end

tests/benchs/src/cases/Calls.hx

@@ -35,13 +35,17 @@ class CallClassChild extends CallClass {
 	override function overrideCall2(s2:String, s2:String) { return null; }
 }
 
+typedef TInstanceCall0 = { function instanceCall0():String; };
+typedef TInstanceCall1 = { function instanceCall1(s1:String):String; }
+typedef TInstanceCall2 = { function instanceCall2(s1:String, s2:String):String; }
+
 class Calls extends TestCase {
 	@:analyzer(ignore)
 	function measureCall0() {
 		var c = new CallClass();
 		var cSub:CallClass = new CallClassChild();
 		var cInterface:CallInterface = c;
-		var cAnon:{ function instanceCall0():String; } = c;
+		var cAnon:TInstanceCall0 = c;
 		var cActualAnon = {
 			instanceCall0: function ():String {
 				return null;
@@ -75,9 +79,7 @@ class Calls extends TestCase {
 		var c = new CallClass();
 		var cSub:CallClass = new CallClassChild();
 		var cInterface:CallInterface = c;
-		var cAnon:{
-			function instanceCall1(s1:String):String;
-		} = c;
+		var cAnon:TInstanceCall1 = c;
 		var cActualAnon = {
 			instanceCall1: function (s1:String):String {
 				return null;
@@ -111,9 +113,7 @@ class Calls extends TestCase {
 		var c = new CallClass();
 		var cSub:CallClass = new CallClassChild();
 		var cInterface:CallInterface = c;
-		var cAnon:{
-			function instanceCall2(s1:String, s2:String):String;
-		} = c;
+		var cAnon:TInstanceCall2 = c;
 		var cActualAnon = {
 			instanceCall2: function (s1:String, s2:String):String {
 				return null;