Downstreams for renaming

.depend

@@ -744,6 +744,7 @@ typing/datarepr.cmx : \
     parsing/asttypes.cmi \
     typing/datarepr.cmi
 typing/datarepr.cmi : \
+    parsing/unit_info.cmi \
     typing/types.cmi \
     typing/path.cmi \
     typing/ident.cmi \
@@ -1449,20 +1450,23 @@ typing/printtyped.cmx : \
 typing/printtyped.cmi : \
     typing/typedtree.cmi
 typing/shape.cmo : \
+    parsing/unit_info.cmi \
     typing/path.cmi \
     utils/misc.cmi \
     utils/identifiable.cmi \
     typing/ident.cmi \
     utils/compilation_unit.cmi \
     typing/shape.cmi
 typing/shape.cmx : \
+    parsing/unit_info.cmx \
     typing/path.cmx \
     utils/misc.cmx \
     utils/identifiable.cmx \
     typing/ident.cmx \
     utils/compilation_unit.cmx \
     typing/shape.cmi
 typing/shape.cmi : \
+    parsing/unit_info.cmi \
     typing/path.cmi \
     utils/identifiable.cmi \
     typing/ident.cmi \

Changes

@@ -661,6 +661,15 @@ OCaml 5.2.0
   usages index
   (Ulysse Gérard, review by Gabriel Scherer and Nathanaëlle Courant)
 
+- #13286: Distinguish unique identifiers `Shape.Uid.t` according to their
+  provenance: either an implementation or an interface.
+  (Ulysse Gérard, review by Florian Angeletti and Leo White)
+
+- #13308: keep track of relations between declaration in the cmt files. This is
+  useful information for external tools for navigation and analysis purposis.
+  (Ulysse Gérard, Florian Angeletti, review by Florian Angeletti and Gabriel
+  Scherer)
+
 ### Build system:
 
 - #12198, #12321, #12586, #12616, #12706, #13048: continue the merge of the

bytecomp/bytepackager.ml

@@ -355,7 +355,7 @@ let package_files ~ppf_dump initial_env files targetfile =
     CU.create (CU.Prefix.from_clflags ())
       (Unit_info.Artifact.modname target |> CU.Name.of_string)
   in
-  CU.set_current (Some comp_unit);
+  CU.set_current (Some (comp_unit, Impl));
   Misc.try_finally (fun () ->
       let coercion =
         Typemod.package_units initial_env files (Unit_info.companion_cmi target)

driver/compile.ml

@@ -22,7 +22,7 @@ let with_info =
   Compile_common.with_info ~native:false ~tool_name
 
 let interface ~source_file ~output_prefix =
-  with_info ~source_file ~output_prefix ~dump_ext:"cmi"
+  with_info ~source_file ~kind:Intf ~output_prefix ~dump_ext:"cmi"
     ~compilation_unit:Inferred_from_output_prefix
   @@ fun info ->
   Compile_common.interface
@@ -101,7 +101,8 @@ let starting_point_of_compiler_pass start_from =
 let implementation_aux ~start_from ~source_file ~output_prefix
     ~keep_symbol_tables:_
     ~(compilation_unit : Compile_common.compilation_unit_or_inferred) =
-  with_info ~source_file ~output_prefix ~dump_ext:"cmo" ~compilation_unit
+  with_info ~source_file ~kind:Impl ~output_prefix
+    ~dump_ext:"cmo" ~compilation_unit
   @@ fun info ->
   match start_from with
   | Parsing ->

driver/compile_common.ml

@@ -28,11 +28,11 @@ type compilation_unit_or_inferred =
   | Exactly of Compilation_unit.t
   | Inferred_from_output_prefix
 
-let with_info ~native ~tool_name ~source_file ~output_prefix
+let with_info ~native ~tool_name ~source_file ~kind ~output_prefix
       ~compilation_unit ~dump_ext k =
   Compmisc.init_path ();
   Compmisc.init_parameters ();
-  let target = Unit_info.make ~source_file output_prefix in
+  let target = Unit_info.make ~source_file output_prefix  in
   let compilation_unit =
     match compilation_unit with
     | Exactly compilation_unit -> compilation_unit
@@ -42,8 +42,8 @@ let with_info ~native ~tool_name ~source_file ~output_prefix
         Compilation_unit.create for_pack_prefix
           (module_name |> Compilation_unit.Name.of_string)
   in
-  Compilation_unit.set_current (Some compilation_unit);
-  Env.set_unit_name (Some compilation_unit);
+  Compilation_unit.set_current (Some (compilation_unit, kind));
+  Env.set_unit_name (Some (compilation_unit, kind));
   let env = Compmisc.initial_env() in
   let dump_file = String.concat "." [output_prefix; dump_ext] in
   Compmisc.with_ppf_dump ~file_prefix:dump_file (fun ppf_dump ->
@@ -85,7 +85,7 @@ let typecheck_intf info ast =
         Format.(fprintf std_formatter) "%a@."
           (Printtyp.printed_signature (Unit_info.source_file info.target))
           sg);
-  ignore (Includemod.signatures info.env ~mark:Mark_both
+  ignore (Includemod.signatures info.env ~mark:true
     ~modes:(Legacy None) sg sg);
   Typecore.force_delayed_checks ();
   Builtin_attributes.warn_unused ();

driver/compile_common.mli

@@ -34,6 +34,7 @@ val with_info :
   native:bool ->
   tool_name:string ->
   source_file:string ->
+  kind:Compilation_unit.intf_or_impl ->
   output_prefix:string ->
   compilation_unit:compilation_unit_or_inferred ->
   dump_ext:string ->

driver/optcompile.ml

@@ -23,7 +23,7 @@ let tool_name = "ocamlopt"
 let with_info = Compile_common.with_info ~native:true ~tool_name
 
 let interface ~source_file ~output_prefix =
-  with_info ~source_file ~output_prefix ~dump_ext:"cmi"
+  with_info ~source_file ~kind:Intf ~output_prefix ~dump_ext:"cmi"
     ~compilation_unit:Inferred_from_output_prefix
   @@ fun info ->
   Compile_common.interface
@@ -115,7 +115,8 @@ let implementation_aux unix ~(flambda2 : flambda2) ~start_from
   let pipeline : Asmgen.pipeline =
     Direct_to_cmm (flambda2 ~keep_symbol_tables)
   in
-  with_info ~source_file ~output_prefix ~dump_ext:"cmx" ~compilation_unit
+  with_info ~source_file ~kind:Impl ~output_prefix
+    ~dump_ext:"cmx" ~compilation_unit
   @@ fun info ->
   if !Flambda_backend_flags.internal_assembler then
       Emitaux.binary_backend_available := true;

file_formats/cms_format.ml

@@ -17,6 +17,8 @@
 
 (** cms and cmsi files format. *)
 
+module Uid = Shape.Uid
+
 let read_magic_number ic =
   let len_magic_number = String.length Config.cms_magic_number in
   really_input_string ic len_magic_number
@@ -32,7 +34,9 @@ type cms_infos = {
   cms_uid_to_attributes : Parsetree.attributes Shape.Uid.Tbl.t;
   cms_impl_shape : Shape.t option; (* None for mli *)
   cms_ident_occurrences :
-    (Longident.t Location.loc * Shape_reduce.result) array
+    (Longident.t Location.loc * Shape_reduce.result) array;
+  cms_declaration_dependencies :
+    (Cmt_format.dependency_kind * Uid.t * Uid.t) list;
 }
 
 type error =
@@ -114,6 +118,9 @@ let save_cms target modname binary_annots initial_env shape =
         let cms_uid_to_loc, cms_uid_to_attributes =
           uid_tables_of_binary_annots binary_annots
         in
+        let cms_declaration_dependencies =
+          Cmt_format.get_declaration_dependencies ()
+        in
         let cms =
           {
             cms_modname = modname;
@@ -125,7 +132,8 @@ let save_cms target modname binary_annots initial_env shape =
             cms_uid_to_loc;
             cms_uid_to_attributes;
             cms_impl_shape = shape;
-            cms_ident_occurrences
+            cms_ident_occurrences;
+            cms_declaration_dependencies;
           }
         in
         output_cms oc cms)

file_formats/cms_format.mli

@@ -17,6 +17,8 @@
 
 (** cms and cmsi files format. *)
 
+module Uid = Shape.Uid
+
 type cms_infos = {
   cms_modname : Compilation_unit.t;
   cms_comments : (string * Location.t) list;
@@ -28,7 +30,9 @@ type cms_infos = {
   cms_uid_to_attributes : Parsetree.attributes Shape.Uid.Tbl.t;
   cms_impl_shape : Shape.t option; (* None for mli *)
   cms_ident_occurrences :
-    (Longident.t Location.loc * Shape_reduce.result) array
+    (Longident.t Location.loc * Shape_reduce.result) array;
+  cms_declaration_dependencies :
+    (Cmt_format.dependency_kind * Uid.t * Uid.t) list;
 }
 
 type error =

file_formats/cmt_format.ml

@@ -45,11 +45,11 @@ and binary_part =
   | Partial_signature_item of signature_item
   | Partial_module_type of module_type
 
+type dependency_kind =  Definition_to_declaration | Declaration_to_declaration
 type cmt_infos = {
   cmt_modname : Compilation_unit.t;
   cmt_annots : binary_annots;
-  cmt_value_dependencies :
-    (Types.value_description * Types.value_description) list;
+  cmt_declaration_dependencies : (dependency_kind * Uid.t * Uid.t) list;
   cmt_comments : (string * Location.t) list;
   cmt_args : string array;
   cmt_sourcefile : string option;
@@ -452,19 +452,19 @@ let read_cmi filename =
     | Some cmi, _ -> cmi
 
 let saved_types = ref []
-let value_deps = ref []
+let uids_deps : (dependency_kind * Uid.t * Uid.t) list ref = ref []
 
 let clear () =
   saved_types := [];
-  value_deps := []
+  uids_deps := []
 
 let add_saved_type b = saved_types := b :: !saved_types
 let get_saved_types () = !saved_types
 let set_saved_types l = saved_types := l
 
-let record_value_dependency vd1 vd2 =
-  if vd1.Types.val_loc <> vd2.Types.val_loc then
-    value_deps := (vd1, vd2) :: !value_deps
+let record_declaration_dependency (rk, uid1, uid2) =
+  if not (Uid.equal uid1 uid2) then
+    uids_deps := (rk, uid1, uid2) :: !uids_deps
 
 let save_cmt target cu binary_annots initial_env cmi shape =
   if !Clflags.binary_annotations && not !Clflags.print_types then begin
@@ -499,7 +499,7 @@ let save_cmt target cu binary_annots initial_env cmi shape =
          let cmt = {
            cmt_modname = cu;
            cmt_annots;
-           cmt_value_dependencies = !value_deps;
+           cmt_declaration_dependencies = !uids_deps;
            cmt_comments = Lexer.comments ();
            cmt_args = Sys.argv;
            cmt_sourcefile = sourcefile;
@@ -518,3 +518,5 @@ let save_cmt target cu binary_annots initial_env cmi shape =
          output_cmt oc cmt)
   end;
   clear ()
+
+let get_declaration_dependencies () = !uids_deps

file_formats/cmt_format.mli

@@ -48,11 +48,11 @@ and binary_part =
   | Partial_signature_item of signature_item
   | Partial_module_type of module_type
 
+type dependency_kind = Definition_to_declaration | Declaration_to_declaration
 type cmt_infos = {
   cmt_modname : Compilation_unit.t;
   cmt_annots : binary_annots;
-  cmt_value_dependencies :
-    (Types.value_description * Types.value_description) list;
+  cmt_declaration_dependencies : (dependency_kind * Uid.t * Uid.t) list;
   cmt_comments : (string * Location.t) list;
   cmt_args : string array;
   cmt_sourcefile : string option;
@@ -108,8 +108,7 @@ val add_saved_type : binary_part -> unit
 val get_saved_types : unit -> binary_part list
 val set_saved_types : binary_part list -> unit
 
-val record_value_dependency:
-  Types.value_description -> Types.value_description -> unit
+val record_declaration_dependency: dependency_kind * Uid.t * Uid.t -> unit
 
 val index_occurrences :
   binary_annots -> (Longident.t Location.loc * Shape_reduce.result) array
@@ -134,3 +133,6 @@ val need_to_clear_env : bool
   val read_signature : 'a -> string -> Types.signature * 'b list * 'c list
 
 *)
+
+val get_declaration_dependencies :
+  unit -> (dependency_kind * Uid.t * Uid.t) list

lambda/translprim.ml

@@ -1610,7 +1610,7 @@ let lambda_of_loc kind sloc =
     let module_name =
       match name with
       | None -> "//"^filename^"//"
-      | Some comp_unit ->
+      | Some (comp_unit, _) ->
         Compilation_unit.name_as_string comp_unit
     in
     Lconst (Const_immstring module_name)

middle_end/compilenv.ml

@@ -68,7 +68,7 @@ let current_unit =
 let reset compilation_unit =
   Infos_table.clear global_infos_table;
   Zero_alloc_info.reset cached_zero_alloc_info;
-  CU.set_current (Some compilation_unit);
+  CU.set_current (Some (compilation_unit, Impl));
   current_unit.ui_unit <- compilation_unit;
   current_unit.ui_defines <- [compilation_unit];
   current_unit.ui_arg_descr <- None;

middle_end/flambda2/cmx/flambda_cmx.ml

@@ -83,7 +83,7 @@ let all_predefined_exception_symbols () =
 
 let predefined_exception_typing_env () =
   let comp_unit = Compilation_unit.get_current () in
-  Compilation_unit.set_current (Some Compilation_unit.predef_exn);
+  Compilation_unit.set_current (Some (Compilation_unit.predef_exn, Impl));
   let typing_env =
     TE.Serializable.predefined_exceptions (all_predefined_exception_symbols ())
   in

middle_end/flambda2/cmx/flambda_cmx_format.ml

@@ -213,7 +213,7 @@ let merge t1_opt t2_opt =
 let print0 ~sections ~print_typing_env ~print_code ~print_offsets ppf t =
   Format.fprintf ppf "@[<hov>Original unit:@ %a@]@;" Compilation_unit.print
     t.original_compilation_unit;
-  Compilation_unit.set_current (Some t.original_compilation_unit);
+  Compilation_unit.set_current (Some (t.original_compilation_unit, Impl));
   let typing_env, code = import_typing_env_and_code0 ~sections t in
   if print_typing_env
   then

middle_end/flambda2/parser/parse_flambda.ml

@@ -154,7 +154,7 @@ let parse filename =
   |> Result.map (fun fexpr ->
          let comp_unit = make_compilation_unit ~extension:".fl" ~filename () in
          let old_comp_unit = Compilation_unit.get_current () in
-         Compilation_unit.set_current (Some comp_unit);
+         Compilation_unit.set_current (Some (comp_unit, Impl));
          let flambda = Fexpr_to_flambda.conv comp_unit fexpr in
          Compilation_unit.set_current old_comp_unit;
          flambda)

middle_end/flambda2/tests/api_tests/extension_meet.ml

@@ -188,5 +188,5 @@ let _ =
     let linkage_name = Compilation_unit.Name.of_string "camlTest" in
     Compilation_unit.create Compilation_unit.Prefix.empty linkage_name
   in
-  Compilation_unit.set_current (Some comp_unit);
+  Compilation_unit.set_current (Some (comp_unit, Impl));
   test_double_recursion ()

middle_end/flambda2/tests/meet_test.ml

@@ -260,7 +260,7 @@ let test_meet_bottom_after_alias () =
 
 let () =
   let comp_unit = "Meet_test" |> Compilation_unit.of_string in
-  Compilation_unit.set_current (Some comp_unit);
+  Compilation_unit.set_current (Some (comp_unit, Impl));
   Format.eprintf "MEET CHAINS WITH TWO VARS@\n@.";
   test_meet_chains_two_vars ();
   Format.eprintf "@.MEET CHAINS WITH THREE VARS@\n@.";

middle_end/flambda2/tests/tools/fldiff.ml

@@ -9,7 +9,7 @@ let _ =
     let modname1 =
       Parse_flambda.make_compilation_unit ~filename:file1 ~extension:".fl" ()
     in
-    Compilation_unit.set_current (Some modname1);
+    Compilation_unit.set_current (Some (modname1, Impl));
     Format.printf "%a@."
       (Compare.Comparison.print Flambda_unit.print)
       (Compare.flambda_units unit1 unit2)

middle_end/flambda2/tests/tools/flexpect.ml

@@ -35,7 +35,7 @@ end
 let run_expect_test ~get_module_info ~extension ~filename
     ({ before; after = expected } : Fexpr.expect_test_spec) : Test_outcome.t =
   let comp_unit = Parse_flambda.make_compilation_unit ~extension ~filename () in
-  Compilation_unit.set_current (Some comp_unit);
+  Compilation_unit.set_current (Some (comp_unit, Impl));
   let before_fl = Fexpr_to_flambda.conv comp_unit before in
   check_invariants before_fl;
   let cmx_loader = Flambda_cmx.create_loader ~get_module_info in

middle_end/flambda2/tests/tools/parseflambda.ml

@@ -15,7 +15,7 @@ let parse_flambda filename =
     let comp_unit =
       Parse_flambda.make_compilation_unit ~extension:".fl" ~filename ()
     in
-    Compilation_unit.set_current comp_unit;
+    Compilation_unit.set_current (Some (comp_unit, Impl));
     Format.printf "%a@.@." Print_fexpr.flambda_unit unit;
     let fl2 = Fexpr_to_flambda.conv comp_unit unit in
     Format.printf "flambda:@.%a@.@." Flambda_unit.print fl2;

middle_end/flambda2/tests/tools/roundtrip.ml

@@ -30,7 +30,7 @@ let () =
     in
     (* Need to get this right or the conversion will complain about binding
        non-local symbols *)
-    Compilation_unit.set_current (Some modname);
+    Compilation_unit.set_current (Some (modname, Impl));
     let unit =
       match Parse_flambda.parse file with
       | Ok unit -> unit