Skip to content

Commit

Permalink
fix the 'stuttering' issue in #show
Browse files Browse the repository at this point in the history
  • Loading branch information
gasche committed Dec 1, 2022
1 parent d9799d3 commit e54e9bc
Show file tree
Hide file tree
Showing 2 changed files with 24 additions and 25 deletions.
10 changes: 0 additions & 10 deletions testsuite/tests/tool-toplevel/show.ml
Expand Up @@ -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
|}];;

Expand All @@ -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 = ()
Expand All @@ -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
|}];;
39 changes: 24 additions & 15 deletions toplevel/topdirs.ml
Expand Up @@ -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"
Expand All @@ -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."

Expand All @@ -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."

Expand Down

0 comments on commit e54e9bc

Please sign in to comment.