Use Global_module.Name.t to stand for a global module identifier

middle_end/compilenv.ml

@@ -35,11 +35,13 @@ type error =
 
 exception Error of error
 
+module Infos_table = Global_module.Name.Tbl
+
 let global_infos_table =
-  (CU.Name.Tbl.create 17 : unit_infos option CU.Name.Tbl.t)
+  (Infos_table.create 17 : unit_infos option Infos_table.t)
 
 let reset_info_tables () =
-  CU.Name.Tbl.reset global_infos_table
+  Infos_table.reset global_infos_table
 
 module String = Misc.Stdlib.String
 
@@ -62,7 +64,7 @@ let current_unit =
   }
 
 let reset compilation_unit =
-  CU.Name.Tbl.clear global_infos_table;
+  Infos_table.clear global_infos_table;
   Zero_alloc_info.reset cached_zero_alloc_info;
   CU.set_current (Some compilation_unit);
   current_unit.ui_unit <- compilation_unit;
@@ -133,41 +135,48 @@ let read_library_info filename =
 
 (* Read and cache info on global identifiers *)
 
+let equal_args (name1, value1) (name2, value2) =
+  CU.equal name1 name2 && CU.equal value1 value2
+
+let equal_up_to_pack_prefix cu1 cu2 =
+  CU.Name.equal (CU.name cu1) (CU.name cu2)
+  && List.equal equal_args (CU.instance_arguments cu1) (CU.instance_arguments cu2)
+
 let get_unit_info comp_unit =
   (* If this fails, it likely means that someone didn't call
      [CU.which_cmx_file]. *)
   assert (CU.can_access_cmx_file comp_unit ~accessed_by:current_unit.ui_unit);
   (* CR lmaurer: Surely this should just compare [comp_unit] to
      [current_unit.ui_unit], but doing so seems to break Closure. We should fix
      that. *)
-  if CU.Name.equal (CU.name comp_unit) (CU.name current_unit.ui_unit)
+  if equal_up_to_pack_prefix comp_unit current_unit.ui_unit
   then
     Some current_unit
   else begin
-    let cmx_name = CU.name comp_unit in
+    let name = CU.to_global_name_without_prefix comp_unit in
     try
-      CU.Name.Tbl.find global_infos_table cmx_name
+      Infos_table.find global_infos_table name
     with Not_found ->
       let (infos, crc) =
-        if Env.is_imported_opaque cmx_name then (None, None)
+        if Env.is_imported_opaque (CU.name comp_unit) then (None, None)
         else begin
           try
             let filename =
-              Load_path.find_uncap ((cmx_name |> CU.Name.to_string) ^ ".cmx") in
+              Load_path.find_uncap (CU.base_filename comp_unit ^ ".cmx") in
             let (ui, crc) = read_unit_info filename in
             if not (CU.equal ui.ui_unit comp_unit) then
               raise(Error(Illegal_renaming(comp_unit, ui.ui_unit, filename)));
             cache_zero_alloc_info ui.ui_zero_alloc_info;
             (Some ui, Some crc)
           with Not_found ->
-            let warn = Warnings.No_cmx_file (cmx_name |> CU.Name.to_string) in
+            let warn = Warnings.No_cmx_file (Global_module.Name.to_string name) in
               Location.prerr_warning Location.none warn;
               (None, None)
           end
       in
       let import = Import_info.create_normal comp_unit ~crc in
       current_unit.ui_imports_cmx <- import :: current_unit.ui_imports_cmx;
-      CU.Name.Tbl.add global_infos_table cmx_name infos;
+      Infos_table.add global_infos_table name infos;
       infos
   end
 
@@ -189,7 +198,8 @@ let get_global_export_info id =
 
 let cache_unit_info ui =
   cache_zero_alloc_info ui.ui_zero_alloc_info;
-  CU.Name.Tbl.add global_infos_table (CU.name ui.ui_unit) (Some ui)
+  Infos_table.add global_infos_table
+    (ui.ui_unit |> CU.to_global_name_without_prefix) (Some ui)
 
 (* Exporting cross-module information *)
 

ocaml/compilerlibs/Makefile.compilerlibs

@@ -50,6 +50,7 @@ UTILS = \
   utils/domainstate.cmo \
   utils/binutils.cmo \
   utils/target_system.cmo \
+  utils/global.cmo \
   typing/ident.cmo \
   utils/compilation_unit.cmo utils/linkage_name.cmo utils/symbol.cmo \
   utils/import_info.cmo \

ocaml/driver/compile_common.ml

@@ -88,7 +88,7 @@ let emit_signature info ast tsg =
       else begin
         let cmi_arg_for =
           match !Clflags.as_argument_for with
-          | Some arg_type -> Some (Compilation_unit.Name.of_string arg_type)
+          | Some arg_type -> Some (Global_module.Name.create arg_type [])
           | None -> None
         in
         Normal { cmi_impl = info.module_name; cmi_arg_for }

ocaml/file_formats/cmi_format.ml

@@ -23,7 +23,7 @@ type pers_flags =
 type kind =
   | Normal of {
       cmi_impl : Compilation_unit.t;
-      cmi_arg_for : Compilation_unit.Name.t option;
+      cmi_arg_for : Global_module.Name.t option;
     }
   | Parameter
 
@@ -64,14 +64,14 @@ type header = {
     header_name : Compilation_unit.Name.t;
     header_kind : kind;
     header_sign : Serialized.signature;
-    header_params : Compilation_unit.Name.t list;
+    header_params : Global_module.Name.t list;
 }
 
 type 'sg cmi_infos_generic = {
     cmi_name : Compilation_unit.Name.t;
     cmi_kind : kind;
     cmi_sign : 'sg;
-    cmi_params : Compilation_unit.Name.t list;
+    cmi_params : Global_module.Name.t list;
     cmi_crcs : crcs;
     cmi_flags : flags;
 }

ocaml/file_formats/cmi_format.mli

@@ -25,15 +25,15 @@ type kind =
       cmi_impl : Compilation_unit.t;
         (* If this module takes parameters, [cmi_impl] will be the functor that
            generates instances *)
-      cmi_arg_for : Compilation_unit.Name.t option;
+      cmi_arg_for : Global_module.Name.t option;
     }
   | Parameter
 
 type 'sg cmi_infos_generic = {
     cmi_name : Compilation_unit.Name.t;
     cmi_kind : kind;
     cmi_sign : 'sg;
-    cmi_params : Compilation_unit.Name.t list;
+    cmi_params : Global_module.Name.t list;
     cmi_crcs : Import_info.t array;
     cmi_flags : pers_flags list;
 }

ocaml/middle_end/compilenv.ml

@@ -35,10 +35,12 @@ type error =
 
 exception Error of error
 
+module Infos_table = Global.Name.Tbl
+
 let global_infos_table =
-  (CU.Name.Tbl.create 17 : unit_infos option CU.Name.Tbl.t)
+  (Infos_table.create 17 : unit_infos option Infos_table.t)
 let export_infos_table =
-  (CU.Name.Tbl.create 10 : Export_info.t CU.Name.Tbl.t)
+  (Infos_table.create 10 : Export_info.t Infos_table.t)
 
 let imported_sets_of_closures_table =
   (Set_of_closures_id.Tbl.create 10
@@ -93,7 +95,7 @@ let current_unit =
     ui_for_pack = None }
 
 let reset compilation_unit =
-  CU.Name.Tbl.clear global_infos_table;
+  Infos_table.clear global_infos_table;
   Set_of_closures_id.Tbl.clear imported_sets_of_closures_table;
   CU.set_current (Some compilation_unit);
   current_unit.ui_unit <- compilation_unit;
@@ -108,7 +110,7 @@ let reset compilation_unit =
   structured_constants := structured_constants_empty;
   current_unit.ui_export_info <- default_ui_export_info;
   merged_environment := Export_info.empty;
-  CU.Name.Tbl.clear export_infos_table
+  Infos_table.clear export_infos_table
 
 let current_unit_infos () =
   current_unit
@@ -140,27 +142,34 @@ let read_library_info filename =
 
 (* Read and cache info on global identifiers *)
 
+let equal_args (name1, value1) (name2, value2) =
+  CU.equal name1 name2 && CU.equal value1 value2
+
+let equal_up_to_pack_prefix cu1 cu2 =
+  CU.Name.equal (CU.name cu1) (CU.name cu2)
+  && List.equal equal_args (CU.instance_arguments cu1) (CU.instance_arguments cu2)
+
 let get_unit_info comp_unit =
   (* If this fails, it likely means that someone didn't call
      [CU.which_cmx_file]. *)
   assert (CU.can_access_cmx_file comp_unit ~accessed_by:current_unit.ui_unit);
   (* CR lmaurer: Surely this should just compare [comp_unit] to
      [current_unit.ui_unit], but doing so seems to break Closure. We should fix
      that. *)
-  if CU.Name.equal (CU.name comp_unit) (CU.name current_unit.ui_unit)
+  if equal_up_to_pack_prefix comp_unit current_unit.ui_unit
   then
     Some current_unit
   else begin
-    let cmx_name = CU.name comp_unit in
+    let name = CU.to_global_name_without_prefix comp_unit in
     try
-      CU.Name.Tbl.find global_infos_table cmx_name
+      Infos_table.find global_infos_table name
     with Not_found ->
       let (infos, crc) =
-        if Env.is_imported_opaque cmx_name then (None, None)
+        if Env.is_imported_opaque (CU.name comp_unit) then (None, None)
         else begin
           try
             let filename =
-              Load_path.find_uncap ((cmx_name |> CU.Name.to_string) ^ ".cmx") in
+              Load_path.find_uncap (CU.base_filename comp_unit ^ ".cmx") in
             let (ui, crc) = read_unit_info filename in
             if not (CU.equal ui.ui_unit comp_unit) then
               raise(Error(Illegal_renaming(comp_unit, ui.ui_unit, filename)));
@@ -182,15 +191,15 @@ let get_unit_info comp_unit =
                         (filename, p1, CU.name current_unit.ui_unit, p2))));
             (Some ui, Some crc)
           with Not_found ->
-            let warn = Warnings.No_cmx_file (cmx_name |> CU.Name.to_string) in
+            let warn = Warnings.No_cmx_file (Global.Name.to_string name) in
               Location.prerr_warning Location.none warn;
               (None, None)
           end
       in
       let import = Import_info.create_normal comp_unit ~crc in
       current_unit.ui_imports_cmx <-
         Array.append [| import |] current_unit.ui_imports_cmx;
-      CU.Name.Tbl.add global_infos_table cmx_name infos;
+      Infos_table.add global_infos_table name infos;
       infos
   end
 
@@ -201,7 +210,8 @@ let get_global_info global_ident =
   get_unit_info (which_cmx_file global_ident)
 
 let cache_unit_info ui =
-  CU.Name.Tbl.add global_infos_table (CU.name ui.ui_unit) (Some ui)
+  Infos_table.add global_infos_table
+    (ui.ui_unit |> CU.to_global_name_without_prefix) (Some ui)
 
 (* Return the approximation of a global identifier *)
 
@@ -248,15 +258,15 @@ let approx_for_global comp_unit =
   if CU.equal comp_unit CU.predef_exn
   then invalid_arg "approx_for_global with predef_exn compilation unit";
   let accessible_comp_unit = which_cmx_file comp_unit in
-  let cmx_name = CU.name accessible_comp_unit in
-  match CU.Name.Tbl.find export_infos_table cmx_name with
+  let name = accessible_comp_unit |> CU.to_global_name_without_prefix in
+  match Infos_table.find export_infos_table name with
   | otherwise -> Some otherwise
   | exception Not_found ->
     match get_unit_info accessible_comp_unit with
     | None -> None
     | Some ui ->
       let exported = get_flambda_export_info ui in
-      CU.Name.Tbl.add export_infos_table cmx_name exported;
+      Infos_table.add export_infos_table name exported;
       merged_environment := Export_info.merge !merged_environment exported;
       Some exported
 

ocaml/otherlibs/dynlink/dune

@@ -83,6 +83,7 @@
     ast_mapper
     attr_helper
     builtin_attributes
+    global_module
     ident
     path
     shape
@@ -190,6 +191,7 @@
 (copy_files ../../parsing/ast_mapper.ml)
 (copy_files ../../parsing/attr_helper.ml)
 (copy_files ../../parsing/builtin_attributes.ml)
+(copy_files ../../typing/global_module.ml)
 (copy_files ../../typing/ident.ml)
 (copy_files ../../typing/path.ml)
 (copy_files ../../typing/jkind.ml)
@@ -261,6 +263,7 @@
 (copy_files ../../parsing/ast_mapper.mli)
 (copy_files ../../parsing/attr_helper.mli)
 (copy_files ../../parsing/builtin_attributes.mli)
+(copy_files ../../typing/global_module.mli)
 (copy_files ../../typing/ident.mli)
 (copy_files ../../typing/path.mli)
 (copy_files ../../typing/jkind.mli)
@@ -361,6 +364,7 @@
       .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Language_extension.cmo
       .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Terminfo.cmo
       .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Location.cmo
+      .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Global_module.cmo
       .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Ident.cmo
       .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Longident.cmo
       .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Compilation_unit.cmo
@@ -446,6 +450,7 @@
       .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Language_extension.cmx
       .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Terminfo.cmx
       .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Location.cmx
+      .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Global_module.cmx
       .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Ident.cmx
       .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Longident.cmx
       .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Compilation_unit.cmx

ocaml/tools/Makefile

@@ -87,6 +87,7 @@ OCAMLPROF=config.cmo build_path_prefix_map.cmo misc.cmo identifiable.cmo \
   debug.cmo terminfo.cmo \
   warnings.cmo location.cmo longident.cmo docstrings.cmo \
   syntaxerr.cmo ast_helper.cmo \
+  global_module.cmo \
   language_extension_kernel.cmo language_extension.cmo \
   jane_syntax_parsing.cmo jane_syntax.cmo \
    ast_iterator.cmo zero_alloc_utils.cmo builtin_attributes.cmo \