Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Remove hard module references in m_deps #11281

Merged
merged 4 commits into from
Jul 18, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion src/codegen/codegen.ml
Original file line number Diff line number Diff line change
Expand Up @@ -387,7 +387,8 @@ module Dump = struct
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 _ m2 ->
PMap.iter (fun _ (sign,mpath) ->
let m2 = (com.cs#get_context sign)#find_module mpath in
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
Expand Down
9 changes: 7 additions & 2 deletions src/compiler/server.ml
Original file line number Diff line number Diff line change
Expand Up @@ -307,7 +307,9 @@ let check_module sctx ctx m p =
end
in
let check_dependencies () =
PMap.iter (fun _ m2 -> match check m2 with
PMap.iter (fun _ (sign,mpath) ->
let m2 = (com.cs#get_context sign)#find_module mpath in
match check m2 with
| None -> ()
| Some reason -> raise (Dirty (DependencyDirty(m2.m_path,reason)))
) m.m_extra.m_deps;
Expand Down Expand Up @@ -407,7 +409,10 @@ 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 _ m2 -> add_modules (tabs ^ " ") m0 m2) m.m_extra.m_deps
PMap.iter (fun _ (sign,mpath) ->
let m2 = (com.cs#get_context sign)#find_module mpath in
add_modules (tabs ^ " ") m0 m2
) m.m_extra.m_deps
)
end
in
Expand Down
5 changes: 3 additions & 2 deletions src/context/display/displayJson.ml
Original file line number Diff line number Diff line change
Expand Up @@ -182,13 +182,14 @@ let handler =
"server/module", (fun hctx ->
let sign = Digest.from_hex (hctx.jsonrpc#get_string_param "signature") in
let path = Path.parse_path (hctx.jsonrpc#get_string_param "path") in
let cc = hctx.display#get_cs#get_context sign in
let cs = hctx.display#get_cs in
let cc = cs#get_context sign in
let m = try
cc#find_module path
with Not_found ->
hctx.send_error [jstring "No such module"]
in
hctx.send_result (generate_module cc m)
hctx.send_result (generate_module cs cc m)
);
"server/type", (fun hctx ->
let sign = Digest.from_hex (hctx.jsonrpc#get_string_param "signature") in
Expand Down
13 changes: 8 additions & 5 deletions src/context/memory.ml
Original file line number Diff line number Diff line change
Expand Up @@ -33,12 +33,14 @@ let update_module_type_deps deps md =
) md.m_types;
!deps

let rec scan_module_deps 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 _ m -> scan_module_deps m h) m.m_extra.m_deps
PMap.iter (fun _ (sign,mpath) ->
let m = (cs#get_context sign)#find_module mpath in
scan_module_deps cs m h) m.m_extra.m_deps
end

let module_sign key md =
Expand All @@ -61,7 +63,7 @@ let get_out out =

let get_module_memory cs all_modules m =
let mdeps = Hashtbl.create 0 in
scan_module_deps 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 ->
Expand Down Expand Up @@ -272,8 +274,9 @@ let display_memory com =
());
if verbose then begin
print (Printf.sprintf " %d total deps" (List.length deps));
PMap.iter (fun _ md ->
print (Printf.sprintf " dep %s%s" (s_type_path md.m_path) (module_sign key md));
PMap.iter (fun _ (sign,mpath) ->
let md = (com.cs#get_context sign)#find_module mpath in
print (Printf.sprintf " dep %s%s" (s_type_path mpath) (module_sign key md));
) m.m_extra.m_deps;
end;
flush stdout
Expand Down
12 changes: 7 additions & 5 deletions src/core/json/genjson.ml
Original file line number Diff line number Diff line change
Expand Up @@ -707,7 +707,7 @@ let generate_module_type ctx mt =

(* module *)

let generate_module cc m =
let generate_module cs cc m =
jobject [
"id",jint m.m_id;
"path",generate_module_path m.m_path;
Expand All @@ -718,10 +718,12 @@ let generate_module cc m =
| MSGood -> "Good"
| MSBad reason -> Printer.s_module_skip_reason reason
| MSUnknown -> "Unknown");
"dependencies",jarray (PMap.fold (fun m acc -> (jobject [
"path",jstring (s_type_path m.m_path);
"sign",jstring (Digest.to_hex m.m_extra.m_sign);
]) :: acc) m.m_extra.m_deps []);
"dependencies",jarray (PMap.fold (fun (sign,mpath) acc ->
(jobject [
"path",jstring (s_type_path mpath);
"sign",jstring (Digest.to_hex ((cs#get_context sign)#find_module mpath).m_extra.m_sign);
]) :: acc
) m.m_extra.m_deps []);
"dependents",jarray (List.map (fun m -> (jobject [
"path",jstring (s_type_path m.m_path);
"sign",jstring (Digest.to_hex m.m_extra.m_sign);
Expand Down
4 changes: 2 additions & 2 deletions src/core/tFunctions.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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.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
Expand Down
2 changes: 1 addition & 1 deletion src/core/tPrinting.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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.m_path) 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 *)
Expand Down
2 changes: 1 addition & 1 deletion src/core/tType.ml
Original file line number Diff line number Diff line change
Expand Up @@ -390,7 +390,7 @@ and module_def_extra = {
mutable m_added : int;
mutable m_checked : int;
mutable m_processed : int;
mutable m_deps : (int,module_def) 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;
Expand Down