Zero alloc: rename Checks to Zero_alloc_info

backend/.ocamlformat-enable

@@ -2,8 +2,8 @@ cmm_helpers.ml
 cmm_helpers.mli
 cmm_builtins.ml
 cmm_builtins.mli
-checks.ml
-checks.mli
+zero_alloc_info.ml
+zero_alloc_info.mli
 zero_alloc_checker.ml
 zero_alloc_checker.mli
 cfg/**/*.ml

backend/asmpackager.ml

@@ -180,8 +180,9 @@ let build_package_cmx members cmxfile =
       ui.ui_export_info
       units
   in
-  let ui_checks = Checks.create () in
-  List.iter (fun info -> Checks.merge info.ui_checks ~into:ui_checks) units;
+  let ui_zero_alloc_info = Zero_alloc_info.create () in
+  List.iter (fun info -> Zero_alloc_info.merge info.ui_zero_alloc_info
+                           ~into:ui_zero_alloc_info) units;
   let modname = Compilation_unit.name ui.ui_unit in
   let pkg_infos =
     { ui_unit = ui.ui_unit;
@@ -204,7 +205,7 @@ let build_package_cmx members cmxfile =
       ui_force_link =
           List.exists (fun info -> info.ui_force_link) units;
       ui_export_info;
-      ui_checks;
+      ui_zero_alloc_info;
       ui_external_symbols = union (List.map (fun info -> info.ui_external_symbols) units);
     } in
   Compilenv.write_unit_info pkg_infos cmxfile

backend/zero_alloc_checker.ml

@@ -1850,10 +1850,10 @@ module Compilenv_utils : sig
   (** [set_value f v] records the value of the function named [f] in [Compilenv]. *)
   val set_value : string -> Value.t -> unit
 end = struct
-  (* Compact the mapping from function name to Value.t to reduce size of Checks
-     in cmx and memory consumption Compilenv. Different components have
-     different frequencies of Top/Bot. The most likely value is encoded as None
-     (i.e., not stored). *)
+  (* Compact the mapping from function name to Value.t to reduce size of
+     Zero_alloc_info in cmx and memory consumption Compilenv. Different
+     components have different frequencies of Top/Bot. The most likely value is
+     encoded as None (i.e., not stored). *)
   let encode (v : V.t) =
     V.match_with v
       ~top:(fun _ -> 0)
@@ -1872,11 +1872,11 @@ end = struct
     | 2 -> V.bot
     | n -> Misc.fatal_errorf "Zero_alloc_checker cannot decode %d" n
 
-  let encode (v : Value.t) : Checks.value =
+  let encode (v : Value.t) : Zero_alloc_info.value option =
     let c = (encode v.div lsl 4) lor (encode v.exn lsl 2) lor encode v.nor in
     if c = 0 then None else Some c
 
-  let decode : Checks.value -> Value.t = function
+  let decode : Zero_alloc_info.value option -> Value.t = function
     | None -> Value.top decoded_witness
     | Some d ->
       if d = 0 then Misc.fatal_error "Zero_alloc_checker unexpected 0 encoding";
@@ -1886,14 +1886,14 @@ end = struct
       { nor; exn; div }
 
   let set_value s (v : Value.t) =
-    let checks = (Compilenv.current_unit_infos ()).ui_checks in
-    Checks.set_value checks s (encode v)
+    let info = (Compilenv.current_unit_infos ()).ui_zero_alloc_info in
+    match encode v with
+    | None -> ()
+    | Some i -> Zero_alloc_info.set_value info s i
 
   let get_value_opt s =
-    let checks = Compilenv.cached_checks in
-    match Checks.get_value checks s with
-    | None -> None
-    | Some (c : Checks.value) -> Some (decode c)
+    let info = Compilenv.cached_zero_alloc_info in
+    Some (decode (Zero_alloc_info.get_value info s))
 end
 
 (** The analysis involved some fixed point computations.
@@ -2485,7 +2485,8 @@ let reset_unit_info () =
 
 let record_unit_info ppf_dump =
   Analysis.record_unit unit_info unresolved_deps ppf_dump;
-  Compilenv.cache_checks (Compilenv.current_unit_infos ()).ui_checks
+  Compilenv.cache_zero_alloc_info
+    (Compilenv.current_unit_infos ()).ui_zero_alloc_info
 
 type iter_witnesses = (string -> Witnesses.components -> unit) -> unit
 

backend/zero_alloc_info.ml

@@ -0,0 +1,52 @@
+module String = Misc.Stdlib.String
+
+type t = { mutable zero_alloc : int String.Map.t }
+
+let create () = { zero_alloc = String.Map.empty }
+
+let reset t = t.zero_alloc <- String.Map.empty
+
+let merge src ~into:dst =
+  let join key b1 b2 =
+    Misc.fatal_errorf "Unexpected merge %s %d %d" key b1 b2
+  in
+  dst.zero_alloc <- String.Map.union join dst.zero_alloc src.zero_alloc
+
+type value = int
+
+let get_value (t : t) s = String.Map.find_opt s t.zero_alloc
+
+let set_value (t : t) s (v : value) =
+  let f new_ old =
+    if not (Option.is_none old)
+    then Misc.fatal_errorf "Value of %s is already set" s;
+    Some new_
+  in
+  t.zero_alloc <- String.Map.update s (f v) t.zero_alloc
+
+module Raw = struct
+  type entries = (string * int) list
+
+  type t = entries option
+
+  let entries_to_map (e : entries) =
+    List.fold_left (fun acc (k, v) -> String.Map.add k v acc) String.Map.empty e
+
+  let print t =
+    let print (name, v) = Printf.printf "\t\t%s = %#x\n" name v in
+    (* CR gyorsh: move encode/decode here somehow for noalloc *)
+    Printf.printf "Function summaries for static checks:\n";
+    List.iter print t
+
+  let print = function None -> () | Some t -> print t
+end
+
+let to_raw (t : t) : Raw.t =
+  if String.Map.is_empty t.zero_alloc
+  then None
+  else Some (String.Map.bindings t.zero_alloc)
+
+let of_raw (t : Raw.t) : t =
+  match t with
+  | None -> create ()
+  | Some t -> { zero_alloc = Raw.entries_to_map t }

backend/zero_alloc_info.mli

@@ -0,0 +1,29 @@
+(** Function summaries computed by zero_alloc analysis
+    and encoded as integers for storing in .cmx files. *)
+
+type value = int
+
+type t
+
+val create : unit -> t
+
+val reset : t -> unit
+
+(** [merge_checks t ~into] modifies [into] by adding information from [t]. *)
+val merge : t -> into:t -> unit
+
+(** [get_value t fun_name] returns None if [fun_name] is not associated
+    with any value. *)
+val get_value : t -> string -> value option
+
+val set_value : t -> string -> value -> unit
+
+module Raw : sig
+  type t
+
+  val print : t -> unit
+end
+
+val to_raw : t -> Raw.t
+
+val of_raw : Raw.t -> t

dune

@@ -86,7 +86,6 @@
   branch_relaxation
   branch_relaxation_intf
   cfgize
-  checks
   cmm_helpers
   cmm_builtins
   cmm_invariants
@@ -145,6 +144,7 @@
   x86_masm
   x86_proc
   zero_alloc_checker
+  zero_alloc_info
   ;; asmcomp/cfg
   cfg
   cfg_intf

file_formats/cmx_format.mli

@@ -55,7 +55,7 @@ type unit_infos =
                                           (* Infos imported *)
     mutable ui_generic_fns: generic_fns;  (* Generic functions needed *)
     mutable ui_export_info: Flambda2_cmx.Flambda_cmx_format.t option;
-    mutable ui_checks: Checks.t;
+    mutable ui_zero_alloc_info: Zero_alloc_info.t;
     mutable ui_force_link: bool;          (* Always linked *)
     mutable ui_external_symbols: string list; (* Set of external symbols *)
   }
@@ -67,7 +67,7 @@ type unit_infos_raw =
     uir_imports_cmx: Import_info.t array;
     uir_generic_fns: generic_fns;
     uir_export_info: Flambda2_cmx.Flambda_cmx_format.raw option;
-    uir_checks: Checks.Raw.t;
+    uir_zero_alloc_info: Zero_alloc_info.Raw.t;
     uir_force_link: bool;
     uir_section_toc: int array;    (* Byte offsets of sections in .cmx
                                       relative to byte immediately after

middle_end/compilenv.ml

@@ -45,9 +45,9 @@ module String = Misc.Stdlib.String
 
 let exported_constants = Hashtbl.create 17
 
-let cached_checks = Checks.create ()
+let cached_zero_alloc_info = Zero_alloc_info.create ()
 
-let cache_checks c = Checks.merge c ~into:cached_checks
+let cache_zero_alloc_info c = Zero_alloc_info.merge c ~into:cached_zero_alloc_info
 
 let current_unit =
   { ui_unit = CU.dummy;
@@ -56,14 +56,14 @@ let current_unit =
     ui_imports_cmx = [];
     ui_generic_fns = { curry_fun = []; apply_fun = []; send_fun = [] };
     ui_force_link = false;
-    ui_checks = Checks.create ();
+    ui_zero_alloc_info = Zero_alloc_info.create ();
     ui_export_info = None;
     ui_external_symbols = [];
   }
 
 let reset compilation_unit =
   CU.Name.Tbl.clear global_infos_table;
-  Checks.reset cached_checks;
+  Zero_alloc_info.reset cached_zero_alloc_info;
   CU.set_current (Some compilation_unit);
   current_unit.ui_unit <- compilation_unit;
   current_unit.ui_defines <- [compilation_unit];
@@ -72,7 +72,7 @@ let reset compilation_unit =
   current_unit.ui_generic_fns <-
     { curry_fun = []; apply_fun = []; send_fun = [] };
   current_unit.ui_force_link <- !Clflags.link_everything;
-  Checks.reset current_unit.ui_checks;
+  Zero_alloc_info.reset current_unit.ui_zero_alloc_info;
   Hashtbl.clear exported_constants;
   current_unit.ui_export_info <- None;
   current_unit.ui_external_symbols <- []
@@ -111,7 +111,7 @@ let read_unit_info filename =
       ui_imports_cmx = uir.uir_imports_cmx |> Array.to_list;
       ui_generic_fns = uir.uir_generic_fns;
       ui_export_info = export_info;
-      ui_checks = Checks.of_raw uir.uir_checks;
+      ui_zero_alloc_info = Zero_alloc_info.of_raw uir.uir_zero_alloc_info;
       ui_force_link = uir.uir_force_link;
       ui_external_symbols = uir.uir_external_symbols |> Array.to_list;
     }
@@ -157,7 +157,7 @@ let get_unit_info comp_unit =
             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_checks ui.ui_checks;
+            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
@@ -188,7 +188,7 @@ let get_global_export_info id =
   | Some ui -> ui.ui_export_info
 
 let cache_unit_info ui =
-  cache_checks ui.ui_checks;
+  cache_zero_alloc_info ui.ui_zero_alloc_info;
   CU.Name.Tbl.add global_infos_table (CU.name ui.ui_unit) (Some ui)
 
 (* Exporting cross-module information *)
@@ -257,7 +257,7 @@ let write_unit_info info filename =
     uir_imports_cmx = Array.of_list info.ui_imports_cmx;
     uir_generic_fns = info.ui_generic_fns;
     uir_export_info = raw_export_info;
-    uir_checks = Checks.to_raw info.ui_checks;
+    uir_zero_alloc_info = Zero_alloc_info.to_raw info.ui_zero_alloc_info;
     uir_force_link = info.ui_force_link;
     uir_section_toc = toc;
     uir_sections_length = total_length;

middle_end/compilenv.mli

@@ -50,12 +50,12 @@ val need_send_fun:
         (* Record the need of a currying (resp. application,
            message sending) function with the given arity *)
 
-val cached_checks : Checks.t
+val cached_zero_alloc_info : Zero_alloc_info.t
         (* Return cached information about functions
            (from other complication units) that satisfy certain properties. *)
 
-val cache_checks : Checks.t -> unit
-        (* [cache_checks c] adds [c] to [cached_checks] *)
+val cache_zero_alloc_info : Zero_alloc_info.t -> unit
+        (* [cache_zero_alloc_info c] adds [c] to [cached_zero_alloc_info] *)
 
 val new_const_symbol : unit -> string