Zero alloc: refactor to remove "property" and improve naming (#2416)

* Remove "Lambda.property" and rename "Lambda.check_attribute" and

propagate this name down to Cmm.

* Rename files

checkmach.ml to zero_alloc_checker.ml
check_attribute.ml to zero_alloc_attribute.ml

* Rename compilation flags "checkmach" to "zero-alloc-checker"

* Update autogenerated dune.inc file

* Refactoring: simplify zero_alloc_checker by removing unused functor

* Format

* Update depend

* Fix upstream testsuite

* Lots of fixes after rebase (makes separate commits useless)

too much diff to fix up in the right commit

* Regenerate dune.inc

* Fix chamelon build

* Rename [check] labelled arguments to [zero_alloc_attribute]

* fix up [dune] to list more things alphabetically

* Fix assorted typos and improve printing

* Format

* Remove unused copy of is_check_enabled

Author: gretay-js

backend/.ocamlformat-enable

@@ -4,8 +4,8 @@ cmm_builtins.ml
 cmm_builtins.mli
 checks.ml
 checks.mli
-checkmach.ml
-checkmach.mli
+zero_alloc_checker.ml
+zero_alloc_checker.mli
 cfg/**/*.ml
 cfg/**/*.mli
 asm_targets/**/*.ml

backend/asmgen.ml

@@ -86,7 +86,7 @@ let (pass_to_cfg : Cfg_format.cfg_unit_info Compiler_pass_map.t) =
   |> Compiler_pass_map.add Compiler_pass.Selection (new_cfg_unit_info ())
 
 let reset () =
-  Checkmach.reset_unit_info ();
+  Zero_alloc_checker.reset_unit_info ();
   start_from_emit := false;
   Compiler_pass_map.iter (fun pass (cfg_unit_info : Cfg_format.cfg_unit_info) ->
     if should_save_ir_after pass then begin
@@ -277,8 +277,8 @@ let compile_fundecl ~ppf_dump ~funcnames fd_cmm =
   ++ Profile.record ~accumulate:true "polling"
        (Polling.instrument_fundecl ~future_funcnames:funcnames)
   ++ Compiler_hooks.execute_and_pipe Compiler_hooks.Mach_polling
-  ++ Profile.record ~accumulate:true "checkmach"
-       (Checkmach.fundecl ~future_funcnames:funcnames ppf_dump)
+  ++ Profile.record ~accumulate:true "zero_alloc_checker"
+       (Zero_alloc_checker.fundecl ~future_funcnames:funcnames ppf_dump)
   ++ (fun fd ->
       match !Flambda_backend_flags.cfg_cse_optimize with
       | false ->
@@ -460,9 +460,9 @@ let compile_unit ~output_prefix ~asm_filename ~keep_asm ~obj_filename ~may_reduc
        Misc.try_finally
          (fun () ->
             gen ();
-            Checkmach.record_unit_info ppf_dump;
+            Zero_alloc_checker.record_unit_info ppf_dump;
             Compiler_hooks.execute Compiler_hooks.Check_allocations
-              Checkmach.iter_witnesses;
+              Zero_alloc_checker.iter_witnesses;
             write_ir output_prefix)
          ~always:(fun () ->
              if create_asm then close_out !Emitaux.output_channel)

backend/cfg/cfg.ml

@@ -57,7 +57,8 @@ let rec of_cmm_codegen_option : Cmm.codegen_option list -> codegen_option list =
     match hd with
     | No_CSE -> No_CSE :: of_cmm_codegen_option tl
     | Reduce_code_size -> Reduce_code_size :: of_cmm_codegen_option tl
-    | Use_linscan_regalloc | Assume _ | Check _ -> of_cmm_codegen_option tl)
+    | Use_linscan_regalloc | Assume_zero_alloc _ | Check_zero_alloc _ ->
+      of_cmm_codegen_option tl)
 
 type t =
   { blocks : basic_block Label.Tbl.t;

backend/cmm.ml

@@ -312,17 +312,14 @@ type expression =
       * Backend_var.With_provenance.t * expression * Debuginfo.t
       * kind_for_unboxing
 
-type property =
-  | Zero_alloc
-
 type codegen_option =
   | Reduce_code_size
   | No_CSE
   | Use_linscan_regalloc
-  | Assume of { property: property; strict: bool; never_returns_normally: bool;
-                never_raises: bool;
-                loc: Location.t }
-  | Check of { property: property; strict: bool; loc : Location.t; }
+  | Assume_zero_alloc of { strict: bool; never_returns_normally: bool;
+                           never_raises: bool;
+                           loc: Location.t }
+  | Check_zero_alloc of { strict: bool; loc : Location.t; }
 
 type fundecl =
   { fun_name: symbol;
@@ -686,6 +683,4 @@ let equal_integer_comparison left right =
   | Cge, (Ceq | Cne | Clt | Cgt | Cle) ->
     false
 
-let all_properties = [Zero_alloc]
-
 let caml_flambda2_invalid = "caml_flambda2_invalid"

backend/cmm.mli

@@ -314,17 +314,14 @@ type expression =
         active.  This allows for sharing a single handler in several places, or
         having multiple entry and exit points to a single trywith block. *)
 
-type property =
-  | Zero_alloc
-
 type codegen_option =
   | Reduce_code_size
   | No_CSE
   | Use_linscan_regalloc
-  | Assume of { property: property; strict: bool; never_returns_normally: bool;
+  | Assume_zero_alloc of { strict: bool; never_returns_normally: bool;
                 never_raises: bool;
                 loc: Location.t }
-  | Check of { property: property; strict: bool; loc: Location.t }
+  | Check_zero_alloc of { strict: bool; loc: Location.t }
 
 type fundecl =
   { fun_name: symbol;
@@ -401,6 +398,5 @@ val equal_float_width : float_width -> float_width -> bool
 val equal_float_comparison : float_comparison -> float_comparison -> bool
 val equal_memory_chunk : memory_chunk -> memory_chunk -> bool
 val equal_integer_comparison : integer_comparison -> integer_comparison -> bool
-val all_properties : property list
 
 val caml_flambda2_invalid : string

backend/printcmm.ml

@@ -392,21 +392,17 @@ and sequence ppf = function
 
 and expression ppf e = fprintf ppf "%a" expr e
 
-let property_to_string : Cmm.property -> string = function
-  | Zero_alloc -> "zero_alloc"
-
 let codegen_option = function
   | Reduce_code_size -> "reduce_code_size"
   | No_CSE -> "no_cse"
   | Use_linscan_regalloc -> "linscan"
-  | Assume { property; strict; never_returns_normally = _; loc = _ } ->
-    Printf.sprintf "assume_%s%s%s"
-      (property_to_string property)
+  | Assume_zero_alloc { strict; never_returns_normally; never_raises; loc = _ } ->
+    Printf.sprintf "assume_zero_alloc_%s%s%s"
       (if strict then "_strict" else "")
-      (if strict then "_never_returns_normally" else "")
-  | Check { property; strict; loc = _ } ->
-    Printf.sprintf "assert_%s%s"
-      (property_to_string property)
+      (if never_returns_normally then "_never_returns_normally" else "")
+      (if never_raises then "_never_raises" else "")
+  | Check_zero_alloc { strict; loc = _ } ->
+    Printf.sprintf "assert_zero_alloc%s"
       (if strict then "_strict" else "")
 
 let print_codegen_options ppf l =

backend/printcmm.mli

@@ -34,5 +34,4 @@ val fundecl : formatter -> Cmm.fundecl -> unit
 val data : formatter -> Cmm.data_item list -> unit
 val phrase : formatter -> Cmm.phrase -> unit
 val temporal_locality : Cmm.prefetch_temporal_locality_hint -> string
-val property_to_string : Cmm.property -> string
 val print_codegen_options : formatter -> Cmm.codegen_option list -> unit

backend/selectgen.ml

@@ -1753,7 +1753,8 @@ method private emit_tail_sequence ?at_start env exp =
 method emit_fundecl ~future_funcnames f =
   current_function_name := f.Cmm.fun_name.sym_name;
   current_function_is_check_enabled :=
-    Checkmach.is_check_enabled f.Cmm.fun_codegen_options f.Cmm.fun_name.sym_name f.Cmm.fun_dbg;
+    Zero_alloc_checker.is_check_enabled f.Cmm.fun_codegen_options
+      f.Cmm.fun_name.sym_name f.Cmm.fun_dbg;
   let num_regs_per_arg = Array.make (List.length f.Cmm.fun_args) 0 in
   let rargs =
     List.mapi