buggy but gives a good speedup in genhl compilation

src/codegen/codegen.ml

@@ -452,9 +452,9 @@ end
 let default_cast ?(vtmp="$t") com e texpr t p =
 	let api = com.basic in
 	let mk_texpr = function
-		| TClassDecl c -> TAnon { a_fields = PMap.empty; a_status = ref (Statics c) }
-		| TEnumDecl e -> TAnon { a_fields = PMap.empty; a_status = ref (EnumStatics e) }
-		| TAbstractDecl a -> TAnon { a_fields = PMap.empty; a_status = ref (AbstractStatics a) }
+		| TClassDecl c -> TAnon { a_id = mk_aid(); a_fields = PMap.empty; a_status = ref (Statics c) }
+		| TEnumDecl e -> TAnon { a_id = mk_aid(); a_fields = PMap.empty; a_status = ref (EnumStatics e) }
+		| TAbstractDecl a -> TAnon { a_id = mk_aid(); a_fields = PMap.empty; a_status = ref (AbstractStatics a) }
 		| TTypeDecl _ -> assert false
 	in
 	let vtmp = alloc_var VGenerated vtmp e.etype e.epos in

src/codegen/gencommon/gencommon.ml

@@ -116,7 +116,7 @@ let follow_once t =
 	| _ ->
 		t
 
-let t_empty = TAnon({ a_fields = PMap.empty; a_status = ref Closed })
+let t_empty = TAnon({ a_id = mk_aid(); a_fields = PMap.empty; a_status = ref Closed })
 
 let alloc_var n t = Type.alloc_var VGenerated n t null_pos
 

src/codegen/gencommon/normalize.ml

@@ -55,6 +55,7 @@ let rec filter_param t =
 		TAbstract(a, List.map filter_param tl)
 	| TAnon a ->
 		TAnon {
+			a_id = mk_aid();
 			a_fields = PMap.map (fun f -> { f with cf_type = filter_param f.cf_type }) a.a_fields;
 			a_status = a.a_status;
 		}

src/context/typecore.ml

@@ -153,7 +153,7 @@ let type_expr ctx e with_type = (!type_expr_ref) ctx e with_type
 let unify_min ctx el = (!unify_min_ref) ctx el
 
 let make_static_this c p =
-	let ta = TAnon { a_fields = c.cl_statics; a_status = ref (Statics c) } in
+	let ta = TAnon { a_id = mk_aid(); a_fields = c.cl_statics; a_status = ref (Statics c) } in
 	mk (TTypeExpr (TClassDecl c)) ta p
 
 let make_static_field_access c cf t p =

src/core/texpr.ml

@@ -214,15 +214,15 @@ let foldmap f acc e =
 (* Collection of functions that return expressions *)
 module Builder = struct
 	let make_static_this c p =
-		let ta = TAnon { a_fields = c.cl_statics; a_status = ref (Statics c) } in
+		let ta = TAnon { a_id = mk_aid(); a_fields = c.cl_statics; a_status = ref (Statics c) } in
 		mk (TTypeExpr (TClassDecl c)) ta p
 
 	let make_typeexpr mt pos =
 		let t =
 			match resolve_typedef mt with
-			| TClassDecl c -> TAnon { a_fields = c.cl_statics; a_status = ref (Statics c) }
-			| TEnumDecl e -> TAnon { a_fields = PMap.empty; a_status = ref (EnumStatics e) }
-			| TAbstractDecl a -> TAnon { a_fields = PMap.empty; a_status = ref (AbstractStatics a) }
+			| TClassDecl c -> TAnon { a_id = mk_aid(); a_fields = c.cl_statics; a_status = ref (Statics c) }
+			| TEnumDecl e -> TAnon { a_id = mk_aid(); a_fields = PMap.empty; a_status = ref (EnumStatics e) }
+			| TAbstractDecl a -> TAnon { a_id = mk_aid(); a_fields = PMap.empty; a_status = ref (AbstractStatics a) }
 			| _ -> assert false
 		in
 		mk (TTypeExpr mt) t pos
@@ -328,7 +328,7 @@ let rec type_constant_value basic (e,p) =
 	| EParenthesis e ->
 		type_constant_value basic e
 	| EObjectDecl el ->
-		mk (TObjectDecl (List.map (fun (k,e) -> k,type_constant_value basic e) el)) (TAnon { a_fields = PMap.empty; a_status = ref Closed }) p
+		mk (TObjectDecl (List.map (fun (k,e) -> k,type_constant_value basic e) el)) (TAnon { a_id = mk_aid(); a_fields = PMap.empty; a_status = ref Closed }) p
 	| EArrayDecl el ->
 		mk (TArrayDecl (List.map (type_constant_value basic) el)) (basic.tarray t_dynamic) p
 	| _ ->

src/core/type.ml

@@ -127,6 +127,7 @@ and anon_status =
 	| AbstractStatics of tabstract
 
 and tanon = {
+	a_id : int;
 	mutable a_fields : (string, tclass_field) PMap.t;
 	a_status : anon_status ref;
 }
@@ -451,7 +452,8 @@ let mk_mono() = TMono (ref None)
 
 let rec t_dynamic = TDynamic t_dynamic
 
-let mk_anon fl = TAnon { a_fields = fl; a_status = ref Closed; }
+let mk_aid = let uid = ref 0 in (fun() -> incr uid; !uid)
+let mk_anon fl = TAnon { a_id = mk_aid(); a_fields = fl; a_status = ref Closed; }
 
 (* We use this for display purposes because otherwise we never see the Dynamic type that
    is defined in StdTypes.hx. This is set each time a typer is created, but this is fine
@@ -633,6 +635,7 @@ let map loop t =
 				t
 			| _ ->
 				TAnon {
+					a_id = mk_aid();
 					a_fields = fields;
 					a_status = a.a_status;
 				}
@@ -719,6 +722,7 @@ let apply_params cparams params t =
 					t
 				| _ ->
 					TAnon {
+						a_id = mk_aid();
 						a_fields = fields;
 						a_status = a.a_status;
 					}
@@ -2938,6 +2942,7 @@ let class_module_type c = {
 	t_pos = c.cl_pos;
 	t_name_pos = null_pos;
 	t_type = TAnon {
+		a_id = mk_aid();
 		a_fields = c.cl_statics;
 		a_status = ref (Statics c);
 	};
@@ -2969,6 +2974,7 @@ let abstract_module_type a tl = {
 	t_pos = a.a_pos;
 	t_name_pos = null_pos;
 	t_type = TAnon {
+		a_id = mk_aid();
 		a_fields = PMap.empty;
 		a_status = ref (AbstractStatics a);
 	};

src/generators/gencs.ml

@@ -620,7 +620,7 @@ let reserved = let res = Hashtbl.create 120 in
 		"remove"; "select"; "set"; "value"; "var"; "where"; "yield"];
 	res
 
-let dynamic_anon = TAnon( { a_fields = PMap.empty; a_status = ref Closed } )
+let dynamic_anon = TAnon( { a_id = mk_aid(); a_fields = PMap.empty; a_status = ref Closed } )
 
 let rec get_class_modifiers meta cl_type cl_access cl_modifiers =
 	match meta with
@@ -2768,7 +2768,7 @@ let generate con =
 
 		let empty_en = match get_type gen (["haxe";"lang"], "EmptyObject") with TEnumDecl e -> e | _ -> assert false in
 		let empty_ctor_type = TEnum(empty_en, []) in
-		let empty_en_expr = mk (TTypeExpr (TEnumDecl empty_en)) (TAnon { a_fields = PMap.empty; a_status = ref (EnumStatics empty_en) }) null_pos in
+		let empty_en_expr = mk (TTypeExpr (TEnumDecl empty_en)) (TAnon { a_id = mk_aid(); a_fields = PMap.empty; a_status = ref (EnumStatics empty_en) }) null_pos in
 		let empty_ctor_expr = mk (TField (empty_en_expr, FEnum(empty_en, PMap.find "EMPTY" empty_en.e_constrs))) empty_ctor_type null_pos in
 		OverloadingConstructor.configure ~empty_ctor_type:empty_ctor_type ~empty_ctor_expr:empty_ctor_expr gen;
 

src/generators/genhl.ml

@@ -98,9 +98,9 @@ type context = {
 	defined_funs : (int,unit) Hashtbl.t;
 	is_macro : bool;
 	mutable dump_out : (unit IO.output) option;
-	mutable cached_types : ttype Hlopt.IMap.t;
+	mutable cached_types : ttype IMap.t;
 	mutable m : method_context;
-	mutable anons_cache : (tanon * ttype) list;
+	mutable anons_cache : ttype IMap.t;
 	mutable method_wrappers : ((ttype * ttype), int) PMap.t;
 	mutable rec_cache : (Type.t * ttype option ref) list;
 	mutable cached_tuples : (ttype list, ttype) PMap.t;
@@ -389,10 +389,9 @@ let rec to_type ?tref ctx t =
 		| _ -> assert false)
 	| TAnon a ->
 		(try
-			(* can't use physical comparison in PMap since addresses might change in GC compact,
-				maybe add an uid to tanon if too slow ? *)
-			List.assq a ctx.anons_cache
+			IMap.find a.a_id ctx.anons_cache
 		with Not_found ->
+			if PMap.is_empty a.a_fields then HDyn else
 			let vp = {
 				vfields = [||];
 				vindex = PMap.empty;
@@ -401,17 +400,12 @@ let rec to_type ?tref ctx t =
 			(match tref with
 			| None -> ()
 			| Some r -> r := Some t);
-			ctx.anons_cache <- (a,t) :: ctx.anons_cache;
+			ctx.anons_cache <- IMap.add a.a_id t ctx.anons_cache;
 			let fields = PMap.fold (fun cf acc -> cfield_type ctx cf :: acc) a.a_fields [] in
-			if fields = [] then
-				let t = HDyn in
-				ctx.anons_cache <- (a,t) :: List.tl ctx.anons_cache;
-				t
-			else
-				let fields = List.sort (fun (n1,_,_) (n2,_,_) -> compare n1 n2) fields in
-				vp.vfields <- Array.of_list fields;
-				Array.iteri (fun i (n,_,_) -> vp.vindex <- PMap.add n i vp.vindex) vp.vfields;
-				t
+			let fields = List.sort (fun (n1,_,_) (n2,_,_) -> compare n1 n2) fields in
+			vp.vfields <- Array.of_list fields;
+			Array.iteri (fun i (n,_,_) -> vp.vindex <- PMap.add n i vp.vindex) vp.vfields;
+			t
 		)
 	| TDynamic _ ->
 		HDyn
@@ -542,14 +536,14 @@ and class_type ?(tref=None) ctx c pl statics =
 	let c = if c.cl_extern then resolve_class ctx c pl statics else c in
 	let key_path = (if statics then c.cl_uid lsl 1 else (c.cl_uid lsl 1) lor 1) in
 	try
-		Hlopt.IMap.find key_path ctx.cached_types
+		IMap.find key_path ctx.cached_types
 	with Not_found when c.cl_interface && not statics ->
 		let vp = {
 			vfields = [||];
 			vindex = PMap.empty;
 		} in
 		let t = HVirtual vp in
-		ctx.cached_types <- Hlopt.IMap.add key_path t ctx.cached_types;
+		ctx.cached_types <- IMap.add key_path t ctx.cached_types;
 		let rec loop c =
 			let fields = List.fold_left (fun acc (i,_) -> loop i @ acc) [] c.cl_implements in
 			PMap.fold (fun cf acc -> cfield_type ctx cf :: acc) c.cl_fields fields
@@ -579,7 +573,7 @@ and class_type ?(tref=None) ctx c pl statics =
 		| None -> ()
 		| Some r -> r := Some t);
 		ctx.ct_depth <- ctx.ct_depth + 1;
-		ctx.cached_types <- Hlopt.IMap.add key_path t ctx.cached_types;
+		ctx.cached_types <- IMap.add key_path t ctx.cached_types;
 		if c.cl_path = ([],"Array") then assert false;
 		if c == ctx.base_class then begin
 			if statics then assert false;
@@ -678,7 +672,7 @@ and class_type ?(tref=None) ctx c pl statics =
 
 and enum_type ?(tref=None) ctx e =
 	try
-		Hlopt.IMap.find (e.e_uid lsl 1) ctx.cached_types
+		IMap.find (e.e_uid lsl 1) ctx.cached_types
 	with Not_found ->
 		let ename = s_type_path e.e_path in
 		let et = {
@@ -691,7 +685,7 @@ and enum_type ?(tref=None) ctx e =
 		(match tref with
 		| None -> ()
 		| Some r -> r := Some t);
-		ctx.cached_types <- Hlopt.IMap.add (e.e_uid lsl 1) t ctx.cached_types;
+		ctx.cached_types <- IMap.add (e.e_uid lsl 1) t ctx.cached_types;
 		et.efields <- Array.of_list (List.map (fun f ->
 			let f = PMap.find f e.e_constrs in
 			let args = (match f.ef_type with
@@ -707,7 +701,7 @@ and enum_type ?(tref=None) ctx e =
 and enum_class ctx e =
 	let key_path = (e.e_uid lsl 1) lor 1 in
 	try
-		Hlopt.IMap.find key_path ctx.cached_types
+		IMap.find key_path ctx.cached_types
 	with Not_found ->
 		let cpath = (fst e.e_path,"$" ^ snd e.e_path) in
 		let pname = s_type_path cpath in
@@ -726,7 +720,7 @@ and enum_class ctx e =
 			pbindings = [];
 		} in
 		let t = HObj p in
-		ctx.cached_types <- Hlopt.IMap.add key_path t ctx.cached_types;
+		ctx.cached_types <- IMap.add key_path t ctx.cached_types;
 		p.psuper <- Some (match class_type ctx ctx.base_enum [] false with HObj o -> o | _ -> assert false);
 		t
 
@@ -3907,7 +3901,7 @@ let create_context com is_macro dump =
 		cconstants = new_lookup();
 		cfunctions = DynArray.create();
 		overrides = Hashtbl.create 0;
-		cached_types = Hlopt.IMap.empty;
+		cached_types = IMap.empty;
 		cached_tuples = PMap.empty;
 		cfids = new_lookup();
 		defined_funs = Hashtbl.create 0;
@@ -3927,7 +3921,7 @@ let create_context com is_macro dump =
 		core_type = get_class "CoreType";
 		core_enum = get_class "CoreEnum";
 		ref_abstract = get_abstract "Ref";
-		anons_cache = [];
+		anons_cache = IMap.empty;
 		rec_cache = [];
 		method_wrappers = PMap.empty;
 		cdebug_files = new_lookup();

src/generators/genjava.ml

@@ -930,7 +930,7 @@ let reserved = let res = Hashtbl.create 120 in
 		"void"; "volatile"; "while"; ];
 	res
 
-let dynamic_anon = TAnon( { a_fields = PMap.empty; a_status = ref Closed } )
+let dynamic_anon = TAnon( { a_id = mk_aid(); a_fields = PMap.empty; a_status = ref Closed } )
 
 let rec get_class_modifiers meta cl_type cl_access cl_modifiers =
 	match meta with
@@ -2308,7 +2308,7 @@ let generate con =
 
 	let empty_en = match get_type gen (["haxe";"lang"], "EmptyObject") with TEnumDecl e -> e | _ -> assert false in
 	let empty_ctor_type = TEnum(empty_en, []) in
-	let empty_en_expr = mk (TTypeExpr (TEnumDecl empty_en)) (TAnon { a_fields = PMap.empty; a_status = ref (EnumStatics empty_en) }) null_pos in
+	let empty_en_expr = mk (TTypeExpr (TEnumDecl empty_en)) (TAnon { a_id = mk_aid(); a_fields = PMap.empty; a_status = ref (EnumStatics empty_en) }) null_pos in
 	let empty_ctor_expr = mk (TField (empty_en_expr, FEnum(empty_en, PMap.find "EMPTY" empty_en.e_constrs))) empty_ctor_type null_pos in
 	OverloadingConstructor.configure ~empty_ctor_type:empty_ctor_type ~empty_ctor_expr:empty_ctor_expr gen;
 

src/generators/genpy.ml

@@ -38,7 +38,7 @@ module Utils = struct
 			abort (Printf.sprintf "Could not find type %s\n" (s_type_path path)) null_pos
 
 	let mk_static_field c cf p =
-			let ta = TAnon { a_fields = c.cl_statics; a_status = ref (Statics c) } in
+			let ta = TAnon { a_id = mk_aid(); a_fields = c.cl_statics; a_status = ref (Statics c) } in
 			let ethis = mk (TTypeExpr (TClassDecl c)) ta p in
 			let t = monomorphs cf.cf_params cf.cf_type in
 			mk (TField (ethis,(FStatic (c,cf)))) t p

src/generators/hlcode.ml

@@ -225,6 +225,11 @@ type code = {
 	constants : (global * int array) array;
 }
 
+module IMap = Map.Make(struct
+	let compare a b = b - a
+	type t = int
+end)
+
 let null_proto =
 	{
 		pname = "";

src/generators/hlopt.ml

@@ -26,11 +26,6 @@ module ISet = Set.Make(struct
 	type t = int
 end)
 
-module IMap = Map.Make(struct
-	let compare a b = b - a
-	type t = int
-end)
-
 type cur_value =
 	| VUndef
 	| VReg of int

src/optimization/inline.ml

@@ -667,7 +667,7 @@ let rec type_inline ctx cf f ethis params tret config p ?(self_calling_closure=f
 			let fl = List.map (fun (s,e) -> s,map false false e) fl in
 			begin match follow e.etype with
 				| TAnon an when (match !(an.a_status) with Const -> true | _ -> false) ->
-					{e with eexpr = TObjectDecl fl; etype = TAnon { an with a_status = ref Closed}}
+					{e with eexpr = TObjectDecl fl; etype = TAnon { an with a_id = mk_aid(); a_status = ref Closed}}
 				| _ ->
 					{e with eexpr = TObjectDecl fl}
 			end

src/typing/fields.ml

@@ -96,7 +96,7 @@ let field_type ctx c pl f p =
 		apply_params l monos f.cf_type
 
 let fast_enum_field e ef p =
-	let et = mk (TTypeExpr (TEnumDecl e)) (TAnon { a_fields = PMap.empty; a_status = ref (EnumStatics e) }) p in
+	let et = mk (TTypeExpr (TEnumDecl e)) (TAnon { a_id = mk_aid(); a_fields = PMap.empty; a_status = ref (EnumStatics e) }) p in
 	TField (et,FEnum (e,ef))
 
 let get_constructor ctx c params p =
@@ -464,7 +464,7 @@ let rec type_field ?(resume=false) ctx e i p mode =
 			cf_kind = Var { v_read = AccNormal; v_write = (match mode with MSet -> AccNormal | MGet | MCall -> AccNo) };
 		} in
 		let x = ref Opened in
-		let t = TAnon { a_fields = PMap.add i f PMap.empty; a_status = x } in
+		let t = TAnon { a_id = mk_aid(); a_fields = PMap.add i f PMap.empty; a_status = x } in
 		ctx.opened <- x :: ctx.opened;
 		r := Some t;
 		field_access ctx mode f (FAnon f) (Type.field_type f) e p

src/typing/finalization.ml

@@ -35,7 +35,7 @@ let get_main ctx types =
 			let ec = (match et with TClassDecl c -> c | _ -> assert false) in
 			let ef = PMap.find "run" ec.cl_statics in
 			let p = null_pos in
-			let et = mk (TTypeExpr et) (TAnon { a_fields = PMap.empty; a_status = ref (Statics ec) }) p in
+			let et = mk (TTypeExpr et) (TAnon { a_id = mk_aid(); a_fields = PMap.empty; a_status = ref (Statics ec) }) p in
 			let call = mk (TCall (mk (TField (et,FStatic (ec,ef))) ef.cf_type p,[])) ctx.t.tvoid p in
 			mk (TBlock [main;call]) ctx.t.tvoid p
 		with Not_found ->

src/typing/typeload.ml

@@ -231,7 +231,7 @@ let make_extension_type ctx tl p =
 			error "Can only extend structures" p
 	in
 	let fields = List.fold_left mk_extension PMap.empty tl in
-	let ta = TAnon { a_fields = fields; a_status = ref (Extend tl); } in
+	let ta = TAnon { a_id = mk_aid(); a_fields = fields; a_status = ref (Extend tl); } in
 	ta
 
 (* build an instance from a full type *)
@@ -396,7 +396,7 @@ and load_complex_type' ctx allow_display (t,p) =
 					error "Loop found in cascading signatures definitions. Please change order/import" p
 				| TAnon a2 ->
 					PMap.iter (fun _ cf -> ignore(is_redefined ctx cf a2.a_fields p)) a.a_fields;
-					TAnon { a_fields = (PMap.foldi PMap.add a.a_fields a2.a_fields); a_status = ref (Extend [t]); }
+					TAnon { a_id = mk_aid(); a_fields = (PMap.foldi PMap.add a.a_fields a2.a_fields); a_status = ref (Extend [t]); }
 				| _ -> error "Can only extend structures" p
 			in
 			let loop t = match follow t with
@@ -517,7 +517,7 @@ and load_complex_type' ctx allow_display (t,p) =
 			end;
 			PMap.add n cf acc
 		in
-		let a = { a_fields = (List.fold_left loop PMap.empty l); a_status = ref Closed; } in
+		let a = { a_id = mk_aid(); a_fields = (List.fold_left loop PMap.empty l); a_status = ref Closed; } in
 		begin match !displayed_field with
 		| None ->
 			()

src/typing/typeloadModule.ml

@@ -673,6 +673,7 @@ let init_module_type ctx context_init do_init (decl,p) =
 		e.e_extern <- e.e_extern;
 		e.e_type.t_params <- e.e_params;
 		e.e_type.t_type <- TAnon {
+			a_id = mk_aid();
 			a_fields = !fields;
 			a_status = ref (EnumStatics e);
 		};

src/typing/typer.ml

@@ -245,7 +245,7 @@ let rec unify_min_raise basic (el:texpr list) : t =
 				let t = try unify_min_raise basic el with Unify_error _ -> raise Not_found in
 				PMap.add n (mk_field n t (List.hd el).epos null_pos) acc
 			) fields PMap.empty in
-			TAnon { a_fields = fields; a_status = ref Closed }
+			TAnon { a_id = mk_aid(); a_fields = fields; a_status = ref Closed }
 		with Not_found ->
 			(* Second pass: Get all base types (interfaces, super classes and their interfaces) of most general type.
 			   Then for each additional type filter all types that do not unify. *)
@@ -1593,6 +1593,7 @@ and type_object_decl ctx fl with_type p =
 			| TDynamic t when (follow t != t_dynamic) ->
 				dynamic_parameter := Some t;
 				ODKWithStructure {
+					a_id = mk_aid();
 					a_status = ref Closed;
 					a_fields = PMap.empty;
 				}
@@ -1638,7 +1639,7 @@ and type_object_decl ctx fl with_type p =
 			end;
 			((n,pn,qs),e)
 		) fl in
-		let t = (TAnon { a_fields = !fields; a_status = ref Const }) in
+		let t = (TAnon { a_id = mk_aid(); a_fields = !fields; a_status = ref Const }) in
 		if not ctx.untyped then begin
 			(match PMap.foldi (fun n cf acc -> if not (Meta.has Meta.Optional cf.cf_meta) && not (PMap.mem n !fields) then n :: acc else acc) field_map [] with
 				| [] -> ()
@@ -1666,7 +1667,7 @@ and type_object_decl ctx fl with_type p =
 		let fields , types = List.fold_left loop ([],PMap.empty) fl in
 		let x = ref Const in
 		ctx.opened <- x :: ctx.opened;
-		mk (TObjectDecl (List.rev fields)) (TAnon { a_fields = types; a_status = x }) p
+		mk (TObjectDecl (List.rev fields)) (TAnon { a_id = mk_aid(); a_fields = types; a_status = x }) p
 	in
 	(match a with
 	| ODKPlain -> type_plain_fields()
@@ -1783,7 +1784,7 @@ and type_new ctx path el with_type force_inline p =
 		end
 	| TAbstract({a_impl = Some c} as a,tl) when not (Meta.has Meta.MultiType a.a_meta) ->
 		let el,cf,ct = build_constructor_call c tl in
-		let ta = TAnon { a_fields = c.cl_statics; a_status = ref (Statics c) } in
+		let ta = TAnon { a_id = mk_aid(); a_fields = c.cl_statics; a_status = ref (Statics c) } in
 		let e = mk (TTypeExpr (TClassDecl c)) ta p in
 		let e = mk (TField (e,(FStatic (c,cf)))) ct p in
 		make_call ctx e el t ~force_inline p