fix(compiler): Fix 'inconsistent assumptions over interface' bug (#2253)

alex-snezhko · web-flow · commit 66e5929b0a51 · 2025-03-30T07:30:45.000Z
diff --git a/compiler/src/codegen/transl_anf.re b/compiler/src/codegen/transl_anf.re
@@ -1112,6 +1112,12 @@ let transl_anf_program =
       ~imports=anf_prog.imports,
       anf_prog.signature,
     );
+
+  Env.add_cmi_to_persistent_structures(
+    anf_prog.prog_loc.loc_start.pos_fname,
+    signature,
+  );
+
   let globals = get_globals();
   let function_table_elements = get_function_table_idents();
   let global_function_table_offset = function_table_global^;
diff --git a/compiler/src/typed/env.re b/compiler/src/typed/env.re
@@ -793,14 +793,12 @@ module Persistent_signature = {
   };
 
   let load =
-    ref((~loc=Location.dummy_loc, unit_name) => {
-      switch (Module_resolution.locate_object_file(~loc, unit_name)) {
-      | filename =>
-        let ret = {filename, cmi: Module_resolution.read_file_cmi(filename)};
-        Some(ret);
-      | exception Not_found => None
+    ref(obj_filename =>
+      {
+        filename: obj_filename,
+        cmi: Module_resolution.read_file_cmi(obj_filename),
       }
-    });
+    );
 };
 
 let acknowledge_pers_struct = (check, {Persistent_signature.filename, cmi}) => {
@@ -846,24 +844,21 @@ let acknowledge_pers_struct = (check, {Persistent_signature.filename, cmi}) => {
   ps;
 };
 
-let find_pers_struct = (~loc, check, filepath) => {
-  switch (Hashtbl.find(persistent_structures, filepath)) {
-  | Some(ps) => ps
+let find_pers_struct = (~loc, check, src_filepath) => {
+  let obj_filepath = Module_resolution.locate_object_file(~loc, src_filepath);
+
+  switch (Hashtbl.find(persistent_structures, obj_filepath)) {
+  | Some(ps) =>
+    add_import(src_filepath);
+    ps;
   | None => raise(Not_found)
   | exception Not_found =>
     switch (can_load_modules^) {
     | Cannot_load_modules(_) => raise(Not_found)
     | Can_load_modules =>
-      let ps = {
-        switch (Persistent_signature.load^(~loc, filepath)) {
-        | Some(ps) => ps
-        | None =>
-          Hashtbl.add(persistent_structures, filepath, None);
-          raise(Not_found);
-        };
-      };
+      let ps = Persistent_signature.load^(obj_filepath);
 
-      add_import(filepath);
+      add_import(src_filepath);
       acknowledge_pers_struct(check, ps);
     }
   };
@@ -873,62 +868,8 @@ let load_pers_struct = (~loc, filepath) => {
   find_pers_struct(~loc, false, filepath).ps_name;
 };
 
-/* Emits a warning if there is no valid cmi for name */
-let check_pers_struct = (~loc, name, filename) =>
-  try(ignore(find_pers_struct(~loc, false, filename))) {
-  | Not_found =>
-    let err = No_module_file(name, None);
-    error(err);
-  | Cmi_format.Error(err) =>
-    let msg = Format.asprintf("%a", Cmi_format.report_error, err);
-    let err = No_module_file(name, Some(msg));
-    error(err);
-  | Error(err) =>
-    let msg =
-      switch (err) {
-      | Illegal_renaming(name, ps_name, filename) =>
-        Format.asprintf(
-          " %a@ contains the compiled interface for @ %s when %s was expected",
-          Location.print_filename,
-          filename,
-          ps_name,
-          name,
-        )
-      | Inconsistent_import(_) => assert(false)
-      | Depend_on_unsafe_string_unit(name, _) =>
-        Printf.sprintf("%s uses -unsafe-string", name)
-      | Unbound_label(_) => assert(false)
-      | Unbound_label_with_alt(_) => assert(false)
-      | Unbound_module(_) => assert(false)
-      | Missing_module(_) => assert(false)
-      | No_module_file(_) => assert(false)
-      | Value_not_found_in_module(_) => assert(false)
-      | Module_not_found_in_module(_) => assert(false)
-      | Type_not_found_in_module(_) => assert(false)
-      | Exception_not_found_in_module(_) => assert(false)
-      | Illegal_value_name(_) => assert(false)
-      | Cyclic_dependencies(_) => assert(false)
-      };
-
-    let err = No_module_file(name, Some(msg));
-    error(err);
-  };
-
 let find_pers_struct = filename => find_pers_struct(true, filename);
 
-let check_pers_struct = (~loc, name, filename) =>
-  if (!Hashtbl.mem(persistent_structures, filename)) {
-    /* PR#6843: record the weak dependency ([add_import]) regardless of
-       whether the check succeeds, to help make builds more
-       deterministic. */
-    add_import(filename);
-    if (Warnings.is_active(Warnings.NoCmiFile("", None))) {
-      add_delayed_check_forward^(() =>
-        check_pers_struct(~loc, name, filename)
-      );
-    };
-  };
-
 let rec find_module_descr = (path, filename, env) => {
   switch (path) {
   | PIdent(id) =>
@@ -2245,16 +2186,7 @@ let crc_of_unit = filename => {
 
 let imports = () => {
   let imported_units = StringSet.elements(imported_units^);
-  let resolved_units =
-    List.map(
-      unit => Module_resolution.locate_unit_object_file(unit),
-      imported_units,
-    );
-  List.map2(
-    (unit, resolved_unit) => (unit, crc_of_unit(resolved_unit)),
-    imported_units,
-    resolved_units,
-  );
+  List.map(unit => (unit, crc_of_unit(unit)), imported_units);
 };
 
 /* Build a module signature */
@@ -2269,7 +2201,7 @@ let build_signature_with_imports =
   let flags = [];
   let crc = Cmi_format.build_crc(~name=modname, sg);
 
-  let cmi = {
+  {
     cmi_name: modname,
     cmi_sign: sg,
     cmi_crcs: imports,
@@ -2278,30 +2210,33 @@ let build_signature_with_imports =
     cmi_type_metadata: type_metadata,
     cmi_config_sum: Cmi_format.config_sum(),
   };
+};
 
+let add_cmi_to_persistent_structures = (filename, cmi) => {
   let comps =
     components_of_module(
-      ~deprecated,
+      ~deprecated=None,
       ~loc=Location.dummy_loc,
       empty,
       Subst.identity,
-      PIdent(Ident.create_persistent(modname)),
-      TModSignature(sg),
+      PIdent(Ident.create_persistent(cmi.cmi_name)),
+      TModSignature(cmi.cmi_sign),
     );
 
   let ps = {
-    ps_name: modname,
-    ps_sig: lazy(Subst.signature(Subst.identity, sg)),
+    ps_name: cmi.cmi_name,
+    ps_sig: lazy(Subst.signature(Subst.identity, cmi.cmi_sign)),
     ps_comps: comps,
     ps_crcs: cmi.cmi_crcs,
     ps_crc: cmi.cmi_crc,
-    ps_filename: Module_resolution.get_object_name(filename),
+    ps_filename:
+      Module_resolution.get_object_name(
+        Filepath.to_string(Filepath.String.derelativize(filename)),
+      ),
     ps_flags: cmi.cmi_flags,
   };
 
   save_pers_struct(ps);
-
-  cmi;
 };
 
 let build_signature = (~deprecated=?, sg, modname, filename, type_metadata) =>
diff --git a/compiler/src/typed/env.rei b/compiler/src/typed/env.rei
@@ -303,9 +303,11 @@ module Persistent_signature: {
       the .cmi file in the load path. This function can be overridden to load
       it from memory, for instance to build a self-contained toplevel. */
 
-  let load: ref((~loc: Location.t=?, string) => option(t));
+  let load: ref(string => t);
 };
 
+let add_cmi_to_persistent_structures: (string, Cmi_format.cmi_infos) => unit;
+
 /* Summaries -- compact representation of an environment, to be
    exported in debugging information. */
 
diff --git a/compiler/test/__snapshots__/basic_functionality.1bf5759c.0.snapshot b/compiler/test/__snapshots__/basic_functionality.1bf5759c.0.snapshot
@@ -55,51 +55,51 @@ basic functionality › unsafe_wasm_globals
     (((instr_desc
        (MDrop
         ((instr_desc
-          (MCallKnown (func printI32_1152)
+          (MCallKnown (func printI32_1076)
            (closure
             ((immediate_desc
-              (MImmBinding (MGlobalBind printI32_1152 Managed)))
+              (MImmBinding (MGlobalBind printI32_1076 Managed)))
              (immediate_analyses ((last_usage Unknown)))))
            (func_type (((Unmanaged WasmI32)) ((Unmanaged WasmI32))))
            (args
             (((immediate_desc
-               (MImmBinding (MGlobalBind _I32_VAL_1153 (Unmanaged WasmI32))))
+               (MImmBinding (MGlobalBind _I32_VAL_1077 (Unmanaged WasmI32))))
               (immediate_analyses ((last_usage Unknown))))))))))))
      ((instr_desc
        (MDrop
         ((instr_desc
-          (MCallKnown (func printI64_1154)
+          (MCallKnown (func printI64_1078)
            (closure
             ((immediate_desc
-              (MImmBinding (MGlobalBind printI64_1154 Managed)))
+              (MImmBinding (MGlobalBind printI64_1078 Managed)))
              (immediate_analyses ((last_usage Unknown)))))
            (func_type (((Unmanaged WasmI64)) ((Unmanaged WasmI32))))
            (args
             (((immediate_desc
-               (MImmBinding (MGlobalBind _I64_VAL_1155 (Unmanaged WasmI64))))
+               (MImmBinding (MGlobalBind _I64_VAL_1079 (Unmanaged WasmI64))))
               (immediate_analyses ((last_usage Unknown))))))))))))
      ((instr_desc
        (MDrop
         ((instr_desc
-          (MCallKnown (func printF32_1156)
+          (MCallKnown (func printF32_1080)
            (closure
             ((immediate_desc
-              (MImmBinding (MGlobalBind printF32_1156 Managed)))
+              (MImmBinding (MGlobalBind printF32_1080 Managed)))
              (immediate_analyses ((last_usage Unknown)))))
            (func_type (((Unmanaged WasmF32)) ((Unmanaged WasmI32))))
            (args
             (((immediate_desc
-               (MImmBinding (MGlobalBind _F32_VAL_1157 (Unmanaged WasmF32))))
+               (MImmBinding (MGlobalBind _F32_VAL_1081 (Unmanaged WasmF32))))
               (immediate_analyses ((last_usage Unknown))))))))))))
      ((instr_desc
-       (MReturnCallKnown (func printF64_1158)
+       (MReturnCallKnown (func printF64_1082)
         (closure
-         ((immediate_desc (MImmBinding (MGlobalBind printF64_1158 Managed)))
+         ((immediate_desc (MImmBinding (MGlobalBind printF64_1082 Managed)))
           (immediate_analyses ((last_usage Unknown)))))
         (func_type (((Unmanaged WasmF64)) ((Unmanaged WasmI32))))
         (args
          (((immediate_desc
-            (MImmBinding (MGlobalBind _F64_VAL_1159 (Unmanaged WasmF64))))
+            (MImmBinding (MGlobalBind _F64_VAL_1083 (Unmanaged WasmF64))))
            (immediate_analyses ((last_usage Unknown)))))))))))
    (main_body_stack_size
     ((stack_size_ptr 0) (stack_size_i32 0) (stack_size_i64 0)
diff --git a/compiler/test/__snapshots__/includes.a3212bd0.0.snapshot b/compiler/test/__snapshots__/includes.a3212bd0.0.snapshot
@@ -9,7 +9,7 @@ includes › include_relative_path3
    (main_body
     (((instr_desc
        (MImmediate
-        ((immediate_desc (MImmBinding (MGlobalBind j_1116 Managed)))
+        ((immediate_desc (MImmBinding (MGlobalBind j_1040 Managed)))
          (immediate_analyses ((last_usage Last)))))))))
    (main_body_stack_size
     ((stack_size_ptr 0) (stack_size_i32 0) (stack_size_i64 0)
diff --git a/compiler/test/__snapshots__/includes.c0c0d5ca.0.snapshot b/compiler/test/__snapshots__/includes.c0c0d5ca.0.snapshot
@@ -36,24 +36,24 @@ includes › include_relative_path4
        (MStore
         (((MLocalBind 1 Managed)
           ((instr_desc
-            (MCallKnown (func bar_1119)
+            (MCallKnown (func bar_1043)
              (closure
               ((immediate_desc
                 (MIncRef
                  ((immediate_desc
-                   (MImmBinding (MGlobalBind bar_1119 Managed)))
+                   (MImmBinding (MGlobalBind bar_1043 Managed)))
                   (immediate_analyses ((last_usage Last))))))
                (immediate_analyses ((last_usage Unknown)))))
              (func_type ((Managed) (Managed)))
              (args
               (((immediate_desc (MImmConst (MConstI32 2)))
                 (immediate_analyses ((last_usage Unknown))))))))))))))
      ((instr_desc
-       (MReturnCallKnown (func print_1116)
+       (MReturnCallKnown (func print_1040)
         (closure
          ((immediate_desc
            (MIncRef
-            ((immediate_desc (MImmBinding (MGlobalBind print_1116 Managed)))
+            ((immediate_desc (MImmBinding (MGlobalBind print_1040 Managed)))
              (immediate_analyses ((last_usage Last))))))
           (immediate_analyses ((last_usage Unknown)))))
         (func_type ((Managed Managed) ((Unmanaged WasmI32))))
diff --git a/compiler/test/__snapshots__/includes.f2bf866b.0.snapshot b/compiler/test/__snapshots__/includes.f2bf866b.0.snapshot
@@ -10,7 +10,7 @@ includes › include_all_constructor
              (MADT
               ((immediate_desc (MImmConst (MConstI32 609193316)))
                (immediate_analyses ((last_usage Unknown))))
-              ((immediate_desc (MImmConst (MConstI32 1121)))
+              ((immediate_desc (MImmConst (MConstI32 1045)))
                (immediate_analyses ((last_usage Unknown))))
               ((immediate_desc (MImmConst (MConstI32 0)))
                (immediate_analyses ((last_usage Unknown))))
@@ -20,7 +20,7 @@ includes › include_all_constructor
         (MADT
          ((immediate_desc (MImmConst (MConstI32 609193316)))
           (immediate_analyses ((last_usage Unknown))))
-         ((immediate_desc (MImmConst (MConstI32 1121)))
+         ((immediate_desc (MImmConst (MConstI32 1045)))
           (immediate_analyses ((last_usage Unknown))))
          ((immediate_desc (MImmConst (MConstI32 1)))
           (immediate_analyses ((last_usage Unknown))))
diff --git a/compiler/test/__snapshots__/provides.0ef7e7b3.0.snapshot b/compiler/test/__snapshots__/provides.0ef7e7b3.0.snapshot
@@ -2,19 +2,19 @@ provides › provide7
 ((mash_code
   ((functions ())
    (imports
-    (((mimp_id ((stamp 1122) (name x))) (mimp_mod provideAll.gr)
+    (((mimp_id ((stamp 1046) (name x))) (mimp_mod provideAll.gr)
       (mimp_name x) (mimp_type (MGlobalImport Managed true))
       (mimp_kind MImportGrain) (mimp_setup MCallGetter) (mimp_used true))))
    (exports ())
    (main_body
     (((instr_desc
        (MImmediate
-        ((immediate_desc (MImmBinding (MGlobalBind x_1122 Managed)))
+        ((immediate_desc (MImmBinding (MGlobalBind x_1046 Managed)))
          (immediate_analyses ((last_usage Last)))))))))
    (main_body_stack_size
     ((stack_size_ptr 0) (stack_size_i32 0) (stack_size_i64 0)
      (stack_size_f32 0) (stack_size_f64 0)))
    (globals ()) (function_table_elements ())
-   (global_function_table_offset ((stamp 1123) (name function_table_global)))
+   (global_function_table_offset ((stamp 1047) (name function_table_global)))
    (compilation_mode Normal) (type_metadata <opaque>)))
  (signature <opaque>))
diff --git a/compiler/test/__snapshots__/provides.82c10ab4.0.snapshot b/compiler/test/__snapshots__/provides.82c10ab4.0.snapshot
diff --git a/compiler/test/__snapshots__/provides.f378d570.0.snapshot b/compiler/test/__snapshots__/provides.f378d570.0.snapshot
