[typer] rewrite `same_overload_args` and other checks

closes #9558
closes #9730

src/codegen/overloads.ml

@@ -2,74 +2,45 @@ open Globals
 open Type
 open Typecore
 
-type overload_args_comparison =
-  | Same
-  | Different
-  | Impl_conflict
-
-let distinguishes_funs_as_params ctx =
-  	match ctx.com.platform with
-  	| Java -> false
-  	| _ -> true
-
-let compare_overload_args ?(get_vmtype) ?(ctx) t1 t2 f1 f2 =
-	let get_vmtype = match get_vmtype with
-		| None -> (fun f -> f)
+let same_overload_args ?(get_vmtype) t1 t2 f1 f2 =
+	let f_transform = match get_vmtype with
 		| Some f -> f
+		| None -> (fun t -> t)
+	in
+	let f_eq t1 t2 = type_iseq (f_transform t1) (f_transform t2) in
+	let compare_type_params () =
+		let rec loop params1 params2 = match params1,params2 with
+			| [],[] ->
+				true
+			| (n1,t1) :: params1,(n2,t2) :: params2 ->
+				n1 = n2 && f_eq t1 t2 && loop params1 params2
+			| [],_
+			| _,[] ->
+				false
+		in
+		loop f1.cf_params f2.cf_params
 	in
-	if List.length f1.cf_params <> List.length f2.cf_params then
-		Different
-	else
-	let amb_funs =
-		match ctx with
-		| None -> false
-		| Some ctx -> not (distinguishes_funs_as_params ctx) in
-	let rec follow_skip_null t = match t with
-		| TMono r ->
-			(match r.tm_type with
-			| Some t -> follow_skip_null t
-			| _ -> t)
-		| TLazy f ->
-			follow_skip_null (lazy_type f)
-		| TAbstract ({ a_path = [],"Null" } as a, [p]) ->
-			TAbstract(a,[follow p])
-		| TType (t,tl) ->
-			follow_skip_null (apply_params t.t_params tl t.t_type)
-		| _ -> t
+	let compare_arguments tl1 tl2 =
+		let rec loop tl1 tl2 = match tl1,tl2 with
+			| [],[] ->
+				true
+			| (n1,o1,t1) :: tl1,(n2,o2,t2) :: tl2 ->
+				(* TODO: do we want to compare n and o here? *)
+				f_eq t1 t2 && loop tl1 tl2
+			| _ ->
+				false
+		in
+		loop tl1 tl2
 	in
-	let compare_type t1 t2 =
-		(if type_iseq t1 t2 then
-			Same
-		else if amb_funs && type_iseq (ambiguate_funs t1) (ambiguate_funs t2) then
-			Impl_conflict
-		else
-			Different) in
-	let compare_arg t1 t2 =
-		let t1 = get_vmtype (follow_skip_null t1) in
-		let t2 = get_vmtype (follow_skip_null t2) in
-		match t1, t2 with
-			| TType _, TType _ -> compare_type t1 t2
-			| TType _, _
-			| _, TType _ -> Different
-			| _ -> compare_type t1 t2
+	let compare_types () =
+		let t1 = follow (apply_params f1.cf_params (List.map (fun (_,t) -> t) f2.cf_params) t1) in
+		match t1,follow t2 with
+		| TFun(tl1,_),TFun(tl2,_) ->
+			compare_arguments tl1 tl2
+		| _ ->
+			false
 	in
-
-	match follow (apply_params f1.cf_params (List.map (fun (_,t) -> t) f2.cf_params) t1), follow t2 with
-		| TFun(a1,_), TFun(a2,_) ->
-			let rec loop args1 args2 =
-				match args1, args2 with
-				| [], [] -> Same
-				| [], _ | _, [] -> Different
-				| (_,_,t1) :: rest1, (_,_,t2) :: rest2 ->
-					match compare_arg t1 t2 with
-					| Same -> loop rest1 rest2
-					| result -> result
-			in
-			loop a1 a2
-		| _ -> die "" __LOC__
-
-let same_overload_args ?(get_vmtype) t1 t2 f1 f2 =
-	compare_overload_args ?get_vmtype t1 t2 f1 f2 <> Different
+	compare_type_params () && compare_types ()
 
 let collect_overloads map c i =
 	let acc = ref [] in

src/core/tFunctions.ml

@@ -491,28 +491,10 @@ let rec follow_without_null t =
 		follow_without_null (apply_params t.t_params tl t.t_type)
 	| _ -> t
 
-(** Assumes `follow` has already been applied *)
 let rec ambiguate_funs t =
-	match t with
+	match follow t with
 	| TFun _ -> TFun ([], t_dynamic)
-	| TMono r ->
-		(match r.tm_type with
-		| Some _ -> die "" __LOC__
-		| _ -> t)
-	| TInst (a, pl) ->
-	    TInst (a, List.map ambiguate_funs pl)
-	| TEnum (a, pl) ->
-	    TEnum (a, List.map ambiguate_funs pl)
-	| TAbstract (a, pl) ->
-	    TAbstract (a, List.map ambiguate_funs pl)
-	| TType (a, pl) ->
-	    TType (a, List.map ambiguate_funs pl)
-	| TDynamic _ -> t
-	| TAnon a ->
-	    TAnon { a with a_fields =
-		    PMap.map (fun af -> { af with cf_type =
-				ambiguate_funs af.cf_type }) a.a_fields }
-	| TLazy _ -> die "" __LOC__
+	| _ -> map ambiguate_funs t
 
 let rec is_nullable ?(no_lazy=false) = function
 	| TMono r ->

src/typing/typeloadFields.ml

@@ -1468,33 +1468,43 @@ let check_overload ctx f fs =
 		let f2 =
 			List.find (fun f2 ->
 				f != f2 &&
-				Overloads.compare_overload_args ~ctx f.cf_type f2.cf_type f f2 = Overloads.Same
+				Overloads.same_overload_args f.cf_type f2.cf_type f f2
 			) fs
 		in
 		display_error ctx ("Another overloaded field of same signature was already declared : " ^ f.cf_name) f.cf_pos;
-		display_error ctx (compl_msg "The second field is declared here") f2.cf_pos
+		display_error ctx (compl_msg "The second field is declared here") f2.cf_pos;
+		false
+	with Not_found -> try
+		(* OVERLOADTODO: generalize this and respect whether or not we actually generate the functions *)
+		if ctx.com.platform <> Java then raise Not_found;
+		let get_vmtype = ambiguate_funs in
+		let f2 =
+			List.find (fun f2 ->
+				f != f2 &&
+				Overloads.same_overload_args ~get_vmtype f.cf_type f2.cf_type f f2
+			) fs
+		in
+		display_error ctx (
+			"Another overloaded field of similar signature was already declared : " ^
+			f.cf_name ^
+			"\nThe signatures are different in Haxe, but not in the target language"
+		) f.cf_pos;
+		display_error ctx (compl_msg "The second field is declared here") f2.cf_pos;
+		false
 	with Not_found ->
-		try
-			let f2 =
-				List.find (fun f2 ->
-					f != f2 &&
-					Overloads.compare_overload_args ~ctx f.cf_type f2.cf_type f f2 = Overloads.Impl_conflict
-				) fs
-			in
-			display_error ctx (
-				"Another overloaded field of similar signature was already declared : " ^
-				f.cf_name ^
-				"\nThe signatures are different in Haxe, but not in the target language"
-			) f.cf_pos;
-			display_error ctx (compl_msg "The second field is declared here") f2.cf_pos
-		with | Not_found -> ()
+		true
 
 let check_overloads ctx c =
 	(* check if field with same signature was declared more than once *)
-	List.iter (fun f ->
-		if has_class_field_flag f CfOverload then
-			check_overload ctx f (f :: f.cf_overloads)
-	) (c.cl_ordered_fields @ c.cl_ordered_statics)
+	let check_field f =
+		if has_class_field_flag f CfOverload then begin
+			let all = f :: f.cf_overloads in
+			ignore(List.fold_left (fun b f -> b && check_overload ctx f all) true all)
+		end
+	in
+	List.iter check_field c.cl_ordered_fields;
+	List.iter check_field c.cl_ordered_statics;
+	Option.may check_field c.cl_constructor
 
 let init_class ctx c p context_init herits fields =
 	let ctx,cctx = create_class_context ctx c context_init p in
@@ -1667,16 +1677,6 @@ let init_class ctx c p context_init herits fields =
 	if not has_struct_init then
 		(* add_constructor does not deal with overloads correctly *)
 		if not ctx.com.config.pf_overload then TypeloadFunction.add_constructor ctx c cctx.force_constructor p;
-	(* check overloaded constructors *)
-	(if ctx.com.config.pf_overload && not cctx.is_lib then match c.cl_constructor with
-	| Some ctor ->
-		delay ctx PTypeField (fun () ->
-			(* TODO: consider making a broader check, and treat some types, like TAnon and type parameters as Dynamic *)
-			List.iter (fun f ->
-				check_overload ctx f (ctor :: ctor.cf_overloads)
-			) (ctor :: ctor.cf_overloads)
-		)
-	| _ -> ());
 	(* push delays in reverse order so they will be run in correct order *)
 	List.iter (fun (ctx,r) ->
 		init_class_done ctx;

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

@@ -0,0 +1,9 @@
+class Main {
+	@:overload static function test(s:String) {}
+	@:overload static function test(i:Int) {}
+	@:overload static function test(i:Int) {}
+
+	static public function main() {
+
+	}
+}

tests/misc/java/projects/Issue9730/compile-fail.hxml

@@ -0,0 +1,3 @@
+-main Main
+--jvm whatever.jar
+--no-output

tests/misc/java/projects/Issue9730/compile-fail.hxml.stderr

@@ -0,0 +1,2 @@
+Main.hx:4: characters 13-43 : Another overloaded field of same signature was already declared : test
+Main.hx:3: characters 13-43 : ... The second field is declared here