From 3aa4bdc7a4ccd5bc916e246ca8c2bad4172bdf74 Mon Sep 17 00:00:00 2001 From: Aleksandr Kuzmenko Date: Thu, 4 Jun 2020 20:42:30 +0300 Subject: [PATCH 1/3] added `module_def_extra.m_file_key` (#9509) --- src/context/compilationServer.ml | 2 +- src/core/tFunctions.ml | 9 +++++++++ src/core/tType.ml | 1 + 3 files changed, 11 insertions(+), 1 deletion(-) diff --git a/src/context/compilationServer.ml b/src/context/compilationServer.ml index d3073ba060f..2e277eeaecd 100644 --- a/src/context/compilationServer.ml +++ b/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 m.m_extra.m_file_key() = file_key then m.m_extra.m_dirty <- Some m.m_path ) cc#get_modules ) contexts diff --git a/src/core/tFunctions.ml b/src/core/tFunctions.ml index e944a8cc180..d582f9f8402 100644 --- a/src/core/tFunctions.ml +++ b/src/core/tFunctions.ml @@ -114,8 +114,17 @@ let mk_class m path pos name_pos = } let module_extra file sign time kind policy = + let file_key = ref None in { m_file = file; + m_file_key = (fun () -> + match !file_key with + | Some key -> key + | None -> + let key = Path.UniqueKey.create file in + file_key := Some key; + key + ); m_sign = sign; m_display = { m_inline_calls = []; diff --git a/src/core/tType.ml b/src/core/tType.ml index f91cd1d719e..ecaa8600036 100644 --- a/src/core/tType.ml +++ b/src/core/tType.ml @@ -324,6 +324,7 @@ and module_def_display = { and module_def_extra = { m_file : string; + m_file_key : unit -> Path.UniqueKey.t; m_sign : string; m_display : module_def_display; mutable m_check_policy : module_check_policy list; From 415a86c019f9120957c18d7e548945383655e820 Mon Sep 17 00:00:00 2001 From: Aleksandr Kuzmenko Date: Thu, 4 Jun 2020 22:14:17 +0300 Subject: [PATCH 2/3] added a cache for file keys in common and eval contexts --- src/codegen/gencommon/gencommon.ml | 6 +++--- src/compiler/displayOutput.ml | 4 ++-- src/compiler/server.ml | 10 +++++----- src/context/common.ml | 16 +++++++++++++++- src/context/display/diagnostics.ml | 8 ++++---- src/context/display/diagnosticsPrinter.ml | 8 ++++---- src/context/display/displayJson.ml | 4 ++-- src/context/display/displayTexpr.ml | 2 +- src/context/display/displayToplevel.ml | 4 ++-- src/context/display/statistics.ml | 2 +- src/context/typecore.ml | 2 +- src/core/display/displayPosition.ml | 9 ++++----- src/generators/gencs.ml | 4 ++-- src/generators/genjava.ml | 4 ++-- src/macro/eval/evalContext.ml | 5 +++-- src/macro/eval/evalDebugMisc.ml | 4 ++-- src/macro/eval/evalDebugSocket.ml | 2 +- src/macro/eval/evalJit.ml | 2 +- src/macro/eval/evalMain.ml | 3 ++- src/macro/eval/evalPrototype.ml | 2 +- src/macro/macroApi.ml | 6 ++++-- src/syntax/parserEntry.ml | 2 +- src/typing/typeload.ml | 2 +- src/typing/typeloadCheck.ml | 2 +- src/typing/typeloadModule.ml | 4 ++-- src/typing/typeloadParse.ml | 8 ++++---- src/typing/typer.ml | 2 +- 27 files changed, 72 insertions(+), 55 deletions(-) diff --git a/src/codegen/gencommon/gencommon.ml b/src/codegen/gencommon/gencommon.ml index 8fe54fdc3a0..8e697c57252 100644 --- a/src/codegen/gencommon/gencommon.ml +++ b/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 diff --git a/src/compiler/displayOutput.ml b/src/compiler/displayOutput.ml index 68e61b39675..9395a58c955 100644 --- a/src/compiler/displayOutput.ml +++ b/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 (filter = None) (cfile.c_package,cfile.c_decls)) :: acc else acc diff --git a/src/compiler/server.ml b/src/compiler/server.ml index 2a73e9b95ba..68186f2712a 100644 --- a/src/compiler/server.ml +++ b/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 <> m.m_extra.m_file_key() then begin if sctx.verbose then print_endline ("Library file was changed for " ^ s_type_path m.m_path); (* TODO *) raise Not_found; end @@ -363,7 +363,7 @@ let check_module sctx ctx m p = ServerMessage.unchanged_content com "" m.m_extra.m_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 (m.m_extra.m_file_key()); raise Not_found; end end diff --git a/src/context/common.ml b/src/context/common.ml index 9acb818c1a5..e79599c0862 100644 --- a/src/context/common.ml +++ b/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 diff --git a/src/context/display/diagnostics.ml b/src/context/display/diagnostics.ml index 9fea1c72d00..e371b9a2df7 100644 --- a/src/context/display/diagnostics.ml +++ b/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 diff --git a/src/context/display/diagnosticsPrinter.ml b/src/context/display/diagnosticsPrinter.ml index a0561f61dd3..78c5f719bfd 100644 --- a/src/context/display/diagnosticsPrinter.ml +++ b/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) -> diff --git a/src/context/display/displayJson.ml b/src/context/display/displayJson.ml index 65c7abc840c..9ba322e0d52 100644 --- a/src/context/display/displayJson.ml +++ b/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; diff --git a/src/context/display/displayTexpr.ml b/src/context/display/displayTexpr.ml index 0cf8a31394f..3a42130e53e 100644 --- a/src/context/display/displayTexpr.ml +++ b/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 diff --git a/src/context/display/displayToplevel.ml b/src/context/display/displayToplevel.ml index 55c7cfceb6d..3298b878a62 100644 --- a/src/context/display/displayToplevel.ml +++ b/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 | _ -> () diff --git a/src/context/display/statistics.ml b/src/context/display/statistics.ml index 1de3752f972..e200b4c05a8 100644 --- a/src/context/display/statistics.ml +++ b/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 ) diff --git a/src/context/typecore.ml b/src/context/typecore.ml index 5e11f31e78b..038aa1b9f68 100644 --- a/src/context/typecore.ml +++ b/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 = { diff --git a/src/core/display/displayPosition.ml b/src/core/display/displayPosition.ml index db9a055abf7..a831d727036 100644 --- a/src/core/display/displayPosition.ml +++ b/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. *) diff --git a/src/generators/gencs.ml b/src/generators/gencs.ml index a73c70a281e..0957315e84d 100644 --- a/src/generators/gencs.ml +++ b/src/generators/gencs.ml @@ -3382,7 +3382,7 @@ let generate con = output_string f v; close_out f; - out_files := (Path.UniqueKey.create full_path) :: !out_files + out_files := (gen.gcon.file_keys#get full_path) :: !out_files ) gen.gcon.resources; end; (* add resources array *) @@ -3494,7 +3494,7 @@ let generate con = ) gen.gmodules; if not (Common.defined gen.gcon Define.KeepOldOutput) then - clean_files (gen.gcon.file ^ "/src") !out_files gen.gcon.verbose; + clean_files gen (gen.gcon.file ^ "/src") !out_files gen.gcon.verbose; dump_descriptor gen ("hxcs_build.txt") s_type_path module_s; if ( not (Common.defined gen.gcon Define.NoCompilation) ) then begin diff --git a/src/generators/genjava.ml b/src/generators/genjava.ml index 045559e577f..107f5f5f71a 100644 --- a/src/generators/genjava.ml +++ b/src/generators/genjava.ml @@ -2633,7 +2633,7 @@ let generate con = output_string f v; close_out f; - out_files := (Path.UniqueKey.create full_path) :: !out_files + out_files := (gen.gcon.file_keys#get full_path) :: !out_files ) gen.gcon.resources; (try let c = get_cl (Hashtbl.find gen.gtypes (["haxe"], "Resource")) in @@ -2659,7 +2659,7 @@ let generate con = ) gen.gtypes_list; if not (Common.defined gen.gcon Define.KeepOldOutput) then - clean_files (gen.gcon.file ^ "/src") !out_files gen.gcon.verbose; + clean_files gen (gen.gcon.file ^ "/src") !out_files gen.gcon.verbose; let path_s_desc path = path_s path [] in dump_descriptor gen ("hxjava_build.txt") path_s_desc (fun md -> path_s_desc (t_infos md).mt_path); diff --git a/src/macro/eval/evalContext.ml b/src/macro/eval/evalContext.ml index 956a22326d4..ab96155ea67 100644 --- a/src/macro/eval/evalContext.ml +++ b/src/macro/eval/evalContext.ml @@ -279,6 +279,7 @@ and context = { mutable instance_prototypes : vprototype IntMap.t; mutable static_prototypes : static_prototypes; mutable constructors : value Lazy.t IntMap.t; + file_keys : Common.file_keys; get_object_prototype : 'a . context -> (int * 'a) list -> vprototype * (int * 'a) list; (* eval *) toplevel : value; @@ -409,12 +410,12 @@ let no_debug = { debug_pos = null_pos; } -let create_env_info static pfile kind capture_infos num_locals num_captures = +let create_env_info static pfile pfile_key kind capture_infos num_locals num_captures = let info = { static = static; kind = kind; pfile = hash pfile; - pfile_unique = hash (Path.UniqueKey.to_string (Path.UniqueKey.create pfile)); + pfile_unique = hash (Path.UniqueKey.to_string pfile_key); capture_infos = capture_infos; num_locals = num_locals; num_captures = num_captures; diff --git a/src/macro/eval/evalDebugMisc.ml b/src/macro/eval/evalDebugMisc.ml index 3b350e4db2f..7182cd6b5b7 100644 --- a/src/macro/eval/evalDebugMisc.ml +++ b/src/macro/eval/evalDebugMisc.ml @@ -43,7 +43,7 @@ let iter_breakpoints ctx f = ) ctx.debug.breakpoints let add_breakpoint ctx file line column condition = - let hash = hash (Path.UniqueKey.to_string (Path.UniqueKey.create (Common.find_file (ctx.curapi.get_com()) file))) in + let hash = hash (Path.UniqueKey.to_string (ctx.file_keys#get (Common.find_file (ctx.curapi.get_com()) file))) in let h = try Hashtbl.find ctx.debug.breakpoints hash with Not_found -> @@ -56,7 +56,7 @@ let add_breakpoint ctx file line column condition = breakpoint let delete_breakpoint ctx file line = - let hash = hash (Path.UniqueKey.to_string (Path.UniqueKey.create (Common.find_file (ctx.curapi.get_com()) file))) in + let hash = hash (Path.UniqueKey.to_string (ctx.file_keys#get (Common.find_file (ctx.curapi.get_com()) file))) in let h = Hashtbl.find ctx.debug.breakpoints hash in Hashtbl.remove h line diff --git a/src/macro/eval/evalDebugSocket.ml b/src/macro/eval/evalDebugSocket.ml index c097712b019..4fc141af79f 100644 --- a/src/macro/eval/evalDebugSocket.ml +++ b/src/macro/eval/evalDebugSocket.ml @@ -630,7 +630,7 @@ let handler = let file = hctx.jsonrpc#get_string_param "file" in let bps = hctx.jsonrpc#get_array_param "breakpoints" in let bps = List.map (parse_breakpoint hctx) bps in - let hash = hash (Path.UniqueKey.to_string (Path.UniqueKey.create (Common.find_file (hctx.ctx.curapi.get_com()) file))) in + let hash = hash (Path.UniqueKey.to_string (hctx.ctx.file_keys#get (Common.find_file (hctx.ctx.curapi.get_com()) file))) in let h = try let h = Hashtbl.find hctx.ctx.debug.breakpoints hash in diff --git a/src/macro/eval/evalJit.ml b/src/macro/eval/evalJit.ml index 9b0194b3075..fae6177eff3 100644 --- a/src/macro/eval/evalJit.ml +++ b/src/macro/eval/evalJit.ml @@ -690,7 +690,7 @@ and jit_tfunction jit static pos tf = fl,exec and get_env_creation jit static file info = - create_env_info static file info jit.capture_infos jit.max_num_locals (Hashtbl.length jit.captures) + create_env_info static file (jit.ctx.file_keys#get file) info jit.capture_infos jit.max_num_locals (Hashtbl.length jit.captures) let jit_timer ctx f = Std.finally (Timer.timer [(if ctx.is_macro then "macro" else "interp");"jit"]) f () diff --git a/src/macro/eval/evalMain.ml b/src/macro/eval/evalMain.ml index 886b5a0ee9b..929d17a5182 100644 --- a/src/macro/eval/evalMain.ml +++ b/src/macro/eval/evalMain.ml @@ -116,6 +116,7 @@ let create com api is_macro = static_prototypes = new static_prototypes; instance_prototypes = IntMap.empty; constructors = IntMap.empty; + file_keys = com.file_keys; get_object_prototype = get_object_prototype; (* eval *) toplevel = vobject { @@ -156,7 +157,7 @@ let call_path ctx path f vl api = let vtype = get_static_prototype_as_value ctx (path_hash path) api.pos in let vfield = field vtype (hash f) in let p = api.pos in - let info = create_env_info true p.pfile EKEntrypoint (Hashtbl.create 0) 0 0 in + let info = create_env_info true p.pfile (ctx.file_keys#get p.pfile) EKEntrypoint (Hashtbl.create 0) 0 0 in let env = push_environment ctx info in env.env_leave_pmin <- p.pmin; env.env_leave_pmax <- p.pmax; diff --git a/src/macro/eval/evalPrototype.ml b/src/macro/eval/evalPrototype.ml index f797bcbd769..e9d3d07ec2c 100644 --- a/src/macro/eval/evalPrototype.ml +++ b/src/macro/eval/evalPrototype.ml @@ -33,7 +33,7 @@ let eval_expr ctx kind e = catch_exceptions ctx (fun () -> let jit,f = jit_expr ctx e in let num_captures = Hashtbl.length jit.captures in - let info = create_env_info true e.epos.pfile kind jit.capture_infos jit.max_num_locals num_captures in + let info = create_env_info true e.epos.pfile (ctx.file_keys#get e.epos.pfile) kind jit.capture_infos jit.max_num_locals num_captures in let env = push_environment ctx info in Std.finally (fun _ -> pop_environment ctx env) f env ) e.Type.epos diff --git a/src/macro/macroApi.ml b/src/macro/macroApi.ml index c69ba67b17b..bd31eba66ce 100644 --- a/src/macro/macroApi.ml +++ b/src/macro/macroApi.ml @@ -1532,8 +1532,9 @@ let macro_api ccom get_api = let dfile = display_pos#get.pfile in dfile = p.pfile || ( + let com = ccom() in (Filename.is_relative p.pfile || Filename.is_relative dfile) - && (Path.UniqueKey.create dfile = Path.UniqueKey.create p.pfile) + && (com.file_keys#get dfile = com.file_keys#get p.pfile) ) in vbool (display_pos#enclosed_in p && same_file()) @@ -1930,9 +1931,10 @@ let macro_api ccom get_api = ); "server_invalidate_files", vfun1 (fun a -> let cs = match CompilationServer.get() with Some cs -> cs | None -> failwith "compilation server not running" in + let com = ccom() in List.iter (fun v -> let s = decode_string v in - let s = Path.UniqueKey.create s in + let s = com.file_keys#get s in cs#taint_modules s; cs#remove_files s; ) (decode_array a); diff --git a/src/syntax/parserEntry.ml b/src/syntax/parserEntry.ml index 8389f5cf6f7..e3188616da6 100644 --- a/src/syntax/parserEntry.ml +++ b/src/syntax/parserEntry.ml @@ -213,7 +213,7 @@ let parse entry ctx code file = let old_macro = !in_macro in code_ref := code; in_display := display_position#get <> null_pos; - in_display_file := !in_display && display_position#is_in_file file; + in_display_file := !in_display && display_position#is_in_file (Path.UniqueKey.create file); syntax_errors := []; let restore = (fun () -> diff --git a/src/typing/typeload.ml b/src/typing/typeload.ml index fc9e4146cd1..46badca2dfb 100644 --- a/src/typing/typeload.ml +++ b/src/typing/typeload.ml @@ -621,7 +621,7 @@ and load_complex_type ctx allow_display (t,pn) = try load_complex_type' ctx allow_display (t,pn) with Error(Module_not_found(([],name)),p) as exc -> - if Diagnostics.is_diagnostics_run p then begin + if Diagnostics.is_diagnostics_run ctx.com p then begin delay ctx PForce (fun () -> DisplayToplevel.handle_unresolved_identifier ctx name p true); t_dynamic end else if ctx.com.display.dms_display && not (DisplayPosition.display_position#enclosed_in pn) then diff --git a/src/typing/typeloadCheck.ml b/src/typing/typeloadCheck.ml index aeaef53f53b..498e9068d6d 100644 --- a/src/typing/typeloadCheck.ml +++ b/src/typing/typeloadCheck.ml @@ -515,7 +515,7 @@ module Inheritance = struct in Some (check_herit t is_extends p) with Error(Module_not_found(([],name)),p) when ctx.com.display.dms_kind <> DMNone -> - if Diagnostics.is_diagnostics_run p then DisplayToplevel.handle_unresolved_identifier ctx name p true; + if Diagnostics.is_diagnostics_run ctx.com p then DisplayToplevel.handle_unresolved_identifier ctx name p true; None ) herits in fl diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index 2c8b7499b9f..bd9c7cc377e 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -468,7 +468,7 @@ let init_module_type ctx context_init (decl,p) = if Filename.basename p.pfile <> "import.hx" then ImportHandling.add_import_position ctx p path; in let check_path_display path p = - if DisplayPosition.display_position#is_in_file p.pfile then DisplayPath.handle_path_display ctx path p + if DisplayPosition.display_position#is_in_file (ctx.com.file_keys#get p.pfile) then DisplayPath.handle_path_display ctx path p in let init_import path mode = check_path_display path p; @@ -948,7 +948,7 @@ let type_types_into_module ctx m tdecls p = wildcard_packages = []; module_imports = []; }; - is_display_file = (ctx.com.display.dms_kind <> DMNone && DisplayPosition.display_position#is_in_file m.m_extra.m_file); + is_display_file = (ctx.com.display.dms_kind <> DMNone && DisplayPosition.display_position#is_in_file (m.m_extra.m_file_key())); bypass_accessor = 0; meta = []; this_stack = []; diff --git a/src/typing/typeloadParse.ml b/src/typing/typeloadParse.ml index ab6a0f9a504..42d9f541a7d 100644 --- a/src/typing/typeloadParse.ml +++ b/src/typing/typeloadParse.ml @@ -47,7 +47,7 @@ let parse_file_from_lexbuf com file p lexbuf = in begin match !Parser.display_mode,parse_result with | DMModuleSymbols (Some ""),_ -> () - | DMModuleSymbols filter,(ParseSuccess(data,_,_)) when filter = None && DisplayPosition.display_position#is_in_file file -> + | DMModuleSymbols filter,(ParseSuccess(data,_,_)) when filter = None && DisplayPosition.display_position#is_in_file (com.file_keys#get file) -> let ds = DocumentSymbols.collect_module_symbols (filter = None) data in DisplayException.raise_module_symbols (DocumentSymbols.Printer.print_module_symbols com [file,ds] filter); | _ -> @@ -63,7 +63,7 @@ let parse_file_from_string com file p string = let current_stdin = ref None (* TODO: we're supposed to clear this at some point *) let parse_file com file p = - let use_stdin = (Common.defined com Define.DisplayStdin) && DisplayPosition.display_position#is_in_file file in + let use_stdin = (Common.defined com Define.DisplayStdin) && DisplayPosition.display_position#is_in_file (com.file_keys#get file) in if use_stdin then let s = match !current_stdin with @@ -112,8 +112,8 @@ let resolve_module_file com m remap p = (* if we try to load a std.xxxx class and resolve a real std file, the package name is not valid, ignore *) (match fst m with | "std" :: _ -> - let file_key = Path.UniqueKey.create file in - if List.exists (fun path -> Path.UniqueKey.starts_with file_key (Path.UniqueKey.create path)) com.std_path then raise Not_found; + let file_key = com.file_keys#get file in + if List.exists (fun path -> Path.UniqueKey.starts_with file_key (com.file_keys#get path)) com.std_path then raise Not_found; | _ -> ()); if !forbid then begin let parse_result = (!parse_hook) com file p in diff --git a/src/typing/typer.ml b/src/typing/typer.ml index 1e330759c0d..8019b970893 100644 --- a/src/typing/typer.ml +++ b/src/typing/typer.ml @@ -156,7 +156,7 @@ let maybe_type_against_enum ctx f with_type iscall p = f() let check_error ctx err p = match err with - | Module_not_found ([],name) when Diagnostics.is_diagnostics_run p -> + | Module_not_found ([],name) when Diagnostics.is_diagnostics_run ctx.com p -> DisplayToplevel.handle_unresolved_identifier ctx name p true | _ -> display_error ctx (error_msg err) p From 6aff99b869807348684832b69a7d47b4ae3ade4d Mon Sep 17 00:00:00 2001 From: Aleksandr Kuzmenko Date: Fri, 5 Jun 2020 11:48:26 +0300 Subject: [PATCH 3/3] UniqueKey.lazy_t & api --- src/codegen/codegen.ml | 11 +++++----- src/compiler/server.ml | 13 ++++++----- src/compiler/serverMessage.ml | 2 +- src/context/compilationServer.ml | 2 +- src/context/display/displayPath.ml | 2 +- src/core/json/genjson.ml | 2 +- src/core/path.ml | 35 ++++++++++++++++++++++++++++++ src/core/tFunctions.ml | 11 +--------- src/core/tPrinting.ml | 2 +- src/core/tType.ml | 3 +-- src/macro/eval/evalPrototype.ml | 2 +- src/optimization/dce.ml | 4 ++-- src/typing/macroContext.ml | 4 ++-- src/typing/typeloadModule.ml | 4 ++-- 14 files changed, 62 insertions(+), 35 deletions(-) diff --git a/src/codegen/codegen.ml b/src/codegen/codegen.ml index a637addeffd..070a76354dd 100644 --- a/src/codegen/codegen.ml +++ b/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() diff --git a/src/compiler/server.ml b/src/compiler/server.ml index 68186f2712a..326d9e2356a 100644 --- a/src/compiler/server.ml +++ b/src/compiler/server.ml @@ -331,7 +331,7 @@ let check_module sctx ctx m p = match load m.m_path p with | None -> loop l | Some _ -> - if com.file_keys#get file <> m.m_extra.m_file_key() 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 (m.m_extra.m_file_key()); + 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 diff --git a/src/compiler/serverMessage.ml b/src/compiler/serverMessage.ml index c9af325d36e..951008000c1 100644 --- a/src/compiler/serverMessage.ml +++ b/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") diff --git a/src/context/compilationServer.ml b/src/context/compilationServer.ml index 2e277eeaecd..b9df0d71e1c 100644 --- a/src/context/compilationServer.ml +++ b/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 m.m_extra.m_file_key() = 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 diff --git a/src/context/display/displayPath.ml b/src/context/display/displayPath.ml index 21179e69b74..47a6cc4ff51 100644 --- a/src/context/display/displayPath.ml +++ b/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 diff --git a/src/core/json/genjson.ml b/src/core/json/genjson.ml index ec0cfeb3363..d0d8bb60738 100644 --- a/src/core/json/genjson.ml +++ b/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); diff --git a/src/core/path.ml b/src/core/path.ml index 480f204d406..9872830ecb6 100644 --- a/src/core/path.ml +++ b/src/core/path.ml @@ -171,12 +171,29 @@ let get_real_path = get_full_path module UniqueKey : sig + (** + Stores a unique key for a file path. + *) type t + (** + Stores an original file path along with a lazily-calculated key. + *) + type lazy_t (** Returns absolute path guaranteed to be the same for different letter case. Use where equality comparison is required, lowercases the path on Windows *) val create : string -> t + + val create_lazy : string -> lazy_t + (** + Calculates a key or retrieve a cached key. + *) + val lazy_key : lazy_t -> t + (** + Returns original path, which was used to create `lazy_t` + *) + val lazy_path : lazy_t -> string (** Check if the first key starts with the second key *) @@ -190,12 +207,30 @@ end = struct type t = string + type lazy_t = string * string option ref + + (* type file_key *) + let create = if Globals.is_windows then (fun f -> String.lowercase (get_full_path f)) else get_full_path + let create_lazy f = + (f, ref None) + + let lazy_key l = + match l with + | f,{ contents = Some key } -> key + | f,k -> + let key = create f in + k := Some key; + key + + let lazy_path l = + fst l + let starts_with subj start = ExtString.String.starts_with subj start diff --git a/src/core/tFunctions.ml b/src/core/tFunctions.ml index d582f9f8402..48a191b771e 100644 --- a/src/core/tFunctions.ml +++ b/src/core/tFunctions.ml @@ -114,17 +114,8 @@ let mk_class m path pos name_pos = } let module_extra file sign time kind policy = - let file_key = ref None in { - m_file = file; - m_file_key = (fun () -> - match !file_key with - | Some key -> key - | None -> - let key = Path.UniqueKey.create file in - file_key := Some key; - key - ); + m_file = Path.UniqueKey.create_lazy file; m_sign = sign; m_display = { m_inline_calls = []; diff --git a/src/core/tPrinting.ml b/src/core/tPrinting.ml index cf1230b0642..f934dfb1576 100644 --- a/src/core/tPrinting.ml +++ b/src/core/tPrinting.ml @@ -605,7 +605,7 @@ module Printer = struct let s_module_def_extra tabs me = s_record_fields tabs [ - "m_file",me.m_file; + "m_file",Path.UniqueKey.lazy_path me.m_file; "m_sign",me.m_sign; "m_time",string_of_float me.m_time; "m_dirty",s_opt s_type_path me.m_dirty; diff --git a/src/core/tType.ml b/src/core/tType.ml index ecaa8600036..127fbc61b3e 100644 --- a/src/core/tType.ml +++ b/src/core/tType.ml @@ -323,8 +323,7 @@ and module_def_display = { } and module_def_extra = { - m_file : string; - m_file_key : unit -> Path.UniqueKey.t; + m_file : Path.UniqueKey.lazy_t; m_sign : string; m_display : module_def_display; mutable m_check_policy : module_check_policy list; diff --git a/src/macro/eval/evalPrototype.ml b/src/macro/eval/evalPrototype.ml index e9d3d07ec2c..2db1813d32b 100644 --- a/src/macro/eval/evalPrototype.ml +++ b/src/macro/eval/evalPrototype.ml @@ -312,7 +312,7 @@ let add_types ctx types ready = ready mt; ctx.type_cache <- IntMap.add key mt ctx.type_cache; if ctx.debug.support_debugger then begin - let file_key = hash inf.mt_module.m_extra.m_file in + let file_key = hash (Path.UniqueKey.lazy_path inf.mt_module.m_extra.m_file) in if not (Hashtbl.mem ctx.debug.breakpoints file_key) then begin Hashtbl.add ctx.debug.breakpoints file_key (Hashtbl.create 0) end diff --git a/src/optimization/dce.ml b/src/optimization/dce.ml index 6c5bd41eb3e..bab09260682 100644 --- a/src/optimization/dce.ml +++ b/src/optimization/dce.ml @@ -83,7 +83,7 @@ let keep_metas = [Meta.Keep;Meta.Expose] (* check if a class is kept entirely *) let keep_whole_class dce c = Meta.has_one_of keep_metas c.cl_meta - || not (dce.full || is_std_file dce c.cl_module.m_extra.m_file || has_meta Meta.Dce c.cl_meta) + || not (dce.full || is_std_file dce (Path.UniqueKey.lazy_path c.cl_module.m_extra.m_file) || has_meta Meta.Dce c.cl_meta) || super_forces_keep c || (match c with | { cl_path = ([],("Math"|"Array"))} when dce.com.platform = Js -> false @@ -95,7 +95,7 @@ let keep_whole_class dce c = let keep_whole_enum dce en = Meta.has_one_of keep_metas en.e_meta - || not (dce.full || is_std_file dce en.e_module.m_extra.m_file || has_meta Meta.Dce en.e_meta) + || not (dce.full || is_std_file dce (Path.UniqueKey.lazy_path en.e_module.m_extra.m_file) || has_meta Meta.Dce en.e_meta) let mk_used_meta pos = Meta.Used,[],(mk_zero_range_pos pos) diff --git a/src/typing/macroContext.ml b/src/typing/macroContext.ml index 2a6c7930791..c053737d52f 100644 --- a/src/typing/macroContext.ml +++ b/src/typing/macroContext.ml @@ -307,7 +307,7 @@ let make_macro_api ctx p = in let add is_macro ctx = let mdep = Option.map_default (fun s -> TypeloadModule.load_module ctx (parse_path s) pos) ctx.m.curmod mdep in - let mnew = TypeloadModule.type_module ctx ~dont_check_path:(has_native_meta) m mdep.m_extra.m_file [tdef,pos] pos in + let mnew = TypeloadModule.type_module ctx ~dont_check_path:(has_native_meta) m (Path.UniqueKey.lazy_path mdep.m_extra.m_file) [tdef,pos] pos in mnew.m_extra.m_kind <- if is_macro then MMacro else MFake; add_dependency mnew mdep; in @@ -336,7 +336,7 @@ let make_macro_api ctx p = let m = Hashtbl.find ctx.g.modules mpath in ignore(TypeloadModule.type_types_into_module ctx m types pos) with Not_found -> - let mnew = TypeloadModule.type_module ctx mpath ctx.m.curmod.m_extra.m_file types pos in + let mnew = TypeloadModule.type_module ctx mpath (Path.UniqueKey.lazy_path ctx.m.curmod.m_extra.m_file) types pos in mnew.m_extra.m_kind <- MFake; add_dependency mnew ctx.m.curmod; end diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index bd9c7cc377e..cd08eaf3ead 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -948,7 +948,7 @@ let type_types_into_module ctx m tdecls p = wildcard_packages = []; module_imports = []; }; - is_display_file = (ctx.com.display.dms_kind <> DMNone && DisplayPosition.display_position#is_in_file (m.m_extra.m_file_key())); + is_display_file = (ctx.com.display.dms_kind <> DMNone && DisplayPosition.display_position#is_in_file (Path.UniqueKey.lazy_key m.m_extra.m_file)); bypass_accessor = 0; meta = []; this_stack = []; @@ -983,7 +983,7 @@ let type_types_into_module ctx m tdecls p = ctx let handle_import_hx ctx m decls p = - let path_split = match List.rev (Path.get_path_parts m.m_extra.m_file) with + let path_split = match List.rev (Path.get_path_parts (Path.UniqueKey.lazy_path m.m_extra.m_file)) with | [] -> [] | _ :: l -> l in