Optimize Path.UniqueKey.create

src/codegen/codegen.ml

@@ -432,11 +432,12 @@ module Dump = struct
 		let print fmt = Printf.kprintf (fun s -> Buffer.add_string buf s) fmt in
 		let dep = Hashtbl.create 0 in
 		List.iter (fun m ->
-			print "%s:\n" m.m_extra.m_file;
+			print "%s:\n" (Path.UniqueKey.lazy_path m.m_extra.m_file);
 			PMap.iter (fun _ m2 ->
-				print "\t%s\n" (m2.m_extra.m_file);
-				let l = try Hashtbl.find dep m2.m_extra.m_file with Not_found -> [] in
-				Hashtbl.replace dep m2.m_extra.m_file (m :: l)
+				let file = Path.UniqueKey.lazy_path m2.m_extra.m_file in
+				print "\t%s\n" file;
+				let l = try Hashtbl.find dep file with Not_found -> [] in
+				Hashtbl.replace dep file (m :: l)
 			) m.m_extra.m_deps;
 		) com.Common.modules;
 		close();
@@ -446,7 +447,7 @@ module Dump = struct
 		Hashtbl.iter (fun n ml ->
 			print "%s:\n" n;
 			List.iter (fun m ->
-				print "\t%s\n" (m.m_extra.m_file);
+				print "\t%s\n" (Path.UniqueKey.lazy_path m.m_extra.m_file);
 			) ml;
 		) dep;
 		close()

src/codegen/gencommon/gencommon.ml

@@ -839,12 +839,12 @@ let write_file gen w source_dir path extension out_files =
 		close_out f
 	end;
 
-	out_files := (Path.UniqueKey.create s_path) :: !out_files;
+	out_files := (gen.gcon.file_keys#get s_path) :: !out_files;
 
 	t()
 
 
-let clean_files path excludes verbose =
+let clean_files gen path excludes verbose =
 	let rec iter_files pack dir path = try
 		let file = Unix.readdir dir in
 
@@ -854,7 +854,7 @@ let clean_files path excludes verbose =
 				let pack = pack @ [file] in
 				iter_files (pack) (Unix.opendir filepath) filepath;
 				try Unix.rmdir filepath with Unix.Unix_error (ENOTEMPTY,_,_) -> ();
-			else if not (String.ends_with filepath ".meta") && not (List.mem (Path.UniqueKey.create filepath) excludes) then begin
+			else if not (String.ends_with filepath ".meta") && not (List.mem (gen.gcon.file_keys#get filepath) excludes) then begin
 				if verbose then print_endline ("Removing " ^ filepath);
 			 	Sys.remove filepath
 			end

src/compiler/displayOutput.ml

@@ -235,7 +235,7 @@ let handle_display_argument com file_pos pre_compilation did_something =
 	| _ ->
 		let file, pos = try ExtString.String.split file_pos "@" with _ -> failwith ("Invalid format: " ^ file_pos) in
 		let file = unquote file in
-		let file_unique = Path.UniqueKey.create file in
+		let file_unique = com.file_keys#get file in
 		let pos, smode = try ExtString.String.split pos "@" with _ -> pos,"" in
 		let mode = match smode with
 			| "position" ->
@@ -430,7 +430,7 @@ let process_global_display_mode com tctx =
 				let l = cs#get_context_files ((Define.get_signature com.defines) :: (match com.get_macros() with None -> [] | Some com -> [Define.get_signature com.defines])) in
 				List.fold_left (fun acc (file_key,cfile) ->
 					let file = cfile.CompilationServer.c_file_path in
-					if (filter <> None || DisplayPosition.display_position#is_in_file file) then
+					if (filter <> None || DisplayPosition.display_position#is_in_file (com.file_keys#get file)) then
 						(file,DocumentSymbols.collect_module_symbols (Some (file,get_module_name_of_cfile file cfile)) (filter = None) (cfile.c_package,cfile.c_decls)) :: acc
 					else
 						acc

src/compiler/server.ml

@@ -123,8 +123,8 @@ let current_stdin = ref None
 let parse_file cs com file p =
 	let cc = CommonCache.get_cache cs com in
 	let ffile = Path.get_full_path file
-	and fkey = Path.UniqueKey.create file in
-	let is_display_file = DisplayPosition.display_position#is_in_file ffile in
+	and fkey = com.file_keys#get file in
+	let is_display_file = DisplayPosition.display_position#is_in_file (com.file_keys#get ffile) in
 	match is_display_file, !current_stdin with
 	| true, Some stdin when Common.defined com Define.DisplayStdin ->
 		TypeloadParse.parse_file_from_string com file p stdin
@@ -287,7 +287,7 @@ let check_module sctx ctx m p =
 	let com = ctx.Typecore.com in
 	let cc = CommonCache.get_cache sctx.cs com in
 	let content_changed m file =
-		let fkey = Path.UniqueKey.create file in
+		let fkey = ctx.com.file_keys#get file in
 		try
 			let cfile = cc#find_file fkey in
 			(* We must use the module path here because the file path is absolute and would cause
@@ -331,7 +331,7 @@ let check_module sctx ctx m p =
 						match load m.m_path p with
 						| None -> loop l
 						| Some _ ->
-							if Path.UniqueKey.create file <> Path.UniqueKey.create m.m_extra.m_file then begin
+							if com.file_keys#get file <> (Path.UniqueKey.lazy_key m.m_extra.m_file) then begin
 								if sctx.verbose then print_endline ("Library file was changed for " ^ s_type_path m.m_path); (* TODO *)
 								raise Not_found;
 							end
@@ -358,12 +358,13 @@ let check_module sctx ctx m p =
 			| _ -> false
 		in
 		let check_file () =
-			if file_time m.m_extra.m_file <> m.m_extra.m_time then begin
-				if has_policy CheckFileContentModification && not (content_changed m m.m_extra.m_file) then begin
-					ServerMessage.unchanged_content com "" m.m_extra.m_file;
+			let file = Path.UniqueKey.lazy_path m.m_extra.m_file in
+			if file_time file <> m.m_extra.m_time then begin
+				if has_policy CheckFileContentModification && not (content_changed m file) then begin
+					ServerMessage.unchanged_content com "" file;
 				end else begin
 					ServerMessage.not_cached com "" m;
-					if m.m_extra.m_kind = MFake then Hashtbl.remove Typecore.fake_modules (Path.UniqueKey.create m.m_extra.m_file);
+					if m.m_extra.m_kind = MFake then Hashtbl.remove Typecore.fake_modules (Path.UniqueKey.lazy_key m.m_extra.m_file);
 					raise Not_found;
 				end
 			end
@@ -385,7 +386,7 @@ let check_module sctx ctx m p =
 				m.m_extra.m_mark <- mark;
 				if old_mark <= start_mark then begin
 					if not (has_policy NoCheckShadowing) then check_module_path();
-					if not (has_policy NoCheckFileTimeModification) || file_extension m.m_extra.m_file <> "hx" then check_file();
+					if not (has_policy NoCheckFileTimeModification) || file_extension (Path.UniqueKey.lazy_path m.m_extra.m_file) <> "hx" then check_file();
 				end;
 				if not (has_policy NoCheckDependencies) then check_dependencies();
 				None

src/compiler/serverMessage.ml

@@ -71,7 +71,7 @@ let changed_directories com tabs dirs =
 
 let module_path_changed com tabs (m,time,file) =
 	if config.print_module_path_changed then print_endline (Printf.sprintf "%smodule path might have changed: %s\n\twas: %2.0f %s\n\tnow: %2.0f %s"
-		(sign_string com) (s_type_path m.m_path) m.m_extra.m_time m.m_extra.m_file time file)
+		(sign_string com) (s_type_path m.m_path) m.m_extra.m_time (Path.UniqueKey.lazy_path m.m_extra.m_file) time file)
 
 let not_cached com tabs m =
 	if config.print_not_cached then print_endline (Printf.sprintf "%s%s not cached (%s)" (sign_string com) (s_type_path m.m_path) "modified")

src/context/common.ml

@@ -212,6 +212,18 @@ class compiler_callbacks = object(self)
 	method get_null_safety_report = null_safety_report
 end
 
+class file_keys = object(self)
+	val cache = Hashtbl.create 0
+
+	method get file =
+		try
+			Hashtbl.find cache file
+		with Not_found ->
+			let key = Path.UniqueKey.create file in
+			Hashtbl.add cache file key;
+			key
+end
+
 type shared_display_information = {
 	mutable diagnostics_messages : (string * pos * DisplayTypes.DiagnosticsKind.t * DisplayTypes.DiagnosticsSeverity.t) list;
 }
@@ -281,6 +293,7 @@ type context = {
 	mutable get_macros : unit -> context option;
 	mutable run_command : string -> int;
 	file_lookup_cache : (string,string option) Hashtbl.t;
+	file_keys : file_keys;
 	readdir_cache : (string * string,(string array) option) Hashtbl.t;
 	parser_cache : (string,(type_def * pos) list) Hashtbl.t;
 	module_to_file : (path,string) Hashtbl.t;
@@ -662,6 +675,7 @@ let create version s_version args =
 			tarray = (fun _ -> die "" __LOC__);
 		};
 		file_lookup_cache = Hashtbl.create 0;
+		file_keys = new file_keys;
 		readdir_cache = Hashtbl.create 0;
 		module_to_file = Hashtbl.create 0;
 		stored_typed_exprs = PMap.empty;
@@ -1027,7 +1041,7 @@ let is_legacy_completion com = match com.json_out with
 let get_entry_point com =
 	Option.map (fun path ->
 		let m = List.find (fun m -> m.m_path = path) com.modules in
-		let c = 
+		let c =
 			match m.m_statics with
 			| Some c when (PMap.mem "main" c.cl_statics) -> c
 			| _ -> ExtList.List.find_map (fun t -> match t with TClassDecl c when c.cl_path = path -> Some c | _ -> None) m.m_types

src/context/compilationServer.ml

@@ -163,7 +163,7 @@ class cache = object(self)
 	method taint_modules file_key =
 		Hashtbl.iter (fun _ cc ->
 			Hashtbl.iter (fun _ m ->
-				if Path.UniqueKey.create m.m_extra.m_file = file_key then m.m_extra.m_dirty <- Some m.m_path
+				if Path.UniqueKey.lazy_key m.m_extra.m_file = file_key then m.m_extra.m_dirty <- Some m.m_path
 			) cc#get_modules
 		) contexts
 

src/context/display/diagnostics.ml

@@ -12,7 +12,7 @@ open DiagnosticsTypes
 let add_removable_code ctx s p prange =
 	ctx.removable_code <- (s,p,prange) :: ctx.removable_code
 
-let is_diagnostics_run p = DiagnosticsPrinter.is_diagnostics_file p.pfile
+let is_diagnostics_run com p = DiagnosticsPrinter.is_diagnostics_file (com.file_keys#get p.pfile)
 
 let find_unused_variables com e =
 	let vars = Hashtbl.create 0 in
@@ -107,7 +107,7 @@ let prepare com =
 		unresolved_identifiers = [];
 	} in
 	List.iter (function
-		| TClassDecl c when DiagnosticsPrinter.is_diagnostics_file c.cl_pos.pfile ->
+		| TClassDecl c when DiagnosticsPrinter.is_diagnostics_file (com.file_keys#get c.cl_pos.pfile) ->
 			List.iter (prepare_field dctx com) c.cl_ordered_fields;
 			List.iter (prepare_field dctx com) c.cl_ordered_statics;
 			(match c.cl_constructor with None -> () | Some cf -> prepare_field dctx com cf);
@@ -122,7 +122,7 @@ let prepare com =
 				ParserEntry.is_true (ParserEntry.eval defines e)
 			in
 			Hashtbl.iter (fun file_key cfile ->
-				if DisplayPosition.display_position#is_in_file cfile.CompilationServer.c_file_path then begin
+				if DisplayPosition.display_position#is_in_file (com.file_keys#get cfile.CompilationServer.c_file_path) then begin
 					let dead_blocks = cfile.CompilationServer.c_pdi.pd_dead_blocks in
 					let dead_blocks = List.filter (fun (_,e) -> not (is_true display_defines e)) dead_blocks in
 					try
@@ -161,7 +161,7 @@ let prepare com =
 	dctx
 
 let secure_generated_code ctx e =
-	if is_diagnostics_run e.epos then mk (TMeta((Meta.Extern,[],e.epos),e)) e.etype e.epos else e
+	if is_diagnostics_run ctx.com e.epos then mk (TMeta((Meta.Extern,[],e.epos),e)) e.etype e.epos else e
 
 let print com =
 	let dctx = prepare com in

src/context/display/diagnosticsPrinter.ml

@@ -7,11 +7,10 @@ open DiagnosticsTypes
 
 type t = DiagnosticsKind.t * pos
 
-let is_diagnostics_file file =
-	let key = Path.UniqueKey.create file in
+let is_diagnostics_file file_key =
 	match (!Parser.display_mode) with
 	| DMDiagnostics [] -> true
-	| DMDiagnostics file_keys -> List.exists (fun key' -> key = key') file_keys
+	| DMDiagnostics file_keys -> List.exists (fun key' -> file_key = key') file_keys
 	| _ -> false
 
 module UnresolvedIdentifierSuggestion = struct
@@ -42,8 +41,9 @@ let json_of_diagnostics dctx =
 		if not (Hashtbl.mem diag p) then
 			Hashtbl.add diag p (dk,p,sev,args)
 	in
+	let file_keys = new Common.file_keys in
 	let add dk p sev args =
-		if p = null_pos || is_diagnostics_file p.pfile then add dk p sev args
+		if p = null_pos || is_diagnostics_file (file_keys#get p.pfile) then add dk p sev args
 	in
 	List.iter (fun (s,p,suggestions) ->
 		let suggestions = ExtList.List.filter_map (fun (s,item,r) ->

src/context/display/displayJson.ml

@@ -197,7 +197,7 @@ let handler =
 		"server/moduleCreated", (fun hctx ->
 			let file = hctx.jsonrpc#get_string_param "file" in
 			let file = Path.get_full_path file in
-			let key = Path.UniqueKey.create file in
+			let key = hctx.com.file_keys#get file in
 			let cs = hctx.display#get_cs in
 			List.iter (fun cc ->
 				Hashtbl.replace cc#get_removed_files key file
@@ -221,7 +221,7 @@ let handler =
 		);
 		"server/invalidate", (fun hctx ->
 			let file = hctx.jsonrpc#get_string_param "file" in
-			let fkey = Path.UniqueKey.create file in
+			let fkey = hctx.com.file_keys#get file in
 			let cs = hctx.display#get_cs in
 			cs#taint_modules fkey;
 			cs#remove_files fkey;

src/context/display/displayPath.ml

@@ -192,7 +192,7 @@ let handle_path_display ctx path p =
 			(* We assume that we want to go to the module file, not a specific type
 			   which might not even exist anyway. *)
 			let mt = ctx.g.do_load_module ctx (sl,s) p in
-			let p = { pfile = mt.m_extra.m_file; pmin = 0; pmax = 0} in
+			let p = { pfile = (Path.UniqueKey.lazy_path mt.m_extra.m_file); pmin = 0; pmax = 0} in
 			raise_positions [p]
 		| (IDKModule(sl,s),_),DMHover ->
 			let m = ctx.g.do_load_module ctx (sl,s) p in

src/context/display/displayTexpr.ml

@@ -150,7 +150,7 @@ let check_display_file ctx cs =
 	| Some cc ->
 		begin try
 			let p = DisplayPosition.display_position#get in
-			let cfile = cc#find_file (Path.UniqueKey.create p.pfile) in
+			let cfile = cc#find_file (ctx.com.file_keys#get p.pfile) in
 			let path = (cfile.c_package,get_module_name_of_cfile p.pfile cfile) in
 			TypeloadParse.PdiHandler.handle_pdi ctx.com cfile.c_pdi;
 			(* We have to go through type_module_hook because one of the module's dependencies could be

src/context/display/displayToplevel.ml

@@ -108,11 +108,11 @@ let explore_class_paths com timer class_paths recursive f_pack f_module =
 let read_class_paths com timer =
 	explore_class_paths com timer (List.filter ((<>) "") com.class_path) true (fun _ -> ()) (fun file path ->
 		(* Don't parse the display file as that would maybe overwrite the content from stdin with the file contents. *)
-		if not (DisplayPosition.display_position#is_in_file file) then begin
+		if not (DisplayPosition.display_position#is_in_file (com.file_keys#get file)) then begin
 			let file,_,pack,_ = Display.parse_module' com path Globals.null_pos in
 			match CompilationServer.get() with
 			| Some cs when pack <> fst path ->
-				let file_key = Path.UniqueKey.create file in
+				let file_key = com.file_keys#get file in
 				(CommonCache.get_cache cs com)#remove_file_for_real file_key
 			| _ ->
 				()

src/context/display/statistics.ml

@@ -28,7 +28,7 @@ let collect_statistics ctx pfilter with_expressions =
 			try
 				Hashtbl.find paths path
 			with Not_found ->
-				let unique = Path.UniqueKey.create path in
+				let unique = ctx.com.file_keys#get path in
 				Hashtbl.add paths path unique;
 				unique
 		)

src/context/typecore.ml

@@ -352,7 +352,7 @@ let exc_protect ?(force=true) ctx f (where:string) =
 
 let fake_modules = Hashtbl.create 0
 let create_fake_module ctx file =
-	let key = Path.UniqueKey.create file in
+	let key = ctx.com.file_keys#get file in
 	let file = Path.get_full_path file in
 	let mdep = (try Hashtbl.find fake_modules key with Not_found ->
 		let mdep = {

src/core/display/displayPosition.ml

@@ -50,12 +50,11 @@ class display_position_container =
 		method enclosed_in p =
 			encloses_position pos p
 		(**
-			Check if `file` contains current display position
+			Check if a file with `file_key` contains current display position
 		*)
-		method is_in_file file =
-			file <> "?"
-			&& pos.pfile <> "?"
-			&& self#get_file_key = Path.UniqueKey.create file
+		method is_in_file file_key =
+			pos.pfile <> "?"
+			&& self#get_file_key = file_key
 		(**
 			Cut `p` at the position of the latest `display_position#set pos` call.
 		*)

src/core/json/genjson.ml

@@ -702,7 +702,7 @@ let generate_module ctx m =
 		"id",jint m.m_id;
 		"path",generate_module_path m.m_path;
 		"types",jlist (fun mt -> generate_type_path m.m_path (t_infos mt).mt_path (t_infos mt).mt_meta) m.m_types;
-		"file",jstring m.m_extra.m_file;
+		"file",jstring (Path.UniqueKey.lazy_path m.m_extra.m_file);
 		"sign",jstring (Digest.to_hex m.m_extra.m_sign);
 		"dependencies",jarray (PMap.fold (fun m acc -> (jobject [
 			"path",jstring (s_type_path m.m_path);