Skip to content

Commit e54e9bc

Browse files
committed
fix the 'stuttering' issue in #show
1 parent d9799d3 commit e54e9bc

File tree

2 files changed

+24
-25
lines changed

2 files changed

+24
-25
lines changed

testsuite/tests/tool-toplevel/show.ml

Lines changed: 0 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -131,7 +131,6 @@ type 'a t += A : int t
131131
(* regression tests for #11533 *)
132132
#show Set.OrderedType;;
133133
[%%expect {|
134-
module type OrderedType = Set.OrderedType
135134
module type OrderedType = sig type t val compare : t -> t -> int end
136135
|}];;
137136

@@ -157,15 +156,9 @@ module U = Unit
157156
module type OT = Set.OrderedType
158157
|}];;
159158

160-
(* the stuttering in this example is a bit silly, it seems to be
161-
a result of strengthening that only shows up for aliases on
162-
non-local modules (from another compilation unit).
163-
164-
Note: This behavior predates the regression tracked in #11533. *)
165159
#show U;;
166160
[%%expect {|
167161
module U = Unit
168-
module U = Unit
169162
module U :
170163
sig
171164
type t = unit = ()
@@ -175,11 +168,8 @@ module U :
175168
end
176169
|}];;
177170

178-
(* Similar stuttering here now that (post-11533) module type synonyms
179-
are also followed. *)
180171
#show OT;;
181172
[%%expect {|
182173
module type OT = Set.OrderedType
183-
module type OT = Set.OrderedType
184174
module type OT = sig type t val compare : t -> t -> int end
185175
|}];;

toplevel/topdirs.ml

Lines changed: 24 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -535,6 +535,9 @@ let is_rec_module id md =
535535
Btype.unmark_iterators.it_module_declaration Btype.unmark_iterators md;
536536
rs
537537

538+
let secretly_the_same_path env path1 path2 =
539+
let norm path = Printtyp.rewrite_double_underscore_paths env path in
540+
Path.same (norm path1) (norm path2)
538541

539542
let () =
540543
reg_show_prim "show_module"
@@ -544,19 +547,22 @@ let () =
544547
| Pident id -> id
545548
| _ -> id
546549
in
547-
let rec accum_aliases md acc =
548-
let acc rs =
550+
let rec accum_aliases path md acc =
551+
let def rs =
549552
Sig_module (id, Mp_present,
550553
{md with md_type = trim_signature md.md_type},
551-
rs, Exported) :: acc in
554+
rs, Exported) in
552555
match md.md_type with
553-
| Mty_alias path ->
554-
let md = Env.find_module path env in
555-
accum_aliases md (acc Trec_not)
556+
| Mty_alias new_path ->
557+
let md = Env.find_module new_path env in
558+
accum_aliases new_path md
559+
(if secretly_the_same_path env path new_path
560+
then acc
561+
else def Trec_not :: acc)
556562
| Mty_ident _ | Mty_signature _ | Mty_functor _ ->
557-
List.rev (acc (is_rec_module id md))
563+
List.rev (def (is_rec_module id md) :: acc)
558564
in
559-
accum_aliases md []
565+
accum_aliases path md []
560566
)
561567
"Print the signature of the corresponding module."
562568

@@ -568,16 +574,19 @@ let () =
568574
| Pident id -> id
569575
| _ -> id
570576
in
571-
let rec accum_defs mtd acc =
572-
let acc = Sig_modtype (id, mtd, Exported) :: acc in
577+
let rec accum_defs path mtd acc =
578+
let def = Sig_modtype (id, mtd, Exported) in
573579
match mtd.mtd_type with
574-
| Some (Mty_ident path) ->
575-
let mtd = Env.find_modtype path env in
576-
accum_defs mtd acc
580+
| Some (Mty_ident new_path) ->
581+
let mtd = Env.find_modtype new_path env in
582+
accum_defs new_path mtd
583+
(if secretly_the_same_path env path new_path
584+
then acc
585+
else def :: acc)
577586
| None | Some (Mty_alias _ | Mty_signature _ | Mty_functor _) ->
578-
List.rev acc
587+
List.rev (def :: acc)
579588
in
580-
accum_defs mtd []
589+
accum_defs path mtd []
581590
)
582591
"Print the signature of the corresponding module type."
583592

0 commit comments

Comments
 (0)