Browse Source

try to help Detective Haxe

Simon Krajewski 5 years ago
parent
commit
3a04d951c0
3 changed files with 65 additions and 0 deletions
  1. 27 0
      src/core/tFunctions.ml
  2. 14 0
      src/typing/calls.ml
  3. 24 0
      tests/unit/src/unit/TestConstrainedMonomorphs.hx

+ 27 - 0
src/core/tFunctions.ml

@@ -270,6 +270,33 @@ let map loop t =
 	| TDynamic t2 ->
 		if t == t2 then	t else TDynamic (loop t2)
 
+let iter loop t =
+	match t with
+	| TMono r ->
+		(match r.tm_type with
+		| None -> ()
+		| Some t -> loop t)
+	| TEnum (_,[]) | TInst (_,[]) | TType (_,[]) ->
+		()
+	| TEnum (e,tl) ->
+		List.iter loop tl
+	| TInst (c,tl) ->
+		List.iter loop tl
+	| TType (t2,tl) ->
+		List.iter loop tl
+	| TAbstract (a,tl) ->
+		List.iter loop tl
+	| TFun (tl,r) ->
+		List.iter (fun (_,_,t) -> loop t) tl;
+		loop r
+	| TAnon a ->
+		PMap.iter (fun _ f -> loop f.cf_type) a.a_fields
+	| TLazy f ->
+		let ft = lazy_type f in
+		loop ft
+	| TDynamic t2 ->
+		if t != t2 then	loop t2
+
 let duplicate t =
 	let monos = ref [] in
 	let rec loop t =

+ 14 - 0
src/typing/calls.ml

@@ -294,6 +294,17 @@ let unify_field_call ctx fa el args ret p inline =
 	let rec loop candidates = match candidates with
 		| [] -> [],[]
 		| (t,cf) :: candidates ->
+			let unbound = DynArray.create () in
+			List.iter (fun (m,_) -> match m.tm_type with
+				| None ->
+					DynArray.add unbound m
+				| Some t ->
+					let rec loop t = match follow t with
+						| TMono m -> DynArray.add unbound m
+						| _ -> TFunctions.iter loop t
+					in
+					loop t
+			) ctx.monomorphs.perfunction;
 			begin try
 				let candidate = attempt_call t cf in
 				if ctx.com.config.pf_overload && is_overload then begin
@@ -302,6 +313,9 @@ let unify_field_call ctx fa el args ret p inline =
 				end else
 					[candidate],[]
 			with Error ((Call_error cerr as err),p) ->
+				DynArray.iter (fun m ->
+					if m.tm_type <> None then Monomorph.unbind m
+				) unbound;
 				maybe_raise_unknown_ident cerr p;
 				let candidates,failures = loop candidates in
 				candidates,(cf,err,p) :: failures

+ 24 - 0
tests/unit/src/unit/TestConstrainedMonomorphs.hx

@@ -18,6 +18,23 @@ private class MyNotString {
 	}
 }
 
+#if java
+@:native("unit.DetectiveHaxeExtern")
+extern private class DetectiveHaxeExtern {
+	@:overload static function itWasYou(i1:Int, i2:Int):String;
+	@:overload static function itWasYou(s1:String, s2:String):String;
+	@:overload static function itWasYou(f1:Float, f2:Float):String;
+}
+
+@:native("unit.DetectiveHaxeExtern")
+@:keep
+private class DetectiveHaxeImplementation {
+	@:overload static function itWasYou(s1:String, s2:String) {
+		return s1 + s2;
+	}
+}
+#end
+
 class TestConstrainedMonomorphs extends Test {
 
 	function infer(arg) {
@@ -30,4 +47,11 @@ class TestConstrainedMonomorphs extends Test {
 	function testNarrowingInference() {
 		eq("fooFOO", infer(new MyNotString("foo")));
 	}
+
+	#if java
+	function testDetectiveHaxe() {
+		var a = null;
+		eq("nullfoo", DetectiveHaxeExtern.itWasYou(a, "foo"));
+	}
+	#end
 }