diff options
| author | Leo White <leo@lpw25.net> | 2022-05-02 18:41:27 +0100 |
|---|---|---|
| committer | Hyunggyu Jang <murasakipurplez5@gmail.com> | 2022-11-11 11:27:41 +0900 |
| commit | ecc1b48ce96ad390a2cfb54e4918046efc8f7175 (patch) | |
| tree | 3b4543a2ceab3217ec939e157622f82b4829f2ce /typing/printtyp.ml | |
| parent | 43c320501271c031052e2b62ec34e933a0d8f36a (diff) | |
| download | ocaml-ecc1b48ce96ad390a2cfb54e4918046efc8f7175.tar.gz | |
Add explicit constructors to Path.t for inline record types
Diffstat (limited to 'typing/printtyp.ml')
| -rw-r--r-- | typing/printtyp.ml | 19 |
1 files changed, 13 insertions, 6 deletions
diff --git a/typing/printtyp.ml b/typing/printtyp.ml index cbe7f35c15..23043e8064 100644 --- a/typing/printtyp.ml +++ b/typing/printtyp.ml @@ -115,6 +115,7 @@ module Namespace = struct let best_class_namespace = function | Papply _ | Pdot _ -> Module + | Pcstr_ty _ | Pext_ty _ -> Type | Pident c -> match location Class c with | Some _ -> Class @@ -385,6 +386,10 @@ let rec rewrite_double_underscore_paths env p = match p with | Pdot (p, s) -> Pdot (rewrite_double_underscore_paths env p, s) + | Pcstr_ty (p, s) -> + Pcstr_ty (rewrite_double_underscore_paths env p, s) + | Pext_ty p -> + Pext_ty (rewrite_double_underscore_paths env p) | Papply (a, b) -> Papply (rewrite_double_underscore_paths env a, rewrite_double_underscore_paths env b) @@ -418,10 +423,10 @@ let rec tree_of_path namespace = function Oide_ident (ident_name namespace id) | Pdot(_, s) as path when non_shadowed_pervasive path -> Oide_ident (Naming_context.pervasives_name namespace s) - | Pdot(Pident t, s) - when namespace=Type && not (Path.is_uident (Ident.name t)) -> - (* [t.A]: inline record of the constructor [A] from type [t] *) - Oide_dot (Oide_ident (ident_name Type t), s) + | Pcstr_ty(p, s) -> + Oide_dot (tree_of_path Type p, s) + | Pext_ty p -> + tree_of_path Other p | Pdot(p, s) -> Oide_dot (tree_of_path Module p, s) | Papply(p1, p2) -> @@ -661,8 +666,9 @@ let penalty s = let rec path_size = function Pident id -> penalty (Ident.name id), -Ident.scope id - | Pdot (p, _) -> + | Pdot (p, _) | Pcstr_ty (p, _) -> let (l, b) = path_size p in (1+l, b) + | Pext_ty p -> path_size p | Papply (p1, p2) -> let (l, b) = path_size p1 in (l + fst (path_size p2), b) @@ -712,8 +718,9 @@ let wrap_printing_env ~error env f = let rec lid_of_path = function Path.Pident id -> Longident.Lident (Ident.name id) - | Path.Pdot (p1, s) -> + | Path.Pdot (p1, s) | Path.Pcstr_ty (p1, s)-> Longident.Ldot (lid_of_path p1, s) + | Path.Pext_ty p -> lid_of_path p | Path.Papply (p1, p2) -> Longident.Lapply (lid_of_path p1, lid_of_path p2) |