2
0
Эх сурвалжийг харах

support top-down inference for array access assignments

see #10655
Simon Krajewski 3 жил өмнө
parent
commit
8c1ce9eb5e

+ 55 - 27
src/context/abstractCast.ml

@@ -148,27 +148,6 @@ let find_array_read_access_raise ctx a pl e1 p =
 	in
 	loop a.a_array_read
 
-let find_array_write_access_raise ctx a pl e1 e2 p =
-	let rec loop cfl =
-		match cfl with
-		| [] -> raise Not_found
-		| cf :: cfl ->
-			let map,check_constraints,get_ta = prepare_array_access_field ctx a pl cf p in
-			match follow (map cf.cf_type) with
-			| TFun((_,_,tab) :: (_,_,ta1) :: (_,_,ta2) :: args,r) as tf when is_empty_or_pos_infos args ->
-				begin try
-					Type.unify tab (get_ta());
-					let e1 = cast_or_unify_raise ctx ta1 e1 p in
-					let e2 = cast_or_unify_raise ctx ta2 e2 p in
-					check_constraints();
-					cf,tf,r,e1,e2
-				with Unify_error _ | Error (Unify _,_) ->
-					loop cfl
-				end
-			| _ -> loop cfl
-	in
-	loop a.a_array_write
-
 let find_array_read_access ctx a tl e1 p =
 	try
 		find_array_read_access_raise ctx a tl e1 p
@@ -176,12 +155,61 @@ let find_array_read_access ctx a tl e1 p =
 		let s_type = s_type (print_context()) in
 		typing_error (Printf.sprintf "No @:arrayAccess function for %s accepts argument of %s" (s_type (TAbstract(a,tl))) (s_type e1.etype)) p
 
-let find_array_write_access ctx a tl e1 e2 p =
-	try
-		find_array_write_access_raise ctx a tl e1 e2 p
-	with Not_found ->
-		let s_type = s_type (print_context()) in
-		typing_error (Printf.sprintf "No @:arrayAccess function for %s accepts arguments of %s and %s" (s_type (TAbstract(a,tl))) (s_type e1.etype) (s_type e2.etype)) p
+module ArrayWrite = struct
+	let get_list_from_key ctx a pl e1 p =
+		let rec loop acc cfl =
+			match cfl with
+			| [] ->
+				List.rev acc
+			| cf :: cfl ->
+				let map,check_constraints,get_ta = prepare_array_access_field ctx a pl cf p in
+				match follow (map cf.cf_type) with
+				| TFun((_,_,tab) :: (_,_,ta1) :: (_,_,ta2) :: args,r) as tf when is_empty_or_pos_infos args ->
+					begin try
+						Type.unify tab (get_ta());
+						let e1 = cast_or_unify_raise ctx ta1 e1 p in
+						let f e2 =
+							let e2 = cast_or_unify_raise ctx ta2 e2 p in
+							check_constraints();
+							cf,tf,r,e1,e2
+						in
+						loop ((f,ta2) :: acc) cfl
+					with Unify_error _ | Error (Unify _,_) ->
+						loop acc cfl
+					end
+				| _ -> loop acc cfl
+		in
+		loop [] a.a_array_write
+
+	let filter_by_value_raise candidates e2 =
+		let rec loop candidates = match candidates with
+			| [] ->
+				raise Not_found
+			| (f,_) :: candidates ->
+				try
+					f e2
+				with Unify_error _ | Error (Unify _,_) ->
+					loop candidates
+		in
+		loop candidates
+
+	let catch_write_exception a tl t1 t2 p f =
+		try
+			f ()
+		with Not_found ->
+			let s_type = s_type (print_context()) in
+			typing_error (Printf.sprintf "No @:arrayAccess function for %s accepts arguments of %s and %s" (s_type (TAbstract(a,tl))) (s_type t1) (s_type t2)) p
+
+	let filter_by_value a tl t1 e2 p candidates =
+		catch_write_exception a tl t1 e2.etype p (fun () -> filter_by_value_raise candidates e2)
+
+	let find_array_write_access_raise ctx a tl e1 e2 p =
+		let candidates = get_list_from_key ctx a tl e1 p in
+		filter_by_value_raise candidates e2
+
+	let find_array_write_access ctx a tl e1 e2 p =
+		catch_write_exception a tl e1.etype e2.etype p (fun () -> find_array_write_access_raise ctx a tl e1 e2 p)
+end
 
 let find_multitype_specialization com a pl p =
 	let uctx = default_unification_context in

+ 9 - 4
src/typing/operators.ml

@@ -570,8 +570,13 @@ let type_assign ctx e1 e2 with_type p =
 		let dispatcher = new call_dispatcher ctx (MSet (Some e2)) with_type p in
 		dispatcher#accessor_call fa [] [e2]
 	| AKAccess(a,tl,c,ebase,ekey) ->
-		let e2 = type_rhs WithType.value in
-		mk_array_set_call ctx (AbstractCast.find_array_write_access ctx a tl ekey e2 p) c ebase p
+		let candidates = AbstractCast.ArrayWrite.get_list_from_key ctx a tl ekey p in
+		let with_type = match candidates with
+			| [(_,t)] -> WithType.with_type t
+			| _ -> WithType.value
+		in
+		let e2 = type_rhs with_type in
+		mk_array_set_call ctx (AbstractCast.ArrayWrite.filter_by_value a tl ekey.etype e2 p candidates) c ebase p
 	| AKResolve(sea,name) ->
 		let eparam = sea.se_this in
 		let e_name = Texpr.Builder.make_string ctx.t name null_pos in
@@ -694,7 +699,7 @@ let type_assign_op ctx op e1 e2 with_type p =
 		let vr = new value_reference ctx in
 		let eget = BinopResult.to_texpr vr eget (fun e -> e) in
 		unify ctx eget.etype r_get p;
-		let cf_set,tf_set,r_set,ekey,eget = AbstractCast.find_array_write_access ctx a tl ekey eget p in
+		let cf_set,tf_set,r_set,ekey,eget = AbstractCast.ArrayWrite.find_array_write_access ctx a tl ekey eget p in
 		let et = type_module_type ctx (TClassDecl c) None p in
 		let e = match cf_set.cf_expr,cf_get.cf_expr with
 			| None,None ->
@@ -890,7 +895,7 @@ let type_unop ctx op flag e with_type p =
 				let e_one = mk (TConst (TInt (Int32.of_int 1))) ctx.com.basic.tint p in
 				let e_op = mk (TBinop((if op = Increment then OpAdd else OpSub),ev_get,e_one)) ev_get.etype p in
 				(* set *)
-				let e_set = mk_array_set_call ctx (AbstractCast.find_array_write_access_raise ctx a tl ekey e_op p) c ebase p in
+				let e_set = mk_array_set_call ctx (AbstractCast.ArrayWrite.find_array_write_access_raise ctx a tl ekey e_op p) c ebase p in
 				let el = evar_key :: evar_get :: e_set :: (if flag = Postfix then [ev_get] else []) in
 				mk (TBlock el) e_set.etype p
 			with Not_found ->

+ 33 - 0
tests/unit/src/unit/issues/Issue10655.hx

@@ -0,0 +1,33 @@
+package unit.issues;
+
+@:structInit
+private class Student {
+	public final name:String;
+	public final score:Int;
+}
+
+private abstract A(String) {
+	public function new() {
+		this = "";
+	}
+
+	@:arrayAccess public function arrayWrite(k:String, v:Array<Dynamic>) {}
+}
+
+class Issue10655 extends Test {
+	function test() {
+		var map = new Map<String, Student>();
+
+		var student1:Student = {name: "Boris", score: 20};
+		map["the best"] = student1;
+
+		map["the worst"] = {name: "Vianney", score: -1};
+		utest.Assert.pass();
+	}
+
+	function test2() {
+		var a = new A();
+		a["foo"] = [1, "foo"];
+		utest.Assert.pass();
+	}
+}