flambda-backend: Simpler symbols (ocaml-flambda#753)

Co-authored-by: Mark Shinwell <[email protected]>

asmcomp/amd64/emit.mlp

@@ -481,7 +481,7 @@ let emit_float_constant f lbl =
   D.qword (Const f)
 
 let emit_global_label s =
-  let lbl = Compilenv.make_symbol (Some s) in
+  let lbl = Cmm_helpers.make_symbol s in
   add_def_symbol lbl;
   let lbl = emit_symbol lbl in
   D.global lbl;
@@ -556,7 +556,7 @@ type probe =
 
 let probe_handler_wrapper_name probe_label =
   let w = Printf.sprintf "probe_wrapper_%d" probe_label in
-  Compilenv.make_symbol (Some w)
+  Cmm_helpers.make_symbol w
   |> emit_symbol
 
 let probes = ref []
@@ -571,7 +571,7 @@ let find_or_add_semaphore name =
   match String.Map.find_opt name !probe_semaphores with
   | Some label -> label
   | None ->
-    let sym = Compilenv.make_symbol (Some ("semaphore_"^name)) in
+    let sym = Cmm_helpers.make_symbol ("semaphore_"^name) in
     probe_semaphores := String.Map.add name sym !probe_semaphores;
     sym
 
@@ -1162,7 +1162,7 @@ let begin_assembly() =
   D.data ();
   emit_global_label "data_begin";
 
-  emit_named_text_section (Compilenv.make_symbol (Some "code_begin"));
+  emit_named_text_section (Cmm_helpers.make_symbol "code_begin");
   emit_global_label "code_begin";
   if system = S_macosx then I.nop (); (* PR#4690 *)
   ()
@@ -1438,7 +1438,7 @@ let end_assembly() =
   (* Emit probe handler wrappers *)
   List.iter emit_probe_handler_wrapper !probes;
 
-  emit_named_text_section (Compilenv.make_symbol (Some "code_end"));
+  emit_named_text_section (Cmm_helpers.make_symbol "code_end");
   if system = S_macosx then I.nop ();
   (* suppress "ld warning: atom sorting error" *)
 
@@ -1483,7 +1483,7 @@ let end_assembly() =
     };
 
   if system = S_linux then begin
-    let frametable = emit_symbol (Compilenv.make_symbol (Some "frametable")) in
+    let frametable = emit_symbol (Cmm_helpers.make_symbol "frametable") in
     D.size frametable (ConstSub (ConstThis, ConstLabel frametable))
   end;
 

asmcomp/arm/emit.mlp

@@ -1041,27 +1041,27 @@ let begin_assembly() =
   `trap_ptr	.req	r8\n`;
   `alloc_ptr	.req	r10\n`;
   `domain_state_ptr	.req	r11\n`;
-  let lbl_begin = Compilenv.make_symbol (Some "data_begin") in
+  let lbl_begin = Cmm_helpers.make_symbol "data_begin" in
   `	.data\n`;
   `	.globl	{emit_symbol lbl_begin}\n`;
   `{emit_symbol lbl_begin}:\n`;
-  let lbl_begin = Compilenv.make_symbol (Some "code_begin") in
+  let lbl_begin = Cmm_helpers.make_symbol "code_begin" in
   emit_named_text_section lbl_begin;
   `	.globl	{emit_symbol lbl_begin}\n`;
   `{emit_symbol lbl_begin}:\n`
 
 let end_assembly () =
-  let lbl_end = Compilenv.make_symbol (Some "code_end") in
+  let lbl_end = Cmm_helpers.make_symbol "code_end" in
   emit_named_text_section lbl_end;
   `	.globl	{emit_symbol lbl_end}\n`;
   `{emit_symbol lbl_end}:\n`;
-  let lbl_end = Compilenv.make_symbol (Some "data_end") in
+  let lbl_end = Cmm_helpers.make_symbol "data_end" in
   `	.data\n`;
   `	.long 0\n`;  (* PR#6329 *)
   `	.globl	{emit_symbol lbl_end}\n`;
   `{emit_symbol lbl_end}:\n`;
   `	.long	0\n`;
-  let lbl = Compilenv.make_symbol (Some "frametable") in
+  let lbl = Cmm_helpers.make_symbol "frametable" in
   `	.globl	{emit_symbol lbl}\n`;
   `{emit_symbol lbl}:\n`;
   emit_frames

asmcomp/arm64/emit.mlp

@@ -1082,28 +1082,28 @@ let data l =
 let begin_assembly() =
   reset_debug_info();
   `	.file	\"\"\n`;  (* PR#7037 *)
-  let lbl_begin = Compilenv.make_symbol (Some "data_begin") in
+  let lbl_begin = Cmm_helpers.make_symbol "data_begin" in
   `	.data\n`;
   `	.globl	{emit_symbol lbl_begin}\n`;
   `{emit_symbol lbl_begin}:\n`;
-  let lbl_begin = Compilenv.make_symbol (Some "code_begin") in
+  let lbl_begin = Cmm_helpers.make_symbol "code_begin" in
   emit_named_text_section lbl_begin;
   `	.globl	{emit_symbol lbl_begin}\n`;
   `{emit_symbol lbl_begin}:\n`
 
 let end_assembly () =
-  let lbl_end = Compilenv.make_symbol (Some "code_end") in
+  let lbl_end = Cmm_helpers.make_symbol "code_end" in
   emit_named_text_section lbl_end;
   `	.globl	{emit_symbol lbl_end}\n`;
   `{emit_symbol lbl_end}:\n`;
-  let lbl_end = Compilenv.make_symbol (Some "data_end") in
+  let lbl_end = Cmm_helpers.make_symbol "data_end" in
   `	.data\n`;
   `	.quad	0\n`;  (* PR#6329 *)
   `	.globl	{emit_symbol lbl_end}\n`;
   `{emit_symbol lbl_end}:\n`;
   `	.quad	0\n`;
   `	.align	3\n`;  (* #7887 *)
-  let lbl = Compilenv.make_symbol (Some "frametable") in
+  let lbl = Cmm_helpers.make_symbol "frametable" in
   `	.globl	{emit_symbol lbl}\n`;
   `{emit_symbol lbl}:\n`;
   emit_frames

asmcomp/asmgen.ml

@@ -25,7 +25,7 @@ open Cmm
 
 type error =
   | Assembler_error of string
-  | Mismatched_for_pack of string option
+  | Mismatched_for_pack of Compilation_unit.Prefix.t
   | Asm_generation of string * Emitaux.error
 
 exception Error of error
@@ -58,17 +58,15 @@ let should_save_before_emit () =
   should_save_ir_after Compiler_pass.Scheduling && (not !start_from_emit)
 
 let linear_unit_info =
-  { Linear_format.unit_name = "";
+  { Linear_format.unit = Compilation_unit.dummy;
     items = [];
-    for_pack = None;
   }
 
 let reset () =
   start_from_emit := false;
   if should_save_before_emit () then begin
-    linear_unit_info.unit_name <- Compilenv.current_unit_name ();
+    linear_unit_info.unit <- Compilation_unit.get_current_exn ();
     linear_unit_info.items <- [];
-    linear_unit_info.for_pack <- !Clflags.for_package;
   end
 
 let save_data dl =
@@ -261,10 +259,11 @@ let compile_implementation ?toplevel ~backend ~filename ~prefixname ~middle_end
 let linear_gen_implementation filename =
   let open Linear_format in
   let linear_unit_info, _ = restore filename in
-  (match !Clflags.for_package, linear_unit_info.for_pack with
-   | None, None -> ()
-   | Some expected, Some saved when String.equal expected saved -> ()
-   | _, saved -> raise(Error(Mismatched_for_pack saved)));
+  let current_package = Compilation_unit.Prefix.from_clflags () in
+  let saved_package =
+    Compilation_unit.for_pack_prefix linear_unit_info.unit in
+  if not (Compilation_unit.Prefix.equal current_package saved_package)
+  then raise(Error(Mismatched_for_pack saved_package));
   let emit_item = function
     | Data dl -> emit_data dl
     | Func f -> emit_fundecl f
@@ -288,13 +287,15 @@ let report_error ppf = function
       fprintf ppf "Assembler error, input left in file %a"
         Location.print_filename file
   | Mismatched_for_pack saved ->
-    let msg = function
-       | None -> "without -for-pack"
-       | Some s -> "with -for-pack "^s
+    let msg prefix =
+      if Compilation_unit.Prefix.is_empty prefix
+      then "without -for-pack"
+      else
+        Format.asprintf "with -for-pack %a" Compilation_unit.Prefix.print prefix
      in
      fprintf ppf
        "This input file cannot be compiled %s: it was generated %s."
-       (msg !Clflags.for_package) (msg saved)
+       (msg (Compilation_unit.Prefix.from_clflags ())) (msg saved)
   | Asm_generation(fn, err) ->
      fprintf ppf
        "Error producing assembly code for function %s: %a"

asmcomp/asmgen.mli

@@ -43,7 +43,7 @@ val compile_phrase :
 
 type error =
   | Assembler_error of string
-  | Mismatched_for_pack of string option
+  | Mismatched_for_pack of Compilation_unit.Prefix.t
   | Asm_generation of string * Emitaux.error
 
 exception Error of error