Use Unit_info.t more like upstream

asmcomp/asmlink.ml

@@ -364,7 +364,10 @@ let make_startup_file unix ~ppf_dump ~sourcefile_for_dwarf genfns units cached_g
   let startup_comp_unit =
     CU.create CU.Prefix.empty (CU.Name.of_string "_startup")
   in
-  Compilenv.reset startup_comp_unit;
+  let startup_unit_info =
+    Unit_info.make_dummy ~input_name:"caml_startup" startup_comp_unit
+  in
+  Compilenv.reset startup_unit_info;
   Emitaux.Dwarf_helpers.init ~disable_dwarf:(not !Dwarf_flags.dwarf_for_startup_file)
     ~sourcefile:sourcefile_for_dwarf;
   Emit.begin_assembly unix;
@@ -421,7 +424,10 @@ let make_shared_startup_file unix ~ppf_dump ~sourcefile_for_dwarf genfns units =
   let shared_startup_comp_unit =
     CU.create CU.Prefix.empty (CU.Name.of_string "_shared_startup")
   in
-  Compilenv.reset shared_startup_comp_unit;
+  let shared_startup_unit_info =
+    Unit_info.make_dummy ~input_name:"caml_startup" shared_startup_comp_unit
+  in
+  Compilenv.reset shared_startup_unit_info;
   Emitaux.Dwarf_helpers.init ~disable_dwarf:(not !Dwarf_flags.dwarf_for_startup_file)
     ~sourcefile:sourcefile_for_dwarf;
   Emit.begin_assembly unix;

asmcomp/asmpackager.ml

@@ -41,8 +41,9 @@ type pack_member =
     pm_kind: pack_member_kind }
 
 let read_member_info pack_path file = (
-  let unit_info = Unit_info.Artifact.from_filename file in
-  let name = Unit_info.Artifact.modname unit_info |> CU.Name.of_string in
+  let for_pack_prefix = CU.to_prefix pack_path in
+  let unit_info = Unit_info.Artifact.from_filename ~for_pack_prefix file in
+  let name = Unit_info.Artifact.modname unit_info |> CU.name in
   let kind =
     if Unit_info.is_cmi unit_info then
       PM_intf
@@ -91,7 +92,8 @@ type flambda2 =
 let make_package_object unix ~ppf_dump members target coercion
       ~(flambda2 : flambda2) =
   let pack_name =
-    Printf.sprintf "pack(%s)" (Unit_info.Artifact.modname target) in
+    Printf.sprintf "pack(%s)"
+      (Unit_info.Artifact.modname target |> CU.name_as_string) in
   Profile.record_call pack_name (fun () ->
     let objtemp =
       if !Clflags.keep_asm_file
@@ -113,9 +115,7 @@ let make_package_object unix ~ppf_dump members target coercion
           | PM_intf -> None
           | PM_impl _ -> Some(CU.create_child (CU.get_current_exn ()) m.pm_name))
         members in
-    let for_pack_prefix = CU.Prefix.from_clflags () in
-    let modname = CU.Name.of_string (Unit_info.Artifact.modname target) in
-    let compilation_unit = CU.create for_pack_prefix modname in
+    let compilation_unit = Unit_info.Artifact.modname target in
     let prefixname = Filename.remove_extension objtemp in
     let required_globals = Compilation_unit.Set.empty in
     let transl_style : Translmod.compilation_unit_style =
@@ -229,11 +229,7 @@ let build_package_cmx members cmxfile ~main_module_block_size =
 
 let package_object_files unix ~ppf_dump files target
                          targetcmx coercion ~flambda2 =
-  let pack_path =
-    let for_pack_prefix = CU.Prefix.from_clflags () in
-    let name = Unit_info.Artifact.modname target |> CU.Name.of_string in
-    CU.create for_pack_prefix name
-  in
+  let pack_path = Unit_info.Artifact.modname target in
   let members = map_left_right (read_member_info pack_path) files in
   check_units members;
   let main_module_block_size =
@@ -250,18 +246,18 @@ let package_files unix ~ppf_dump initial_env files targetcmx ~flambda2 =
         try Load_path.find f
         with Not_found -> raise(Error(File_not_found f)))
       files in
-  let cmx = Unit_info.Artifact.from_filename targetcmx in
+  let for_pack_prefix = CU.Prefix.from_clflags () in
+  let cmx = Unit_info.Artifact.from_filename ~for_pack_prefix targetcmx in
   let cmi = Unit_info.companion_cmi cmx in
   let obj = Unit_info.companion_obj cmx in
   (* Set the name of the current "input" *)
   Location.input_name := targetcmx;
   (* Set the name of the current compunit *)
-  let comp_unit =
-    let for_pack_prefix = CU.Prefix.from_clflags () in
-    CU.create for_pack_prefix
-      (CU.Name.of_string (Unit_info.Artifact.modname cmi))
+  let unit_info =
+    Unit_info.of_artifact Impl cmx ~dummy_source_file:targetcmx
   in
-  Compilenv.reset comp_unit;
+  let comp_unit = Unit_info.Artifact.modname cmx in
+  Compilenv.reset unit_info;
   Misc.try_finally (fun () ->
       let coercion =
         Typemod.package_units initial_env files cmi comp_unit in

bytecomp/bytepackager.ml

@@ -103,11 +103,10 @@ type pack_member =
     pm_kind: pack_member_kind }
 
 let read_member_info ~packed_compilation_unit file =
-  let member_artifact = Unit_info.Artifact.from_filename file in
-  let member_name =
-    Unit_info.Artifact.modname member_artifact |> CU.Name.of_string
-  in
-  let packed_name = CU.create_child packed_compilation_unit member_name in
+  let for_pack_prefix = CU.to_prefix packed_compilation_unit in
+  let member_artifact = Unit_info.Artifact.from_filename ~for_pack_prefix file in
+  let packed_name = Unit_info.Artifact.modname member_artifact in
+  let member_name = CU.name packed_name in
   let kind =
     (* PR#7479: make sure it is either a .cmi or a .cmo *)
     if Unit_info.is_cmi member_artifact then
@@ -241,13 +240,8 @@ let build_global_target ~ppf_dump oc ~packed_compilation_unit state members
 
 let package_object_files ~ppf_dump files target coercion =
   let targetfile = Unit_info.Artifact.filename target in
-  let packed_compilation_unit_name =
-    CU.Name.of_string (Unit_info.Artifact.modname target)
-  in
-  let packed_compilation_unit =
-    let prefix = CU.Prefix.from_clflags () in
-    CU.create prefix packed_compilation_unit_name
-  in
+  let packed_compilation_unit = Unit_info.Artifact.modname target in
+  let packed_compilation_unit_name = CU.name packed_compilation_unit in
   let members =
     map_left_right (read_member_info ~packed_compilation_unit) files
   in
@@ -350,12 +344,15 @@ let package_files ~ppf_dump initial_env files targetfile =
          try Load_path.find f
          with Not_found -> raise(Error(File_not_found f)))
       files in
-  let target = Unit_info.Artifact.from_filename targetfile in
-  let comp_unit =
-    CU.create (CU.Prefix.from_clflags ())
-      (Unit_info.Artifact.modname target |> CU.Name.of_string)
+  let for_pack_prefix = CU.Prefix.from_clflags () in
+  let target = Unit_info.Artifact.from_filename ~for_pack_prefix targetfile in
+  let comp_unit = Unit_info.Artifact.modname target in
+  let unit_info =
+    (* Do what [asmpackager] does and use the target .cmx as a dummy source
+       file *)
+    Unit_info.of_artifact Impl target ~dummy_source_file:targetfile
   in
-  CU.set_current (Some comp_unit);
+  Env.set_unit_name (Some unit_info);
   Misc.try_finally (fun () ->
       let coercion =
         Typemod.package_units initial_env files (Unit_info.companion_cmi target)

driver/compile.ml

@@ -23,7 +23,7 @@ let with_info =
 
 let interface ~source_file ~output_prefix =
   with_info ~source_file ~output_prefix ~dump_ext:"cmi"
-    ~compilation_unit:Inferred_from_output_prefix
+    ~compilation_unit:Inferred_from_output_prefix ~kind:Intf
   @@ fun info ->
   Compile_common.interface
     ~hook_parse_tree:(fun _ -> ())
@@ -102,6 +102,7 @@ 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
+    ~kind:Impl
   @@ fun info ->
   match start_from with
   | Parsing ->

driver/compile_common.ml

@@ -15,6 +15,8 @@
 
 open Misc
 
+(* CR lmaurer: No longer need both [target] and [module_name] here (true in lots
+   of places) *)
 type info = {
   target: Unit_info.t;
   module_name : Compilation_unit.t;
@@ -29,21 +31,20 @@ type compilation_unit_or_inferred =
   | Inferred_from_output_prefix
 
 let with_info ~native ~tool_name ~source_file ~output_prefix
-      ~compilation_unit ~dump_ext k =
+      ~compilation_unit ~kind ~dump_ext k =
   Compmisc.init_path ();
   Compmisc.init_parameters ();
-  let target = Unit_info.make ~source_file output_prefix in
-  let compilation_unit =
+  let target =
     match compilation_unit with
-    | Exactly compilation_unit -> compilation_unit
+    | Exactly compilation_unit ->
+        Unit_info.make_with_known_compilation_unit ~source_file kind
+          output_prefix compilation_unit
     | Inferred_from_output_prefix ->
-        let module_name = Unit_info.modname target in
         let for_pack_prefix = Compilation_unit.Prefix.from_clflags () in
-        Compilation_unit.create for_pack_prefix
-          (module_name |> Compilation_unit.Name.of_string)
+        Unit_info.make ~source_file ~for_pack_prefix kind output_prefix
   in
-  Compilation_unit.set_current (Some compilation_unit);
-  Env.set_unit_name (Some compilation_unit);
+  let compilation_unit = Unit_info.modname target in
+  Env.set_unit_name (Some target);
   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 ->

driver/compile_common.mli

@@ -36,6 +36,7 @@ val with_info :
   source_file:string ->
   output_prefix:string ->
   compilation_unit:compilation_unit_or_inferred ->
+  kind:Unit_info.intf_or_impl ->
   dump_ext:string ->
   (info -> 'a) -> 'a
 (** [with_info ~native ~tool_name ~source_file ~output_prefix ~dump_ext k]

driver/optcompile.ml

@@ -24,7 +24,7 @@ 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"
-    ~compilation_unit:Inferred_from_output_prefix
+    ~compilation_unit:Inferred_from_output_prefix ~kind:Intf
   @@ fun info ->
   Compile_common.interface
   ~hook_parse_tree:(Compiler_hooks.execute Compiler_hooks.Parse_tree_intf)
@@ -84,7 +84,7 @@ type flambda2 =
 
 (* Emit assembly directly from Linear IR *)
 let emit unix i =
-  Compilenv.reset i.module_name;
+  Compilenv.reset i.target;
   Asmgen.compile_implementation_linear unix
     (Unit_info.prefix i.target)
     ~progname:(Unit_info.source_file i.target)
@@ -116,14 +116,15 @@ let implementation_aux unix ~(flambda2 : flambda2) ~start_from
     Direct_to_cmm (flambda2 ~keep_symbol_tables)
   in
   with_info ~source_file ~output_prefix ~dump_ext:"cmx" ~compilation_unit
+    ~kind:Impl
   @@ fun info ->
   if !Flambda_backend_flags.internal_assembler then
       Emitaux.binary_backend_available := true;
   match start_from with
   | Parsing ->
     let backend info ({ structure; coercion; argument_interface; _ }
                       : Typedtree.implementation) =
-      Compilenv.reset info.module_name;
+      Compilenv.reset info.target;
       let argument_coercion =
         match argument_interface with
         | Some { ai_coercion_from_primary; ai_signature = _ } ->
@@ -148,7 +149,7 @@ let implementation_aux unix ~(flambda2 : flambda2) ~start_from
       info ~backend
   | Emit -> emit unix info ~ppf_dump:info.ppf_dump
   | Instantiation { runtime_args; main_module_block_size; arg_descr } ->
-    Compilenv.reset info.module_name;
+    Compilenv.reset info.target;
     begin
       match !Clflags.as_argument_for with
       | Some _ ->

flambda-backend/testsuite/tools/codegen_main.ml

@@ -22,7 +22,8 @@ let compile_file filename =
     Emitaux.output_channel := open_out out_name
   end; (* otherwise, stdout *)
   let compilation_unit = "test" |> Compilation_unit.of_string in
-  Compilenv.reset compilation_unit;
+  let unit_info = Unit_info.make_dummy ~input_name:"test" compilation_unit in
+  Compilenv.reset unit_info;
   Emit.begin_assembly (module Unix : Compiler_owee.Unix_intf.S);
   let ic = open_in filename in
   let lb = Lexing.from_channel ic in

middle_end/compilenv.ml

@@ -65,10 +65,11 @@ let current_unit =
     ui_external_symbols = [];
   }
 
-let reset compilation_unit =
+let reset unit_info =
+  let compilation_unit = Unit_info.modname unit_info in
   Infos_table.clear global_infos_table;
   Zero_alloc_info.reset cached_zero_alloc_info;
-  CU.set_current (Some compilation_unit);
+  Env.set_unit_name (Some unit_info);
   current_unit.ui_unit <- compilation_unit;
   current_unit.ui_defines <- [compilation_unit];
   current_unit.ui_arg_descr <- None;

middle_end/compilenv.mli

@@ -21,7 +21,7 @@
 
 open Cmx_format
 
-val reset : Compilation_unit.t -> unit
+val reset : Unit_info.t -> unit
         (* Reset the environment and record the name of the unit being
            compiled (including any associated -for-pack prefix). *)
 

middle_end/flambda2/cmx/flambda_cmx.ml

@@ -82,12 +82,16 @@ let all_predefined_exception_symbols () =
   Predef.all_predef_exns |> List.map symbol_for_global |> Symbol.Set.of_list
 
 let predefined_exception_typing_env () =
-  let comp_unit = Compilation_unit.get_current () in
-  Compilation_unit.set_current (Some Compilation_unit.predef_exn);
+  let unit_info = Env.get_unit_name () in
+  let predef_unit_info =
+    Unit_info.make_dummy ~input_name:"<predefined exceptions>"
+      Compilation_unit.predef_exn
+  in
+  Env.set_unit_name (Some predef_unit_info);
   let typing_env =
     TE.Serializable.predefined_exceptions (all_predefined_exception_symbols ())
   in
-  Compilation_unit.set_current comp_unit;
+  Env.set_unit_name unit_info;
   typing_env
 
 let create_loader ~get_module_info =

middle_end/flambda2/cmx/flambda_cmx_format.ml

@@ -213,7 +213,10 @@ 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);
+  let unit_info =
+    Unit_info.make_dummy ~input_name:"<none>" t.original_compilation_unit
+  in
+  Env.set_unit_name (Some unit_info);
   let typing_env, code = import_typing_env_and_code0 ~sections t in
   if print_typing_env
   then

middle_end/flambda2/parser/parse_flambda.ml

@@ -153,8 +153,9 @@ let parse filename =
   parse_fexpr 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);
+         let unit_info = Unit_info.make_dummy ~input_name:filename comp_unit in
+         let old_unit_info = Env.get_unit_name () in
+         Env.set_unit_name (Some unit_info);
          let flambda = Fexpr_to_flambda.conv comp_unit fexpr in
-         Compilation_unit.set_current old_comp_unit;
+         Env.set_unit_name old_unit_info;
          flambda)

middle_end/flambda2/tests/api_tests/extension_meet.ml

@@ -188,5 +188,6 @@ 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);
+  let unit_info = Unit_info.make_dummy ~input_name:"camlTest" comp_unit in
+  Env.set_unit_name (Some unit_info);
   test_double_recursion ()

middle_end/flambda2/tests/meet_test.ml

@@ -424,7 +424,8 @@ let test_meet_bottom_after_alias () =
 
 let () =
   let comp_unit = "Meet_test" |> Compilation_unit.of_string in
-  Compilation_unit.set_current (Some comp_unit);
+  let unit_info = Unit_info.make_dummy ~input_name:"meet_test" comp_unit in
+  Env.set_unit_name (Some unit_info);
   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/flexpect.ml

@@ -35,7 +35,8 @@ 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);
+  let unit_info = Unit_info.make_dummy ~input_name:filename comp_unit in
+  Env.set_unit_name (Some unit_info);
   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/roundtrip.ml

@@ -28,9 +28,10 @@ let () =
     let modname =
       Parse_flambda.make_compilation_unit ~filename:file ~extension:".fl" ()
     in
+    let unit_info = Unit_info.make_dummy ~input_name:file modname in
     (* Need to get this right or the conversion will complain about binding
        non-local symbols *)
-    Compilation_unit.set_current (Some modname);
+    Env.set_unit_name (Some unit_info);
     let unit =
       match Parse_flambda.parse file with
       | Ok unit -> unit