flambda-backend: Add code path to read .cmi without adding to environ…

…ment (#1674)

Currently, every time a .cmi is read for any reason, we bind the name of the
module in the environment. In nearly every case, this is undesirable: for
instance, if we're reading the .cmi for the current module, we do _not_ want
to add the current module to its own environment. This behavior is largely
benign at the moment since we read .cmi files after typechecking, but
parameterised libraries will complicate this picture.

debugger/loadprinter.ml

@@ -99,7 +99,7 @@ let init () =
   let topdirs =
     Filename.concat !Parameters.topdirs_path "topdirs.cmi" in
   let topdirs_unit = "Topdirs" |> Compilation_unit.of_string in
-  ignore (Env.read_signature topdirs_unit topdirs)
+  ignore (Env.read_signature topdirs_unit topdirs ~add_binding:true)
 
 let match_printer_type desc typename =
   let printer_type =

typing/env.ml

@@ -974,8 +974,9 @@ let imports () = Persistent_env.imports !persistent_env
 let import_crcs ~source crcs =
   Persistent_env.import_crcs !persistent_env ~source crcs
 
-let read_pers_mod modname filename =
+let read_pers_mod modname filename ~add_binding =
   Persistent_env.read !persistent_env read_sign_of_cmi modname filename
+    ~add_binding
 
 let find_pers_mod name =
   Persistent_env.find !persistent_env read_sign_of_cmi name
@@ -2617,8 +2618,10 @@ let open_signature
   else open_signature None root env
 
 (* Read a signature from a file *)
-let read_signature modname filename =
-  let mda = read_pers_mod (Compilation_unit.name modname) filename in
+let read_signature modname filename ~add_binding =
+  let mda =
+    read_pers_mod (Compilation_unit.name modname) filename ~add_binding
+  in
   let md = Subst.Lazy.force_module_decl mda.mda_declaration in
   match md.md_type with
   | Mty_signature sg -> sg

typing/env.mli

@@ -419,8 +419,11 @@ val set_unit_name: Compilation_unit.t option -> unit
 val get_unit_name: unit -> Compilation_unit.t option
 
 (* Read, save a signature to/from a file *)
-val read_signature: Compilation_unit.t -> filepath -> signature
-        (* Arguments: module name, file name. Results: signature. *)
+val read_signature:
+  Compilation_unit.t -> filepath -> add_binding:bool -> signature
+        (* Arguments: module name, file name, [add_binding] flag.
+           Results: signature. If [add_binding] is true, creates an entry for
+           the module in the environment. *)
 val save_signature:
   alerts:alerts -> signature -> Compilation_unit.t -> filepath
   -> Cmi_format.cmi_infos_lazy

typing/persistent_env.ml

@@ -181,7 +181,7 @@ let save_pers_struct penv crc comp_unit flags filename =
   Consistbl.set crc_units modname comp_unit crc filename;
   add_import penv modname
 
-let acknowledge_pers_struct penv check modname pers_sig pm =
+let process_pers_struct penv check modname pers_sig =
   let { Persistent_signature.filename; cmi } = pers_sig in
   let name = cmi.cmi_name in
   let crcs = cmi.cmi_crcs in
@@ -216,16 +216,24 @@ let acknowledge_pers_struct penv check modname pers_sig pm =
         error (Direct_reference_from_wrong_package (name, filename, prefix));
   | None -> ()
   end;
+  ps
+
+let bind_pers_struct penv modname ps pm =
   let {persistent_structures; _} = penv in
-  Hashtbl.add persistent_structures modname (Found (ps, pm));
+  Hashtbl.add persistent_structures modname (Found (ps, pm))
+
+let acknowledge_pers_struct penv check modname pers_sig pm =
+  let ps = process_pers_struct penv check modname pers_sig in
+  bind_pers_struct penv modname ps pm;
   ps
 
-let read_pers_struct penv val_of_pers_sig check modname filename =
+let read_pers_struct penv val_of_pers_sig check modname filename ~add_binding =
   add_import penv modname;
   let cmi = read_cmi_lazy filename in
   let pers_sig = { Persistent_signature.filename; cmi } in
   let pm = val_of_pers_sig pers_sig in
-  let ps = acknowledge_pers_struct penv check modname pers_sig pm in
+  let ps = process_pers_struct penv check modname pers_sig in
+  if add_binding then bind_pers_struct penv modname ps pm;
   (ps, pm)
 
 let find_pers_struct penv val_of_pers_sig check name =
@@ -297,8 +305,8 @@ let check_pers_struct penv f ~loc name =
       let warn = Warnings.No_cmi_file(name_as_string, Some msg) in
         Location.prerr_warning loc warn
 
-let read penv f modname filename =
-  snd (read_pers_struct penv f true modname filename)
+let read penv f modname filename ~add_binding =
+  snd (read_pers_struct penv f true modname filename ~add_binding)
 
 let find penv f name =
   snd (find_pers_struct penv f true name)

typing/persistent_env.mli

@@ -59,8 +59,10 @@ val clear_missing : 'a t -> unit
 
 val fold : 'a t -> (Compilation_unit.Name.t -> 'a -> 'b -> 'b) -> 'b -> 'b
 
+(* If [add_binding] is false, reads the signature from the .cmi but does not
+   bind the module name in the environment. *)
 val read : 'a t -> (Persistent_signature.t -> 'a)
-  -> Compilation_unit.Name.t -> filepath -> 'a
+  -> Compilation_unit.Name.t -> filepath -> add_binding:bool -> 'a
 val find : 'a t -> (Persistent_signature.t -> 'a)
   -> Compilation_unit.Name.t -> 'a
 

typing/typemod.ml

@@ -3256,7 +3256,8 @@ let type_implementation sourcefile outputprefix modulename initial_env ast =
             with Not_found ->
               raise(Error(Location.in_file sourcefile, Env.empty,
                           Interface_not_compiled sourceintf)) in
-          let dclsig = Env.read_signature modulename intf_file in
+          let dclsig =
+            Env.read_signature modulename intf_file ~add_binding:false in
           let coercion, shape =
             Profile.record_call "check_sig" (fun () ->
               Includemod.compunit initial_env ~mark:Mark_positive
@@ -3389,14 +3390,15 @@ let package_units initial_env objfiles cmifile modulename =
            |> Compilation_unit.Name.of_string
          in
          let modname = Compilation_unit.create_child modulename unit in
-         let sg = Env.read_signature modname (pref ^ ".cmi") in
+         let sg =
+           Env.read_signature modname (pref ^ ".cmi") ~add_binding:false in
          if Filename.check_suffix f ".cmi" &&
             not(Mtype.no_code_needed_sig (Lazy.force Env.initial_safe_string)
                   sg)
          then raise(Error(Location.none, Env.empty,
                           Implementation_is_required f));
          Compilation_unit.name modname,
-         Env.read_signature modname (pref ^ ".cmi"))
+         Env.read_signature modname (pref ^ ".cmi") ~add_binding:false)
       objfiles in
   (* Compute signature of packaged unit *)
   Ident.reinit();
@@ -3419,7 +3421,7 @@ let package_units initial_env objfiles cmifile modulename =
       raise(Error(Location.in_file mlifile, Env.empty,
                   Interface_not_compiled mlifile))
     end;
-    let dclsig = Env.read_signature modulename cmifile in
+    let dclsig = Env.read_signature modulename cmifile ~add_binding:false in
     let cc, _shape =
       Includemod.compunit initial_env ~mark:Mark_both
         "(obtained by packing)" sg mlifile dclsig shape