Add TAnon comparison to fast_eq (#8592)

* add TAnon comparison to fast_eq

* extract into fast_eq_anon

* refactoring

* sort field lists

* handle monomorph arguments while typing `@:from` (#8588)

* fixed hangs on type_array_decl and type_ident

* no need for `fields_eq` in some cases

* less PMap lookups

src/core/type.ml

@@ -634,7 +634,7 @@ let map loop t =
 	| TDynamic t2 ->
 		if t == t2 then	t else TDynamic (loop t2)
 
-let dup t =
+let duplicate t =
 	let monos = ref [] in
 	let rec loop t =
 		match t with
@@ -1742,42 +1742,69 @@ let link_dynamic a b = match follow a,follow b with
 	| TDynamic _,TMono r -> r := Some a
 	| _ -> ()
 
-let rec fast_eq a b =
+let fast_eq_check type_param_check a b =
 	if a == b then
 		true
 	else match a , b with
 	| TFun (l1,r1) , TFun (l2,r2) when List.length l1 = List.length l2 ->
-		List.for_all2 (fun (_,_,t1) (_,_,t2) -> fast_eq t1 t2) l1 l2 && fast_eq r1 r2
+		List.for_all2 (fun (_,_,t1) (_,_,t2) -> type_param_check t1 t2) l1 l2 && type_param_check r1 r2
 	| TType (t1,l1), TType (t2,l2) ->
-		t1 == t2 && List.for_all2 fast_eq l1 l2
+		t1 == t2 && List.for_all2 type_param_check l1 l2
 	| TEnum (e1,l1), TEnum (e2,l2) ->
-		e1 == e2 && List.for_all2 fast_eq l1 l2
+		e1 == e2 && List.for_all2 type_param_check l1 l2
 	| TInst (c1,l1), TInst (c2,l2) ->
-		c1 == c2 && List.for_all2 fast_eq l1 l2
+		c1 == c2 && List.for_all2 type_param_check l1 l2
 	| TAbstract (a1,l1), TAbstract (a2,l2) ->
-		a1 == a2 && List.for_all2 fast_eq l1 l2
+		a1 == a2 && List.for_all2 type_param_check l1 l2
 	| _ , _ ->
 		false
 
+let rec fast_eq a b = fast_eq_check fast_eq a b
+
 let rec fast_eq_mono ml a b =
-	if a == b then
+	if fast_eq_check (fast_eq_mono ml) a b then
 		true
 	else match a , b with
-	| TFun (l1,r1) , TFun (l2,r2) when List.length l1 = List.length l2 ->
-		List.for_all2 (fun (_,_,t1) (_,_,t2) -> fast_eq_mono ml t1 t2) l1 l2 && fast_eq_mono ml r1 r2
-	| TType (t1,l1), TType (t2,l2) ->
-		t1 == t2 && List.for_all2 (fast_eq_mono ml) l1 l2
-	| TEnum (e1,l1), TEnum (e2,l2) ->
-		e1 == e2 && List.for_all2 (fast_eq_mono ml) l1 l2
-	| TInst (c1,l1), TInst (c2,l2) ->
-		c1 == c2 && List.for_all2 (fast_eq_mono ml) l1 l2
-	| TAbstract (a1,l1), TAbstract (a2,l2) ->
-		a1 == a2 && List.for_all2 (fast_eq_mono ml) l1 l2
 	| TMono _, _ ->
 		List.memq a ml
 	| _ , _ ->
 		false
 
+let rec fast_eq_anon a b =
+	if fast_eq_check fast_eq_anon a b then
+		true
+	else match a , b with
+	| TMono { contents = Some t1 }, TMono { contents = Some t2 } ->
+		fast_eq_anon t1 t2
+	| TAnon a1, TAnon a2 ->
+		let fields_eq() =
+			let rec loop fields1 fields2 =
+				match fields1, fields2 with
+				| [], [] -> true
+				| _, [] | [], _ -> false
+				| f1 :: rest1, f2 :: rest2 ->
+					f1.cf_name = f2.cf_name
+					&& (try fast_eq_anon f1.cf_type f2.cf_type with Not_found -> false)
+					&& loop rest1 rest2
+			in
+			let fields1 = PMap.fold (fun field fields -> field :: fields) a1.a_fields []
+			and fields2 = PMap.fold (fun field fields -> field :: fields) a2.a_fields []
+			and sort_compare f1 f2 = compare f1.cf_name f2.cf_name in
+			loop (List.sort sort_compare fields1) (List.sort sort_compare fields2)
+		in
+		(match !(a2.a_status), !(a1.a_status) with
+		| Statics c, Statics c2 -> c == c2
+		| EnumStatics e, EnumStatics e2 -> e == e2
+		| AbstractStatics a, AbstractStatics a2 -> a == a2
+		| Extend tl1, Extend tl2 -> fields_eq() && List.for_all2 fast_eq_anon tl1 tl2
+		| Closed, Closed -> fields_eq()
+		| Opened, Opened -> fields_eq()
+		| Const, Const -> fields_eq()
+		| _ -> false
+		)
+	| _ , _ ->
+		false
+
 (* perform unification with subtyping.
    the first type is always the most down in the class hierarchy
    it's also the one that is pointed by the position.

src/typing/typer.ml

@@ -107,7 +107,7 @@ let maybe_type_against_enum ctx f with_type iscall p =
 				| TAbstract (a,pl) when not (Meta.has Meta.CoreType a.a_meta) ->
 					begin match get_abstract_froms a pl with
 						| [t2] ->
-							if (List.exists (fast_eq t) stack) then raise Exit;
+							if (List.exists (fast_eq_anon t) stack) then raise Exit;
 							loop (t :: stack) t2
 						| _ -> raise Exit
 					end
@@ -1610,7 +1610,7 @@ and type_object_decl ctx fl with_type p =
 		let rec loop seen t =
 			match follow t with
 			| TAnon a -> ODKWithStructure a
-			| TAbstract (a,pl) as t when not (Meta.has Meta.CoreType a.a_meta) && not (List.exists (fun t' -> fast_eq t t') seen) ->
+			| TAbstract (a,pl) as t when not (Meta.has Meta.CoreType a.a_meta) && not (List.exists (fun t' -> fast_eq_anon t t') seen) ->
 				(match List.fold_left (fun acc t' -> match loop (t :: seen) t' with ODKPlain -> acc | t -> t :: acc) [] (get_abstract_froms a pl) with
 				| [t] -> t
 				| _ -> ODKPlain)
@@ -2096,10 +2096,10 @@ and type_array_decl ctx el with_type p =
 					Some (get_iterable_param t)
 				with Not_found ->
 					None)
-			| TAbstract (a,pl) as t when not (List.exists (fun t' -> fast_eq t (follow t')) seen) ->
+			| TAbstract (a,pl) as t when not (List.exists (fun t' -> fast_eq_anon t (follow t')) seen) ->
 				let types =
 					List.fold_left
-						(fun acc t -> match loop (t :: seen) t with
+						(fun acc t' -> match loop (t :: seen) t' with
 							| None -> acc
 							| Some t -> t :: acc
 						)

src/typing/typerBase.ml

@@ -203,7 +203,7 @@ let get_abstract_froms a pl =
 		match follow (Type.field_type f) with
 		| TFun ([_,_,v],t) ->
 			(try
-				ignore(type_eq EqStrict t (TAbstract(a,List.map dup pl))); (* unify fields monomorphs *)
+				ignore(type_eq EqStrict t (TAbstract(a,List.map duplicate pl))); (* unify fields monomorphs *)
 				v :: acc
 			with Unify_error _ ->
 				acc)

tests/misc/compiler_loops/projects/Issue8588/Main.hx

@@ -0,0 +1,9 @@
+abstract Under<T>(T) {
+	@:from public static function from<T>(v:T) return v;
+}
+
+class Main {
+	static public function main() {
+		var a1:Under<{}> = { };
+	}
+}

tests/misc/compiler_loops/projects/Issue8588/Main2.hx

@@ -0,0 +1,9 @@
+abstract Under<T>(T) {
+	@:from public static function from<T>(v) return (v:Under<T>);
+}
+
+class Main {
+	static function main() {
+		var a1:Under<{}> = {};
+	}
+}

tests/misc/compiler_loops/projects/Issue8588/Main3.hx

@@ -0,0 +1,9 @@
+abstract Under<T>(T) {
+	@:from public static function from<T>(v:Under<T>) { return v; }
+}
+
+class Main3 {
+	static public function main() {
+		var a1:Under<{}> = [];
+	}
+}

tests/misc/compiler_loops/projects/Issue8588/Main4.hx

@@ -0,0 +1,9 @@
+abstract Under<T>(T) {
+	@:from public static function from<T>(v:Under<T>) { return v; }
+}
+
+class Main3 {
+	static public function main() {
+		var a1:Under<{}> = ident;
+	}
+}

tests/misc/compiler_loops/projects/Issue8588/compile-fail.hxml

@@ -0,0 +1 @@
+-main Main

tests/misc/compiler_loops/projects/Issue8588/compile-fail.hxml.stderr

@@ -0,0 +1 @@
+Main.hx:2: characters 9-53 : from.T should be Under<Unknown<0>>

tests/misc/compiler_loops/projects/Issue8588/compile2-fail.hxml

@@ -0,0 +1 @@
+-main Main2

tests/misc/compiler_loops/projects/Issue8588/compile2-fail.hxml.stderr

@@ -0,0 +1 @@
+Main2.hx:7: characters 3-25 : { } should be Under<{ }>

tests/misc/compiler_loops/projects/Issue8588/compile3-fail.hxml

@@ -0,0 +1 @@
+-main Main3

tests/misc/compiler_loops/projects/Issue8588/compile3-fail.hxml.stderr

@@ -0,0 +1 @@
+Main3.hx:7: characters 3-25 : Array<Unknown<0>> should be Under<{ }>

tests/misc/compiler_loops/projects/Issue8588/compile4-fail.hxml

@@ -0,0 +1 @@
+-main Main4

tests/misc/compiler_loops/projects/Issue8588/compile4-fail.hxml.stderr

@@ -0,0 +1 @@
+Main4.hx:7: characters 22-27 : Unknown identifier : ident