From 8935a14170afe8ce52cb8d99a0fe5e49a6864ebc Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Tue, 18 Jul 2023 13:04:30 +0200 Subject: [PATCH] [cache] use path + sign for module deps --- src/codegen/codegen.ml | 4 ++-- src/compiler/server.ml | 7 ++++--- src/context/memory.ml | 21 +++++++++++---------- src/core/json/genjson.ml | 2 +- src/core/tFunctions.ml | 4 ++-- src/core/tPrinting.ml | 2 +- src/core/tType.ml | 2 +- 7 files changed, 22 insertions(+), 20 deletions(-) diff --git a/src/codegen/codegen.ml b/src/codegen/codegen.ml index 2cbad944e2f..be792ac59a2 100644 --- a/src/codegen/codegen.ml +++ b/src/codegen/codegen.ml @@ -381,14 +381,14 @@ module Dump = struct | None -> platform_name_macro com | Some s -> s in - let cc = CommonCache.get_cache com in let dump_dependencies_path = [dump_path com;target_name;"dependencies"] in let buf,close = create_dumpfile [] dump_dependencies_path in 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" (Path.UniqueKey.lazy_path m.m_extra.m_file); - PMap.iter (fun _ mpath -> + PMap.iter (fun _ (sign,mpath) -> + let cc = com.cs#get_context sign in let m2 = cc#find_module mpath in let file = Path.UniqueKey.lazy_path m2.m_extra.m_file in print "\t%s\n" file; diff --git a/src/compiler/server.ml b/src/compiler/server.ml index b2bc76be13a..624d5b32395 100644 --- a/src/compiler/server.ml +++ b/src/compiler/server.ml @@ -307,7 +307,8 @@ let check_module sctx ctx m p = end in let check_dependencies () = - PMap.iter (fun _ mpath -> + PMap.iter (fun _ (sign,mpath) -> + let cc = com.cs#get_context sign in let m2 = cc#find_module mpath in match check m2 with | None -> () @@ -395,7 +396,6 @@ let check_module sctx ctx m p = context. *) let add_modules sctx ctx m p = let com = ctx.Typecore.com in - let cc = CommonCache.get_cache com in let rec add_modules tabs m0 m = if m.m_extra.m_added < ctx.com.compilation_step then begin (match m0.m_extra.m_kind, m.m_extra.m_kind with @@ -410,7 +410,8 @@ let add_modules sctx ctx m p = ) m.m_types; TypeloadModule.ModuleLevel.add_module ctx m p; PMap.iter (Hashtbl.replace com.resources) m.m_extra.m_binded_res; - PMap.iter (fun _ mpath -> + PMap.iter (fun _ (sign,mpath) -> + let cc = com.cs#get_context sign in let m2 = cc#find_module mpath in add_modules (tabs ^ " ") m0 m2 ) m.m_extra.m_deps diff --git a/src/context/memory.ml b/src/context/memory.ml index 4619b86c6ae..2bf999a941b 100644 --- a/src/context/memory.ml +++ b/src/context/memory.ml @@ -33,14 +33,15 @@ let update_module_type_deps deps md = ) md.m_types; !deps -let rec scan_module_deps cc m h = +let rec scan_module_deps cs m h = if Hashtbl.mem h m.m_id then () else begin Hashtbl.add h m.m_id m; - PMap.iter (fun _ mpath -> + PMap.iter (fun _ (sign,mpath) -> + let cc = cs#get_context sign in let m = cc#find_module mpath in - scan_module_deps cc m h) m.m_extra.m_deps + scan_module_deps cs m h) m.m_extra.m_deps end let module_sign key md = @@ -61,9 +62,9 @@ let collect_leaks m deps out = let get_out out = Obj.repr Common.memory_marker :: Obj.repr Typecore.memory_marker :: PMap.fold (fun m acc -> Obj.repr m :: acc) out [] -let get_module_memory cc all_modules m = +let get_module_memory cs all_modules m = let mdeps = Hashtbl.create 0 in - scan_module_deps cc m mdeps; + scan_module_deps cs m mdeps; let deps = ref [Obj.repr null_module] in let out = ref all_modules in let deps = Hashtbl.fold (fun _ md deps -> @@ -134,7 +135,7 @@ let get_memory_json (cs : CompilationCache.t) mreq = let cc = cs#get_context sign in let all_modules = List.fold_left (fun acc m -> PMap.add m.m_id m acc) PMap.empty cs#get_modules in let l = Hashtbl.fold (fun _ m acc -> - (m,(get_module_memory cc all_modules m)) :: acc + (m,(get_module_memory cs all_modules m)) :: acc ) cc#get_modules [] in let l = List.sort (fun (_,(size1,_)) (_,(size2,_)) -> compare size2 size1) l in let leaks = ref [] in @@ -173,7 +174,7 @@ let get_memory_json (cs : CompilationCache.t) mreq = let cc = cs#get_context sign in let m = cc#find_module path in let all_modules = List.fold_left (fun acc m -> PMap.add m.m_id m acc) PMap.empty cs#get_modules in - let _,(_,deps,out,_) = get_module_memory cc all_modules m in + let _,(_,deps,out,_) = get_module_memory cs all_modules m in let deps = update_module_type_deps deps m in let out = get_out out in let types = List.map (fun md -> @@ -239,7 +240,6 @@ let display_memory com = print ("Total Allocated Memory " ^ fmt_size (mem.Gc.heap_words * (Sys.word_size asr 8))); print ("Free Memory " ^ fmt_size (mem.Gc.free_words * (Sys.word_size asr 8))); let c = com.cs in - let cc = CommonCache.get_cache com in print ("Total cache size " ^ size c); (* print (" haxelib " ^ size c.c_haxelib); *) (* print (" parsed ast " ^ size c.c_files ^ " (" ^ string_of_int (Hashtbl.length c.c_files) ^ " files stored)"); *) @@ -247,7 +247,7 @@ let display_memory com = let module_list = c#get_modules in let all_modules = List.fold_left (fun acc m -> PMap.add m.m_id m acc) PMap.empty module_list in let modules = List.fold_left (fun acc m -> - let (size,r) = get_module_memory cc all_modules m in + let (size,r) = get_module_memory c all_modules m in (m,size,r) :: acc ) [] module_list in let cur_key = ref "" and tcount = ref 0 and mcount = ref 0 in @@ -275,7 +275,8 @@ let display_memory com = ()); if verbose then begin print (Printf.sprintf " %d total deps" (List.length deps)); - PMap.iter (fun _ mpath -> + PMap.iter (fun _ (sign,mpath) -> + let cc = c#get_context sign in let md = cc#find_module mpath in print (Printf.sprintf " dep %s%s" (s_type_path mpath) (module_sign key md)); ) m.m_extra.m_deps; diff --git a/src/core/json/genjson.ml b/src/core/json/genjson.ml index 89b3e812022..3b01177c232 100644 --- a/src/core/json/genjson.ml +++ b/src/core/json/genjson.ml @@ -718,7 +718,7 @@ let generate_module cc m = | MSGood -> "Good" | MSBad reason -> Printer.s_module_skip_reason reason | MSUnknown -> "Unknown"); - "dependencies",jarray (PMap.fold (fun mpath acc -> + "dependencies",jarray (PMap.fold (fun (_,mpath) acc -> let m = cc#find_module mpath in (jobject [ "path",jstring (s_type_path mpath); diff --git a/src/core/tFunctions.ml b/src/core/tFunctions.ml index 30c46ce6305..ff3540b08ef 100644 --- a/src/core/tFunctions.ml +++ b/src/core/tFunctions.ml @@ -233,8 +233,8 @@ let null_abstract = { } let add_dependency ?(skip_postprocess=false) m mdep = - if m != null_module && m != mdep then begin - m.m_extra.m_deps <- PMap.add mdep.m_id mdep.m_path m.m_extra.m_deps; + if m != null_module && (m.m_path != mdep.m_path || m.m_extra.m_sign != mdep.m_extra.m_sign) then begin + m.m_extra.m_deps <- PMap.add mdep.m_id (mdep.m_extra.m_sign, mdep.m_path) m.m_extra.m_deps; (* In case the module is cached, we'll have to run post-processing on it again (issue #10635) *) if not skip_postprocess then m.m_extra.m_processed <- 0 end diff --git a/src/core/tPrinting.ml b/src/core/tPrinting.ml index 6bc0a3c0799..fd4351ea0a2 100644 --- a/src/core/tPrinting.ml +++ b/src/core/tPrinting.ml @@ -605,7 +605,7 @@ module Printer = struct "m_cache_state",s_module_cache_state me.m_cache_state; "m_added",string_of_int me.m_added; "m_checked",string_of_int me.m_checked; - "m_deps",s_pmap string_of_int (fun m -> snd m) me.m_deps; + "m_deps",s_pmap string_of_int (fun (_,m) -> snd m) me.m_deps; "m_processed",string_of_int me.m_processed; "m_kind",s_module_kind me.m_kind; "m_binded_res",""; (* TODO *) diff --git a/src/core/tType.ml b/src/core/tType.ml index d3de13b0927..6ec5f025b21 100644 --- a/src/core/tType.ml +++ b/src/core/tType.ml @@ -390,7 +390,7 @@ and module_def_extra = { mutable m_added : int; mutable m_checked : int; mutable m_processed : int; - mutable m_deps : (int,path) PMap.t; + mutable m_deps : (int,(string (* sign *) * path)) PMap.t; mutable m_kind : module_kind; mutable m_binded_res : (string, string) PMap.t; mutable m_if_feature : (string *(tclass * tclass_field * bool)) list;