Add `remove_aliases` parameter to `scrape_for_type_of`

typing/mtype.ml

@@ -401,14 +401,14 @@ let collect_arg_paths mty =
   PathSet.fold (fun p -> Ident.Set.union (collect_ids !subst !bindings p))
     !paths Ident.Set.empty
 
-let rec remove_aliases env excl mty =
+let rec remove_aliases_mty env excl mty =
   match mty with
     Mty_signature sg ->
       Mty_signature (remove_aliases_sig env excl sg)
   | Mty_alias _ ->
       let mty' = Env.scrape_alias env mty in
       if mty' = mty then mty else
-      remove_aliases env excl mty'
+      remove_aliases_mty env excl mty'
   | mty ->
       mty
 
@@ -421,7 +421,7 @@ and remove_aliases_sig env excl sg =
           Mty_alias _ when Ident.Set.mem id excl ->
             md.md_type
         | mty ->
-            remove_aliases env excl mty
+            remove_aliases_mty env excl mty
       in
       Sig_module(id, {md with md_type = mty} , rs) ::
       remove_aliases_sig (Env.add_module id mty env) excl rem
@@ -431,12 +431,14 @@ and remove_aliases_sig env excl sg =
   | it :: rem ->
       it :: remove_aliases_sig env excl rem
 
-let remove_aliases env sg =
-  let excl = collect_arg_paths sg in
-  (* PathSet.iter (fun p -> Format.eprintf "%a@ " Printtyp.path p) excl;
-  Format.eprintf "@."; *)
-  remove_aliases env excl sg
 
+let scrape_for_type_of ~remove_aliases env mty =
+  if remove_aliases then begin
+    let excl = collect_arg_paths mty in
+    remove_aliases_mty env excl mty
+  end else begin
+    scrape_for_type_of env mty
+  end
 
 (* Lower non-generalizable type variables *)
 

typing/mtype.mli

@@ -21,7 +21,8 @@ val scrape: Env.t -> module_type -> module_type
         (* Expand toplevel module type abbreviations
            till hitting a "hard" module type (signature, functor,
            or abstract module type ident. *)
-val scrape_for_type_of: Env.t -> module_type -> module_type
+val scrape_for_type_of:
+  remove_aliases:bool -> Env.t -> module_type -> module_type
         (* Expand module aliases *)
 val freshen: module_type -> module_type
         (* Return an alpha-equivalent copy of the given module type
@@ -44,5 +45,4 @@ val enrich_typedecl: Env.t -> Path.t -> Ident.t -> type_declaration ->
   type_declaration
 val type_paths: Env.t -> Path.t -> module_type -> Path.t list
 val contains_type: Env.t -> module_type -> bool
-val remove_aliases: Env.t -> module_type -> module_type
 val lower_nongen: int -> module_type -> unit

typing/typemod.ml

@@ -401,12 +401,7 @@ let merge_constraint initial_env remove_aliases loc sg constr =
       when Ident.name id = s ->
         let path, md' = Typetexp.find_module initial_env loc lid'.txt in
         let mty = md'.md_type in
-        let mty =
-          if remove_aliases then
-            Mtype.remove_aliases env mty
-          else
-            Mtype.scrape_for_type_of env mty
-        in
+        let mty = Mtype.scrape_for_type_of ~remove_aliases env mty in
         let md'' = { md' with md_type = mty } in
         let newmd = Mtype.strengthen_decl ~aliasable:false env md'' path in
         ignore(Includemod.modtypes ~loc env newmd.md_type md.md_type);
@@ -1769,13 +1764,7 @@ let type_module_type_of env smod =
     | _ -> type_module env smod
   in
   let mty = tmty.mod_type in
-  let mty =
-    if remove_aliases then
-      (* PR#6307: expand aliases at root and submodules *)
-      Mtype.remove_aliases env mty
-    else
-      Mtype.scrape_for_type_of env mty
-  in
+  let mty = Mtype.scrape_for_type_of ~remove_aliases env mty in
   (* PR#5036: must not contain non-generalized type variables *)
   if not (closed_modtype env mty) then
     raise(Error(smod.pmod_loc, env, Non_generalizable_module mty));