fix(compiler): Stabilize CRC checks (#2101)

compiler/grainc/grainc.re

@@ -36,9 +36,6 @@ let compile_file = (name, outfile_arg) => {
         ~default=Compile.default_output_filename(name),
         outfile_arg,
       );
-    if (Grain_utils.Config.debug^) {
-      Compile.save_mashed(name, Compile.default_mashtree_filename(outfile));
-    };
     let hook =
       if (Grain_utils.Config.statically_link^) {
         Compile.stop_after_assembled;

compiler/src/compile.re

@@ -49,6 +49,20 @@ let default_mashtree_filename = name =>
 let compile_prog = p =>
   Compcore.module_to_bytes @@ Compcore.compile_wasm_module(p);
 
+let save_mashed = (mashed, outfile) => {
+  switch (outfile) {
+  | Some(outfile) =>
+    let outfile = default_mashtree_filename(outfile);
+    Grain_utils.Fs_access.ensure_parent_directory_exists(outfile);
+    let mash_string =
+      Sexplib.Sexp.to_string_hum @@ Mashtree.sexp_of_mash_program(mashed);
+    let oc = open_out(outfile);
+    output_string(oc, mash_string);
+    close_out(oc);
+  | None => ()
+  };
+};
+
 let log_state = state =>
   if (Grain_utils.Config.verbose^) {
     let prerr_sexp = (conv, x) =>
@@ -135,9 +149,7 @@ let next_state = (~is_root_file=false, {cstate_desc, cstate_filename} as cs) =>
         ~no_pervasives=has_attr("noPervasives"),
         ~runtime_mode=has_attr("runtimeMode"),
       );
-      if (is_root_file) {
-        Grain_utils.Config.set_root_config();
-      };
+
       Well_formedness.check_well_formedness(p);
       WellFormed(p);
     | WellFormed(p) =>
@@ -157,7 +169,11 @@ let next_state = (~is_root_file=false, {cstate_desc, cstate_filename} as cs) =>
       Linearized(Linearize.transl_anf_module(typed_mod))
     | Linearized(anfed) => Optimized(Optimize.optimize_program(anfed))
     | Optimized(optimized) =>
-      Mashed(Transl_anf.transl_anf_program(optimized))
+      let mashed = Transl_anf.transl_anf_program(optimized);
+      if (Config.debug^) {
+        save_mashed(mashed, cs.cstate_outfile);
+      };
+      Mashed(mashed);
     | Mashed(mashed) =>
       Compiled(Compmod.compile_wasm_module(~name=?cstate_filename, mashed))
     | Compiled(compiled) =>
@@ -289,6 +305,9 @@ let compile_string =
     reset_compiler_state();
     compile_wasi_polyfill();
   };
+  if (is_root_file) {
+    Grain_utils.Config.set_root_config();
+  };
   let cstate = {
     cstate_desc: Initial(InputString(str)),
     cstate_filename: name,
@@ -305,6 +324,9 @@ let compile_file =
     reset_compiler_state();
     compile_wasi_polyfill();
   };
+  if (is_root_file) {
+    Grain_utils.Config.set_root_config();
+  };
   let cstate = {
     cstate_desc: Initial(InputFile(filename)),
     cstate_filename: Some(filename),
@@ -317,18 +339,6 @@ let compile_file =
 
 let anf = Linearize.transl_anf_module;
 
-let save_mashed = (f, outfile) =>
-  switch (compile_file(~is_root_file=false, ~hook=stop_after_mashed, f)) {
-  | {cstate_desc: Mashed(mashed)} =>
-    Grain_utils.Fs_access.ensure_parent_directory_exists(outfile);
-    let mash_string =
-      Sexplib.Sexp.to_string_hum @@ Mashtree.sexp_of_mash_program(mashed);
-    let oc = open_out(outfile);
-    output_string(oc, mash_string);
-    close_out(oc);
-  | _ => failwith("Should be impossible")
-  };
-
 let report_error = loc =>
   Location.(
     Printf.(

compiler/src/compile.rei

@@ -41,8 +41,6 @@ exception InlineFlagsError(Location.t, error);
 
 let default_output_filename: string => string;
 
-let default_mashtree_filename: string => string;
-
 let stop_after_parse: compilation_state => compilation_action;
 
 let stop_after_well_formed: compilation_state => compilation_action;
@@ -85,5 +83,3 @@ let compile_file:
     string
   ) =>
   compilation_state;
-
-let save_mashed: (string, string) => unit;

compiler/src/typed/cmi_format.re

@@ -46,12 +46,25 @@ let cmi_digest_of_yojson =
       "cmi_digest_of_yojson: Invalid Digest: " ++ Yojson.Safe.to_string(d),
     );
 
+let sexp_of_cmi_digest = d => Sexplib.Conv.sexp_of_string(Digest.to_hex(d));
+let cmi_digest_of_sexp =
+  fun
+  | Sexplib.Sexp.Atom(s) as d =>
+    try(Digest.from_hex(s)) {
+    | Invalid_argument(_) =>
+      of_sexp_error("cmi_digest_of_sexp: invalid digest", d)
+    }
+  | d => of_sexp_error("cmi_digest_of_sexp: invalid digest", d);
+
+[@deriving sexp]
+type cmi_crcs = list((string, cmi_digest));
+let rec cmi_crcs_of_yojson = [%of_yojson: list((string, cmi_digest))]
+and cmi_crcs_to_yojson = [%to_yojson: list((string, cmi_digest))];
+
 [@deriving sexp]
-type cmi_crcs = [@sexp.opaque] list((string, option(Digest.t)));
-let rec cmi_crcs_of_yojson = [%of_yojson:
-  list((string, option(cmi_digest)))
-]
-and cmi_crcs_to_yojson = [%to_yojson: list((string, option(cmi_digest)))];
+type cmi_crc = cmi_digest;
+let rec cmi_crc_of_yojson = [%of_yojson: cmi_digest]
+and cmi_crc_to_yojson = [%to_yojson: cmi_digest];
 
 [@deriving (sexp, yojson)]
 type cmi_type_metadata = {
@@ -65,6 +78,7 @@ type cmi_infos = {
   cmi_name: string,
   cmi_sign: Types.signature,
   cmi_crcs,
+  cmi_crc,
   cmi_flags: list(pers_flags),
   cmi_type_metadata,
   cmi_config_sum: string,
@@ -75,25 +89,18 @@ type config_opt =
 
 let config_sum = Config.get_root_config_digest;
 
-let build_full_cmi = (~name, ~sign, ~crcs, ~flags, ~type_metadata) => {
-  let ns_sign = Marshal.to_bytes((name, sign, config_sum()), []);
-  let crc = Digest.bytes(ns_sign);
-  let crcs = [(name, Some(crc)), ...crcs];
-  let cmi_config_sum = config_sum();
-  {
-    cmi_name: name,
-    cmi_sign: sign,
-    cmi_crcs: crcs,
-    cmi_flags: flags,
-    cmi_type_metadata: type_metadata,
-    cmi_config_sum,
-  };
-};
+let build_crc = (~name: string, sign: Types.signature) => {
+  let subst_sign =
+    Subst.with_reset_state(() =>
+      Subst.signature(Subst.for_crc(Subst.identity), sign)
+    );
 
-let cmi_to_crc = ({cmi_name, cmi_sign, cmi_config_sum}) => {
-  let ns_sign = Marshal.to_bytes((cmi_name, cmi_sign, cmi_config_sum), []);
-  let crc = Digest.bytes(ns_sign);
-  crc;
+  let ns_sign =
+    Marshal.to_bytes(
+      (name, subst_sign, Config.get_root_config_digest()),
+      [],
+    );
+  Digest.bytes(ns_sign);
 };
 
 let input_cmi = ic =>

compiler/src/typed/cmi_format.rei

@@ -28,23 +28,16 @@ type cmi_type_metadata = {
 type cmi_infos = {
   cmi_name: string,
   cmi_sign: list(Types.signature_item),
-  cmi_crcs: list((string, option(Digest.t))),
+  cmi_crcs: list((string, Digest.t)),
+  cmi_crc: Digest.t,
   cmi_flags: list(pers_flags),
   cmi_type_metadata,
   cmi_config_sum: string,
 };
 
 let config_sum: unit => string;
 
-let build_full_cmi:
-  (
-    ~name: string,
-    ~sign: list(Types.signature_item),
-    ~crcs: list((string, option(Digest.t))),
-    ~flags: list(pers_flags),
-    ~type_metadata: cmi_type_metadata
-  ) =>
-  cmi_infos;
+let build_crc: (~name: string, Types.signature) => Digest.t;
 
 /* write the magic + the cmi information */
 let serialize_cmi: cmi_infos => bytes;
@@ -55,8 +48,6 @@ let input_cmi: in_channel => cmi_infos;
 /* read a cmi from a filename, checking the magic */
 let read_cmi: string => cmi_infos;
 
-let cmi_to_crc: cmi_infos => Digest.t;
-
 /* Error report */
 
 type error =