Bläddra i källkod

add a unique id per type, allow for faster lookup in some generators (by type id instead of type path)

Nicolas Cannasse 6 år sedan
förälder
incheckning
946682f359
4 ändrade filer med 44 tillägg och 22 borttagningar
  1. 14 0
      src/core/type.ml
  2. 13 15
      src/generators/genhl.ml
  3. 13 7
      src/generators/hlopt.ml
  4. 4 0
      src/typing/typeloadModule.ml

+ 14 - 0
src/core/type.ml

@@ -204,6 +204,7 @@ and tclass_kind =
 and metadata = Ast.metadata
 
 and tinfos = {
+	mt_uid : int;
 	mt_path : path;
 	mt_module : module_def;
 	mt_pos : pos;
@@ -216,6 +217,7 @@ and tinfos = {
 }
 
 and tclass = {
+	cl_uid : int;
 	mutable cl_path : path;
 	mutable cl_module : module_def;
 	mutable cl_pos : pos;
@@ -263,6 +265,7 @@ and tenum_field = {
 }
 
 and tenum = {
+	e_uid : int;
 	mutable e_path : path;
 	e_module : module_def;
 	e_pos : pos;
@@ -280,6 +283,7 @@ and tenum = {
 }
 
 and tdef = {
+	t_uid : int;
 	t_path : path;
 	t_module : module_def;
 	t_pos : pos;
@@ -294,6 +298,7 @@ and tdef = {
 }
 
 and tabstract = {
+	a_uid : int;
 	mutable a_path : path;
 	a_module : module_def;
 	a_pos : pos;
@@ -458,8 +463,13 @@ 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_uid =
+	let uid = ref 0 in
+	(fun() -> incr uid; !uid)
+
 let mk_class m path pos name_pos =
 	{
+		cl_uid = mk_uid();
 		cl_path = path;
 		cl_module = m;
 		cl_pos = pos;
@@ -541,6 +551,7 @@ let null_class =
 let null_field = mk_field "" t_dynamic null_pos null_pos
 
 let null_abstract = {
+	a_uid = mk_uid();
 	a_path = ([],"");
 	a_module = null_module;
 	a_pos = null_pos;
@@ -2920,6 +2931,7 @@ module StringError = struct
 end
 
 let class_module_type c = {
+	t_uid = mk_uid();
 	t_path = [],"Class<" ^ (s_type_path c.cl_path) ^ ">" ;
 	t_module = c.cl_module;
 	t_doc = None;
@@ -2936,6 +2948,7 @@ let class_module_type c = {
 }
 
 let enum_module_type m path p  = {
+	t_uid = mk_uid();
 	t_path = [], "Enum<" ^ (s_type_path path) ^ ">";
 	t_module = m;
 	t_doc = None;
@@ -2949,6 +2962,7 @@ let enum_module_type m path p  = {
 }
 
 let abstract_module_type a tl = {
+	t_uid = mk_uid();
 	t_path = [],Printf.sprintf "Abstract<%s%s>" (s_type_path a.a_path) (s_type_params (ref []) tl);
 	t_module = a.a_module;
 	t_doc = None;

+ 13 - 15
src/generators/genhl.ml

@@ -98,7 +98,7 @@ type context = {
 	defined_funs : (int,unit) Hashtbl.t;
 	is_macro : bool;
 	mutable dump_out : (unit IO.output) option;
-	mutable cached_types : (path, ttype) PMap.t;
+	mutable cached_types : ttype Hlopt.IMap.t;
 	mutable m : method_context;
 	mutable anons_cache : (tanon * ttype) list;
 	mutable method_wrappers : ((ttype * ttype), int) PMap.t;
@@ -540,16 +540,16 @@ and real_type ctx e =
 
 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 fst c.cl_path, "$" ^ snd c.cl_path else c.cl_path) in
+	let key_path = (if statics then c.cl_uid lsl 1 else (c.cl_uid lsl 1) lor 1) in
 	try
-		PMap.find key_path ctx.cached_types
+		Hlopt.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 <- PMap.add c.cl_path t ctx.cached_types;
+		ctx.cached_types <- Hlopt.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
@@ -559,7 +559,7 @@ and class_type ?(tref=None) ctx c pl statics =
 		Array.iteri (fun i (n,_,_) -> vp.vindex <- PMap.add n i vp.vindex) vp.vfields;
 		t
 	| Not_found ->
-		let pname = s_type_path key_path in
+		let pname = s_type_path (if statics then fst c.cl_path, "$" ^ snd c.cl_path else c.cl_path) in
 		let p = {
 			pname = pname;
 			pid = alloc_string ctx pname;
@@ -579,7 +579,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 <- PMap.add key_path t ctx.cached_types;
+		ctx.cached_types <- Hlopt.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 +678,7 @@ and class_type ?(tref=None) ctx c pl statics =
 
 and enum_type ?(tref=None) ctx e =
 	try
-		PMap.find e.e_path ctx.cached_types
+		Hlopt.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 +691,7 @@ and enum_type ?(tref=None) ctx e =
 		(match tref with
 		| None -> ()
 		| Some r -> r := Some t);
-		ctx.cached_types <- PMap.add e.e_path t ctx.cached_types;
+		ctx.cached_types <- Hlopt.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
@@ -705,10 +705,11 @@ and enum_type ?(tref=None) ctx e =
 		t
 
 and enum_class ctx e =
-	let cpath = (fst e.e_path,"$" ^ snd e.e_path) in
+	let key_path = (e.e_uid lsl 1) lor 1 in
 	try
-		PMap.find cpath ctx.cached_types
+		Hlopt.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
 		let p = {
 			pname = pname;
@@ -725,7 +726,7 @@ and enum_class ctx e =
 			pbindings = [];
 		} in
 		let t = HObj p in
-		ctx.cached_types <- PMap.add cpath t ctx.cached_types;
+		ctx.cached_types <- Hlopt.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
 
@@ -756,9 +757,6 @@ and class_global ?(resolve=true) ctx c =
 let resolve_class_global ctx cpath =
 	lookup ctx.cglobals ("$" ^ cpath) (fun() -> assert false)
 
-let resolve_type ctx path =
-	PMap.find path ctx.cached_types
-
 let alloc_std ctx name args ret =
 	let lib = "std" in
 	(* different from :hlNative to prevent mismatch *)
@@ -3909,7 +3907,7 @@ let create_context com is_macro dump =
 		cconstants = new_lookup();
 		cfunctions = DynArray.create();
 		overrides = Hashtbl.create 0;
-		cached_types = PMap.empty;
+		cached_types = Hlopt.IMap.empty;
 		cached_tuples = PMap.empty;
 		cfids = new_lookup();
 		defined_funs = Hashtbl.create 0;

+ 13 - 7
src/generators/hlopt.ml

@@ -26,6 +26,11 @@ 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
@@ -46,7 +51,7 @@ type block = {
 	mutable bstate : reg_state array option;
 	mutable bneed : ISet.t;
 	mutable bneed_all : ISet.t option;
-	mutable bwrite : (int, int) PMap.t;
+	mutable bwrite : int IMap.t;
 }
 
 type control =
@@ -456,7 +461,7 @@ let code_graph (f:fundecl) =
 				bloop = false;
 				bstate = None;
 				bneed = ISet.empty;
-				bwrite = PMap.empty;
+				bwrite = IMap.empty;
 				bneed_all = None;
 			} in
 			Hashtbl.add blocks_pos pos b;
@@ -608,7 +613,7 @@ let optimize dump get_str (f:fundecl) =
 				s.rbind <- [];
 				s.rnullcheck <- false;
 				last_write.(r) <- i;
-				b.bwrite <- PMap.add r i b.bwrite;
+				b.bwrite <- IMap.add r i b.bwrite;
 				write_count r;
 				unalias s
 			in
@@ -704,7 +709,7 @@ let optimize dump get_str (f:fundecl) =
 			) ISet.empty b.bnext in
 			let need_sub = ISet.filter (fun r ->
 				try
-					let w = PMap.find r b.bwrite in
+					let w = IMap.find r b.bwrite in
 					set_live r (w + 1) b.bend;
 					false
 				with Not_found ->
@@ -789,7 +794,7 @@ let optimize dump get_str (f:fundecl) =
 				if reg < nargs then [(i,-reg-1)] else
 				let b = resolve_block p in
 				if last_w >= b.bstart && last_w < b.bend && last_w < p then loop last_w else
-				let wp = try PMap.find reg b.bwrite with Not_found -> -1 in
+				let wp = try IMap.find reg b.bwrite with Not_found -> -1 in
 				let rec gather b =
 					if Hashtbl.mem gmap b.bstart then [] else begin
 						Hashtbl.add gmap b.bstart ();
@@ -797,7 +802,7 @@ let optimize dump get_str (f:fundecl) =
 						List.fold_left (fun acc bp ->
 							if bp.bstart > b.bstart then acc else
 							try
-								let wp = PMap.find reg bp.bwrite in
+								let wp = IMap.find reg bp.bwrite in
 								if wp > p then assert false;
 								loop wp @ acc
 							with Not_found ->
@@ -847,7 +852,8 @@ let optimize dump get_str (f:fundecl) =
 					b.bend
 				);
 				let need = String.concat "," (List.map string_of_int (ISet.elements b.bneed)) in
-				let wr = String.concat " " (List.rev (PMap.foldi (fun r p acc -> Printf.sprintf "%d@%X" r p :: acc) b.bwrite [])) in
+				let reg_count = ref (-1) in
+				let wr = String.concat " " (List.rev (IMap.fold (fun p _ acc -> incr reg_count; let r = !reg_count in Printf.sprintf "%d@%X" r p :: acc) b.bwrite [])) in
 				write ("\t" ^ (if b.bloop then "LOOP " else "") ^ "NEED=" ^ need ^ "\tWRITE=" ^ wr);
 				b
 			with Not_found ->

+ 4 - 0
src/typing/typeloadModule.ml

@@ -229,6 +229,7 @@ let module_pass_1 ctx m tdecls loadp =
 			let priv = List.mem EPrivate d.d_flags in
 			let path = make_path name priv in
 			let e = {
+				e_uid = mk_uid();
 				e_path = path;
 				e_module = m;
 				e_pos = p;
@@ -252,6 +253,7 @@ let module_pass_1 ctx m tdecls loadp =
 			let priv = List.mem EPrivate d.d_flags in
 			let path = make_path name priv in
 			let t = {
+				t_uid = mk_uid();
 				t_path = path;
 				t_module = m;
 				t_pos = p;
@@ -277,6 +279,7 @@ let module_pass_1 ctx m tdecls loadp =
 			let priv = List.mem AbPrivate d.d_flags in
 			let path = make_path name priv in
 			let a = {
+				a_uid = mk_uid();
 				a_path = path;
 				a_private = priv;
 				a_module = m;
@@ -396,6 +399,7 @@ let init_module_type ctx context_init do_init (decl,p) =
 				let _, _, f = ctx.g.do_build_instance ctx t p_type in
 				(* create a temp private typedef, does not register it in module *)
 				let mt = TTypeDecl {
+					t_uid = mk_uid();
 					t_path = (fst md.m_path @ ["_" ^ snd md.m_path],name);
 					t_module = ctx.m.curmod;
 					t_pos = p;