consider cast function arguments and return types during unification (fixed issue #1408) (fixed issue #1419)

codegen.ml

@@ -1321,36 +1321,28 @@ let handle_abstract_casts ctx e =
 		| _ ->
 			def())
 	in
-	let find_cast a pl t from =
-		let rec loop fl = match fl with
-			| [] -> raise Not_found
-			| (t2,Some cf) :: _ when type_iseq t (apply_params a.a_types pl (monomorphs cf.cf_params t2)) -> cf
-			| (t2,_) :: fl -> loop fl
-		in
-		loop (List.rev (if from then a.a_from else a.a_to))
-	in
+	let find_from ab pl a b = List.find (Type.unify_from_field ab pl a b) ab.a_from in
+	let find_to ab pl a b = List.find (Type.unify_to_field ab pl a b) ab.a_to in
 	let rec check_cast tleft eright p =
 		let eright = loop eright in
-		try (match follow tleft,follow eright.etype with
+		try (match follow eright.etype,follow tleft with
 			| (TAbstract({a_impl = Some c1} as a1,pl1) as t1),(TAbstract({a_impl = Some c2} as a2,pl2) as t2) ->
 				if a1 == a2 then
 					eright
 				else begin
-					let c,cf,a,pl = try
-						c1,find_cast a1 pl1 t2 true,a1,pl1
+					let c,cfo,a,pl = try
+						c1,snd (find_to a1 pl1 t1 t2),a1,pl1
 					with Not_found ->
-						c2,find_cast a2 pl2 t1 false,a2,pl2
+						c2,snd (find_from a2 pl2 t1 t2),a2,pl2
 					in
-					make_cast_call c cf a pl [eright] tleft p
+					match cfo with None -> eright | Some cf -> make_cast_call c cf a pl [eright] tleft p
 				end
 			| TDynamic _,_ | _,TDynamic _ ->
 				eright
-			| TAbstract({a_impl = Some c} as a,pl),t ->
-				let cf = find_cast a pl t true in
-				make_cast_call c cf a pl [eright] tleft p
-			| t,TAbstract({a_impl = Some c} as a,pl) ->
-				let cf = find_cast a pl t false in
-				make_cast_call c cf a pl [eright] tleft p
+			| TAbstract({a_impl = Some c} as a,pl) as t1,t2 ->
+				begin match snd (find_to a pl t1 t2) with None -> eright | Some cf -> make_cast_call c cf a pl [eright] tleft p end
+			| t1,(TAbstract({a_impl = Some c} as a,pl) as t2) ->
+				begin match snd (find_from a pl t1 t2) with None -> eright | Some cf -> make_cast_call c cf a pl [eright] tleft p end
 			| _ ->
 				eright)
 		with Not_found ->

tests/unit/MyAbstract.hx

@@ -89,4 +89,21 @@ abstract MyHash(Hash<V>)<V> {
 		return hash;
 	}
 }
-#end
+#end
+
+class AbstractBase<T> {
+	public var value:T;
+	public function new(value:T) {
+		this.value = value;
+	}
+}
+
+abstract AbstractZ(AbstractBase<T>)<T> from AbstractBase<T> {
+	@:to public static function toFoo(a:AbstractBase<Int>):Int {
+		return a.value;
+	}
+	
+	@:to public static function toString(a:AbstractBase<String>):String {
+		return a.value;
+	}
+}

tests/unit/TestType.hx

@@ -664,4 +664,20 @@ class TestType extends Test {
 		exc(function() { throw null; return null; } );
 		exc(function() { throw null; return { foo: 1}; } );
 	}
+	
+	function testAbstractCastConstraints() {
+		var z:unit.MyAbstract.AbstractZ<String> = new unit.MyAbstract.AbstractBase("foo");
+		var s:String = z;
+		t(typeError( {
+			var i:Int = z;
+		}));
+		eq("foo", s);
+		
+		var z:unit.MyAbstract.AbstractZ<Int> = new unit.MyAbstract.AbstractBase(12);
+		var i:Int = z;
+		eq(12, i);
+		t(typeError( {
+			var s:String = z;
+		}));
+	}
 }

type.ml

@@ -993,16 +993,7 @@ let rec unify a b =
 	| _ , TAbstract ({a_path=[],"Void"},_) ->
 		error [cannot_unify a b]
 	| TAbstract (a1,tl1) , TAbstract (a2,tl2) ->
-		let has_impl = a1.a_impl <> None || a2.a_impl <> None in
-		if not (List.exists (fun (t,cfo) ->
-			let t = apply_params a1.a_types tl1 t in
-			let t = match cfo with None -> t | Some cf -> monomorphs cf.cf_params t in
-			try if has_impl then type_eq EqStrict t b else unify t b; true with Unify_error _ -> false
-		) a1.a_to) && not (List.exists (fun (t,cfo) ->
-			let t = apply_params a2.a_types tl2 t in
-			let t = match cfo with None -> t | Some cf -> monomorphs cf.cf_params t in
-			try if has_impl then type_eq EqStrict a t else unify a t; true with Unify_error _ -> false
-		) a2.a_from) then error [cannot_unify a b]
+		if not (List.exists (unify_to_field a1 tl1 a b) a1.a_to) && not (List.exists (unify_from_field a2 tl2 a b) a2.a_from) then error [cannot_unify a b]
 	| TInst (c1,tl1) , TInst (c2,tl2) ->
 		let rec loop c tl =
 			if c == c2 then begin
@@ -1146,12 +1137,7 @@ let rec unify a b =
 		| _ ->
 			error [cannot_unify a b])
 	| TAbstract (aa,tl), _  ->
-		let has_impl = aa.a_impl <> None in
-		if not (List.exists (fun (t,cfo) ->
-			let t = apply_params aa.a_types tl t in
-			let t = match cfo with None -> t | Some cf -> monomorphs cf.cf_params t in
-			try if has_impl then type_eq EqStrict t b else unify t b; true with Unify_error _ -> false
-		) aa.a_to) then error [cannot_unify a b];
+		if not (List.exists (unify_to_field aa tl a b) aa.a_to) then error [cannot_unify a b];
 	| TInst ({ cl_kind = KTypeParameter ctl } as c,pl), TAbstract _ ->
 		(* one of the constraints must satisfy the abstract *)
 		if not (List.exists (fun t ->
@@ -1159,15 +1145,34 @@ let rec unify a b =
 			try unify t b; true with Unify_error _ -> false
 		) ctl) then error [cannot_unify a b];
 	| _, TAbstract (bb,tl) ->
-		let has_impl = bb.a_impl <> None in
-		if not (List.exists (fun (t,cfo) ->
-			let t = apply_params bb.a_types tl t in
-			let t = match cfo with None -> t | Some cf -> monomorphs cf.cf_params t in
-			try if has_impl then type_eq EqStrict a t else unify a t; true with Unify_error _ -> false
-		) bb.a_from) then error [cannot_unify a b];
+		if not (List.exists (unify_from_field bb tl a b) bb.a_from) then error [cannot_unify a b]
 	| _ , _ ->
 		error [cannot_unify a b]
 
+and unify_from_field ab tl a b (t,cfo) =
+	let loop a b = try (if ab.a_impl <> None then type_eq EqStrict a b else unify a b); true with Unify_error _ -> false in
+	match cfo with
+	| Some cf -> (match follow cf.cf_type with
+		| TFun(_,r) ->
+			let monos = List.map (fun _ -> mk_mono()) cf.cf_params in
+			let map t = apply_params ab.a_types tl (apply_params cf.cf_params monos t) in
+			if loop a (map t) then try unify (map r) b; true with Unify_error _ -> false else false
+		| _ -> assert false)
+	| _ ->
+		loop a (apply_params ab.a_types tl t)
+
+and unify_to_field ab tl a b (t,cfo) =
+	let loop a b = try (if ab.a_impl <> None then type_eq EqStrict a b else unify a b); true with Unify_error _ -> false in
+	match cfo with
+	| Some cf -> (match follow cf.cf_type with
+		| TFun([_,_,ta],_) ->
+			let monos = List.map (fun _ -> mk_mono()) cf.cf_params in
+			let map t = apply_params ab.a_types tl (apply_params cf.cf_params monos t) in
+			if loop (map t) b then try unify (map ab.a_this) (map ta); true with Unify_error _ -> false else false
+		| _ -> assert false)
+	| _ ->
+		loop (apply_params ab.a_types tl t) b
+
 and unify_types a b tl1 tl2 =
 	List.iter2 (fun t1 t2 ->
 		try

typeload.ml

@@ -1337,11 +1337,12 @@ let init_class ctx c p context_init herits fields =
 				| KAbstractImpl a ->
 					let m = mk_mono() in
 					if Meta.has Meta.From f.cff_meta then begin
-						let t_abstract = TAbstract(a,(List.map (fun _ -> mk_mono()) a.a_types)) in
-						unify ctx t (tfun [m] t_abstract) f.cff_pos;
+						let ta = TAbstract(a, List.map (fun _ -> mk_mono()) a.a_types) in
+						unify ctx t (tfun [m] ta) f.cff_pos;
 						a.a_from <- (follow m, Some cf) :: a.a_from
 					end else if Meta.has Meta.To f.cff_meta then begin
-						unify ctx t (tfun [a.a_this] m) f.cff_pos;
+						let ta = monomorphs a.a_types (monomorphs params a.a_this) in
+						unify ctx t (tfun [ta] m) f.cff_pos;
 						a.a_to <- (follow m, Some cf) :: a.a_to
 					end
 				| _ ->
@@ -1491,6 +1492,11 @@ let init_class ctx c p context_init herits fields =
 		with Error (Custom str,p) ->
 			display_error ctx str p
 	) fields;
+	(match c.cl_kind with
+	| KAbstractImpl a ->
+		a.a_to <- List.rev a.a_to;
+		a.a_from <- List.rev a.a_from
+	| _ -> ());
 	c.cl_ordered_statics <- List.rev c.cl_ordered_statics;
 	c.cl_ordered_fields <- List.rev c.cl_ordered_fields;
 	(*