From e54e9bc34aa8c4e9ee9b5de053e43dd0772f746a Mon Sep 17 00:00:00 2001
From: Gabriel Scherer <gabriel.scherer@gmail.com>
Date: Thu, 1 Dec 2022 22:37:18 +0100
Subject: [PATCH] fix the 'stuttering' issue in #show

---
 testsuite/tests/tool-toplevel/show.ml | 10 -------
 toplevel/topdirs.ml                   | 39 ++++++++++++++++-----------
 2 files changed, 24 insertions(+), 25 deletions(-)

diff --git a/testsuite/tests/tool-toplevel/show.ml b/testsuite/tests/tool-toplevel/show.ml
index 655d0bfe6b10..28b59d9fdb1e 100644
--- a/testsuite/tests/tool-toplevel/show.ml
+++ b/testsuite/tests/tool-toplevel/show.ml
@@ -131,7 +131,6 @@ type 'a t += A : int t
 (* regression tests for #11533 *)
 #show Set.OrderedType;;
 [%%expect {|
-module type OrderedType = Set.OrderedType
 module type OrderedType = sig type t val compare : t -> t -> int end
 |}];;
 
@@ -157,15 +156,9 @@ module U = Unit
 module type OT = Set.OrderedType
 |}];;
 
-(* the stuttering in this example is a bit silly, it seems to be
-   a result of strengthening that only shows up for aliases on
-   non-local modules (from another compilation unit).
-
-   Note: This behavior predates the regression tracked in #11533.  *)
 #show U;;
 [%%expect {|
 module U = Unit
-module U = Unit
 module U :
   sig
     type t = unit = ()
@@ -175,11 +168,8 @@ module U :
   end
 |}];;
 
-(* Similar stuttering here now that (post-11533) module type synonyms
-   are also followed. *)
 #show OT;;
 [%%expect {|
 module type OT = Set.OrderedType
-module type OT = Set.OrderedType
 module type OT = sig type t val compare : t -> t -> int end
 |}];;
diff --git a/toplevel/topdirs.ml b/toplevel/topdirs.ml
index c47ea27e2efe..bc57e324ab1c 100644
--- a/toplevel/topdirs.ml
+++ b/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,19 +547,22 @@ 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."
 
@@ -568,16 +574,19 @@ let () =
          | Pident id -> id
          | _ -> id
        in
-       let rec accum_defs mtd acc =
-         let acc = Sig_modtype (id, mtd, Exported) :: acc in
+       let rec accum_defs path mtd acc =
+         let def = Sig_modtype (id, mtd, Exported) in
          match mtd.mtd_type with
-         | Some (Mty_ident path) ->
-             let mtd = Env.find_modtype path env in
-             accum_defs mtd acc
+         | 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 acc
+             List.rev (def :: acc)
        in
-       accum_defs mtd []
+       accum_defs path mtd []
     )
     "Print the signature of the corresponding module type."