Merge pull request ocaml#11534 from gasche/follow-synonyms-in-show-mo…

…dule-type

Follow synonyms in #show_module _type

Changes

@@ -78,6 +78,10 @@ OCaml 4.14 maintenance branch
 - #11776: Extend environment with functor parameters in `strengthen_lazy`.
   (Chris Casinghino and Luke Maurer, review by Gabriel Scherer)
 
+- #11533, #11534: follow synonyms again in #show_module_type
+  (this had stopped working in 4.14.0)
+  (Gabriel Scherer, review by Jacques Garrigue, report by Yaron Minsky)
+
 OCaml 4.14.0 (28 March 2022)
 ----------------------------
 

testsuite/tests/tool-toplevel/show.ml

@@ -124,3 +124,52 @@ type _ t += A : int t
 [%%expect{|
 type 'a t += A : int t
 |}];;
+
+
+
+
+(* regression tests for #11533 *)
+#show Set.OrderedType;;
+[%%expect {|
+module type OrderedType = sig type t val compare : t -> t -> int end
+|}];;
+
+(* extra tests after #11533
+
+   The regression in #11533 would only show up when showing values defined
+   outside the current module. Those new tests below test modules and module
+   types from the standard library. To minimize test churn / promotion,
+   we are looking for some that will change as little as possible
+   in the future.
+
+   - For module type it's easy: OrderedType is fixed in stone as
+     changing it would break all code using Set.Make.
+
+   - For modules we use Stdlib.Unit, one of the stdlib modules
+     that is less likely to change very often (there are only
+     so many features you can add to 'unit').
+*)
+module U = Stdlib.Unit;;
+module type OT = Set.OrderedType;;
+[%%expect {|
+module U = Unit
+module type OT = Set.OrderedType
+|}];;
+
+#show U;;
+[%%expect {|
+module U = Unit
+module U :
+  sig
+    type t = unit = ()
+    val equal : t -> t -> bool
+    val compare : t -> t -> int
+    val to_string : t -> string
+  end
+|}];;
+
+#show OT;;
+[%%expect {|
+module type OT = Set.OrderedType
+module type OT = sig type t val compare : t -> t -> int end
+|}];;

toplevel/topdirs.ml

@@ -535,6 +535,9 @@ let is_rec_module id md =
   Btype.unmark_iterators.it_module_declaration Btype.unmark_iterators md;
   rs
 
+let secretly_the_same_path env path1 path2 =
+  let norm path = Printtyp.rewrite_double_underscore_paths env path in
+  Path.same (norm path1) (norm path2)
 
 let () =
   reg_show_prim "show_module"
@@ -544,27 +547,46 @@ let () =
          | Pident id -> id
          | _ -> id
        in
-       let rec accum_aliases md acc =
-         let acc rs =
+       let rec accum_aliases path md acc =
+         let def rs =
            Sig_module (id, Mp_present,
                        {md with md_type = trim_signature md.md_type},
-                       rs, Exported) :: acc in
+                       rs, Exported) in
          match md.md_type with
-         | Mty_alias path ->
-             let md = Env.find_module path env in
-             accum_aliases md (acc Trec_not)
+         | Mty_alias new_path ->
+             let md = Env.find_module new_path env in
+             accum_aliases new_path md
+               (if secretly_the_same_path env path new_path
+                then acc
+                else def Trec_not :: acc)
          | Mty_ident _ | Mty_signature _ | Mty_functor _ ->
-             List.rev (acc (is_rec_module id md))
+             List.rev (def (is_rec_module id md) :: acc)
        in
-       accum_aliases md []
+       accum_aliases path md []
     )
     "Print the signature of the corresponding module."
 
 let () =
   reg_show_prim "show_module_type"
     (fun env loc id lid ->
-       let _path, desc = Env.lookup_modtype ~loc lid env in
-       [ Sig_modtype (id, desc, Exported) ]
+       let path, mtd = Env.lookup_modtype ~loc lid env in
+       let id = match path with
+         | Pident id -> id
+         | _ -> id
+       in
+       let rec accum_defs path mtd acc =
+         let def = Sig_modtype (id, mtd, Exported) in
+         match mtd.mtd_type with
+         | Some (Mty_ident new_path) ->
+             let mtd = Env.find_modtype new_path env in
+             accum_defs new_path mtd
+               (if secretly_the_same_path env path new_path
+                then acc
+                else def :: acc)
+         | None | Some (Mty_alias _ | Mty_signature _ | Mty_functor _) ->
+             List.rev (def :: acc)
+       in
+       accum_defs path mtd []
     )
     "Print the signature of the corresponding module type."