Explorar el Código

add cl_type to avoid hundreds of ClassStatics anons

Simon Krajewski hace 1 año
padre
commit
ebbfc0f495

+ 1 - 1
src/compiler/hxb/hxbReader.ml

@@ -647,7 +647,7 @@ class hxb_reader
 			TType(self#read_typedef_ref,[])
 		| 13 ->
 			let c = self#read_class_ref in
-			TType(class_module_type c,[])
+			c.cl_type
 		| 14 ->
 			let en = self#read_enum_ref in
 			en.e_type

+ 25 - 22
src/core/tFunctions.ml

@@ -107,8 +107,28 @@ let tfun pl r = TFun (List.map (fun t -> "",false,t) pl,r)
 
 let fun_args l = List.map (fun (a,c,t) -> a, c <> None, t) l
 
-let mk_class m path pos name_pos =
+let mk_typedef m path pos name_pos t =
 	{
+		t_path = path;
+		t_module = m;
+		t_pos = pos;
+		t_name_pos = name_pos;
+		t_private = false;
+		t_doc = None;
+		t_meta = [];
+		t_params = [];
+		t_using = [];
+		t_type = t;
+		t_restore = (fun () -> ());
+	}
+
+let class_module_type c =
+	let path = ([],"Class<" ^ (s_type_path c.cl_path) ^ ">") in
+	let t = mk_anon ~fields:c.cl_statics (ref (ClassStatics c)) in
+	{ (mk_typedef c.cl_module path c.cl_pos null_pos t) with t_private = true}
+
+let mk_class m path pos name_pos =
+	let rec c = {
 		cl_path = path;
 		cl_module = m;
 		cl_pos = pos;
@@ -118,6 +138,7 @@ let mk_class m path pos name_pos =
 		cl_private = false;
 		cl_kind = KNormal;
 		cl_flags = 0;
+		cl_type = t_dynamic;
 		cl_params = [];
 		cl_using = [];
 		cl_super = None;
@@ -133,22 +154,9 @@ let mk_class m path pos name_pos =
 		cl_build = (fun() -> Built);
 		cl_restore = (fun() -> ());
 		cl_descendants = [];
-	}
-
-let mk_typedef m path pos name_pos t =
-	{
-		t_path = path;
-		t_module = m;
-		t_pos = pos;
-		t_name_pos = name_pos;
-		t_private = false;
-		t_doc = None;
-		t_meta = [];
-		t_params = [];
-		t_using = [];
-		t_type = t;
-		t_restore = (fun () -> ());
-	}
+	} in
+	c.cl_type <- TType(class_module_type c,[]);
+	c
 
 let module_extra file sign time kind added policy =
 	{
@@ -940,11 +948,6 @@ let var_extra params e = {
 	v_expr = e;
 }
 
-let class_module_type c =
-	let path = ([],"Class<" ^ (s_type_path c.cl_path) ^ ">") in
-	let t = mk_anon ~fields:c.cl_statics (ref (ClassStatics c)) in
-	{ (mk_typedef c.cl_module path c.cl_pos null_pos t) with t_private = true}
-
 let enum_module_type en fields =
 	let path = ([], "Enum<" ^ (s_type_path en.e_path) ^ ">") in
 	let t = mk_anon ~fields (ref (EnumStatics en)) in

+ 1 - 0
src/core/tType.ml

@@ -291,6 +291,7 @@ and tclass = {
 	mutable cl_using : (tclass * pos) list;
 	mutable cl_restore : unit -> unit;
 	(* do not insert any fields above *)
+	mutable cl_type : t;
 	mutable cl_kind : tclass_kind;
 	mutable cl_flags : int;
 	mutable cl_super : (tclass * tparams) option;

+ 7 - 3
src/core/tUnification.ml

@@ -343,6 +343,13 @@ let fast_eq_check type_param_check a b =
 		c1 == c2 && List.for_all2 type_param_check l1 l2
 	| TAbstract (a1,l1), TAbstract (a2,l2) ->
 		a1 == a2 && List.for_all2 type_param_check l1 l2
+	| TAnon an1,TAnon an2 ->
+		begin match !(an1.a_status),!(an2.a_status) with
+			| ClassStatics c, ClassStatics c2 -> c == c2
+			| EnumStatics e, EnumStatics e2 -> e == e2
+			| AbstractStatics a, AbstractStatics a2 -> a == a2
+			| _ -> false
+		end
 	| _ , _ ->
 		false
 
@@ -391,9 +398,6 @@ let rec shallow_eq a b =
 					loop (List.sort sort_compare fields1) (List.sort sort_compare fields2)
 				in
 				(match !(a2.a_status), !(a1.a_status) with
-				| ClassStatics c, ClassStatics c2 -> c == c2
-				| EnumStatics e, EnumStatics e2 -> e == e2
-				| AbstractStatics a, AbstractStatics a2 -> a == a2
 				| Extend tl1, Extend tl2 -> fields_eq() && List.for_all2 shallow_eq tl1 tl2
 				| Closed, Closed -> fields_eq()
 				| Const, Const -> fields_eq()

+ 2 - 2
src/core/texpr.ml

@@ -486,12 +486,12 @@ let foldmap f acc e =
 (* Collection of functions that return expressions *)
 module Builder = struct
 	let make_static_this c p =
-		mk (TTypeExpr (TClassDecl c)) (TType(TFunctions.class_module_type c,[])) p
+		mk (TTypeExpr (TClassDecl c)) c.cl_type p
 
 	let make_typeexpr mt pos =
 		let t =
 			match resolve_typedef mt with
-			| TClassDecl c -> TType(class_module_type c,[])
+			| TClassDecl c -> c.cl_type
 			| TEnumDecl e -> e.e_type
 			| TAbstractDecl a -> TType(abstract_module_type a [],[])
 			| _ -> die "" __LOC__

+ 6 - 0
src/typing/typeloadFields.ml

@@ -1878,6 +1878,12 @@ let init_class ctx c p herits fields =
 	end;
 	c.cl_ordered_statics <- List.rev c.cl_ordered_statics;
 	c.cl_ordered_fields <- List.rev c.cl_ordered_fields;
+	begin match follow c.cl_type with
+		| TAnon an ->
+			an.a_fields <- c.cl_statics
+		| _ ->
+			die "" __LOC__
+	end;
 	(*
 		make sure a default contructor with same access as super one will be added to the class structure at some point.
 	*)

+ 1 - 2
src/typing/typerBase.ml

@@ -207,8 +207,7 @@ let type_module_type ctx t p =
 			in
 			loop mt None
 		| TClassDecl c ->
-			let t_tmp = class_module_type c in
-			mk (TTypeExpr (TClassDecl c)) (TType (t_tmp,[])) p
+			mk (TTypeExpr (TClassDecl c)) c.cl_type p
 		| TEnumDecl e ->
 			mk (TTypeExpr (TEnumDecl e)) e.e_type p
 		| TTypeDecl s ->