这是indexloc提供的服务,不要输入任何密码
Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion src/ocaml/typing/persistent_env.ml
Original file line number Diff line number Diff line change
Expand Up @@ -280,7 +280,7 @@ let register_pers_for_short_paths penv modname ps components =
in
let modname_as_string = Compilation_unit.Name.to_string modname in
Short_paths.Basis.load (short_paths_basis penv) modname_as_string
deps alias_deps desc deprecated
deps alias_deps desc ps.ps_import.imp_visibility deprecated
(* Reading persistent structures from .cmi files *)

let save_import penv crc modname impl flags filename =
Expand Down
22 changes: 14 additions & 8 deletions src/ocaml/typing/short_paths.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1098,13 +1098,13 @@ module Shortest = struct
(fun desc ->
match desc with
| Desc.Type(id, desc, conc, dpr) ->
Component.Type(origin, id, desc, local_or_open conc, dpr)
Component.Type(origin, id, desc, local_or_open conc, Desc.visibility_of_deprecated dpr)
| Desc.Class_type(id, desc, conc, dpr) ->
Component.Class_type(origin, id, desc, local_or_open conc, dpr)
Component.Class_type(origin, id, desc, local_or_open conc, Desc.visibility_of_deprecated dpr)
| Desc.Module_type(id, desc, conc, dpr) ->
Component.Module_type(origin, id, desc, local_or_open conc, dpr)
Component.Module_type(origin, id, desc, local_or_open conc, Desc.visibility_of_deprecated dpr)
| Desc.Module(id, desc, conc, dpr) ->
Component.Module(origin, id, desc, local_or_open conc, dpr)
Component.Module(origin, id, desc, local_or_open conc, Desc.visibility_of_deprecated dpr)
| Desc.Declare_type id ->
Component.Declare_type(origin, id)
| Desc.Declare_class_type id ->
Expand Down Expand Up @@ -1743,6 +1743,7 @@ module Basis = struct
depends : string list;
alias_depends : string list;
desc : Desc.Module.t;
visibility : Load_path.visibility;
deprecated : Desc.deprecated; }

type t =
Expand Down Expand Up @@ -1790,11 +1791,16 @@ module Basis = struct
let update_shortest t additions loads =
let components =
List.map
(fun { name; desc; deprecated; _ } ->
(fun { name; desc; visibility=load_visibility; deprecated; _ } ->
let index = String_map.find name t.assignment in
let origin = Origin.Dependency index in
let id = Ident.global name in
Component.Module(origin, id, desc, Component.Global, deprecated))
let component_visibility : Desc.visibility =
match load_visibility, deprecated with
| Hidden, _ | _, Deprecated -> Hidden
| Visible, Not_deprecated -> Visible
in
Component.Module(origin, id, desc, Component.Global, component_visibility))
loads
in
let components =
Expand Down Expand Up @@ -1838,8 +1844,8 @@ module Basis = struct
let add t name =
t.pending_additions <- String_set.add name t.pending_additions

let load t name depends alias_depends desc deprecated =
let load = { name; depends; alias_depends; desc; deprecated } in
let load t name depends alias_depends desc visibility deprecated =
let load = { name; depends; alias_depends; desc; visibility; deprecated } in
t.pending_loads <- load :: t.pending_loads

end
Expand Down
2 changes: 1 addition & 1 deletion src/ocaml/typing/short_paths.mli
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,7 @@ module Basis : sig
val add : t -> string -> unit

val load : t -> string -> string list -> string list ->
Desc.Module.t -> Desc.deprecated -> unit
Desc.Module.t -> Load_path.visibility -> Desc.deprecated -> unit

end

Expand Down
104 changes: 58 additions & 46 deletions src/ocaml/typing/short_paths_graph.ml
Original file line number Diff line number Diff line change
Expand Up @@ -44,6 +44,14 @@ module Desc = struct
| Deprecated
| Not_deprecated

type visibility =
| Visible
| Hidden

let visibility_of_deprecated = function
| Deprecated -> Hidden
| Not_deprecated -> Visible

module Type = struct

type t =
Expand Down Expand Up @@ -220,24 +228,24 @@ let hidden_ident id =
Since 5.0.0 unsafe_string is always false *)
hidden_name (Ident.name id)

let hidden_definition deprecated name =
match deprecated with
| Desc.Deprecated -> true
| Desc.Not_deprecated -> hidden_name name
let hidden_definition visibility name =
match visibility with
| Desc.Hidden -> true
| Desc.Visible -> hidden_name name

let hidden_base_definition deprecated id =
match deprecated with
| Desc.Deprecated -> true
| Desc.Not_deprecated -> hidden_ident id
let hidden_base_definition visibility id =
match visibility with
| Desc.Hidden -> true
| Desc.Visible -> hidden_ident id

module rec Type : sig

type t

val base : Origin.t -> Ident.t -> Desc.Type.t option -> Desc.deprecated -> t
val base : Origin.t -> Ident.t -> Desc.Type.t option -> Desc.visibility -> t

val child :
Module.normalized -> string -> Desc.Type.t option -> Desc.deprecated -> t
Module.normalized -> string -> Desc.Type.t option -> Desc.visibility -> t

val declare : Origin.t -> Ident.t -> t

Expand Down Expand Up @@ -288,18 +296,18 @@ end = struct
| Some (Subst(p, ns)) -> Subst(p, ns)
| Some (Alias alias) -> Alias alias

let base origin id desc deprecated =
let base origin id desc visibility =
let path = Path.Pident id in
let hidden = hidden_base_definition deprecated id in
let hidden = hidden_base_definition visibility id in
let sort = Sort.Defined in
let definition = definition_of_desc desc in
Definition { origin; path; hidden; sort; definition }

let child md name desc deprecated =
let child md name desc visibility =
let origin = Module.raw_origin md in
let sort = Module.raw_sort md in
let path = Path.Pdot(Module.raw_path md, name) in
let hidden = hidden_definition deprecated name in
let hidden = hidden_definition visibility name in
let definition = definition_of_desc desc in
Definition { origin; path; hidden; sort; definition }

Expand Down Expand Up @@ -387,11 +395,11 @@ and Class_type : sig
type t

val base :
Origin.t -> Ident.t -> Desc.Class_type.t option -> Desc.deprecated -> t
Origin.t -> Ident.t -> Desc.Class_type.t option -> Desc.visibility -> t

val child :
Module.normalized -> string ->
Desc.Class_type.t option -> Desc.deprecated -> t
Desc.Class_type.t option -> Desc.visibility -> t

val declare : Origin.t -> Ident.t -> t

Expand Down Expand Up @@ -438,18 +446,18 @@ end = struct
| Some (Subst(p, ns)) -> Subst(p, ns)
| Some (Alias alias) -> Alias alias

let base origin id desc deprecated =
let base origin id desc visibility =
let path = Path.Pident id in
let hidden = hidden_base_definition deprecated id in
let hidden = hidden_base_definition visibility id in
let sort = Sort.Defined in
let definition = definition_of_desc desc in
Definition { origin; path; hidden; sort; definition }

let child md name desc deprecated =
let child md name desc visibility =
let origin = Module.raw_origin md in
let sort = Module.raw_sort md in
let path = Path.Pdot(Module.raw_path md, name) in
let hidden = hidden_definition deprecated name in
let hidden = hidden_definition visibility name in
let definition = definition_of_desc desc in
Definition { origin; path; hidden; sort; definition }

Expand Down Expand Up @@ -533,11 +541,11 @@ and Module_type : sig
type t

val base :
Origin.t -> Ident.t -> Desc.Module_type.t option -> Desc.deprecated -> t
Origin.t -> Ident.t -> Desc.Module_type.t option -> Desc.visibility -> t

val child :
Module.normalized -> string ->
Desc.Module_type.t option -> Desc.deprecated -> t
Desc.Module_type.t option -> Desc.visibility -> t

val declare : Origin.t -> Ident.t -> t

Expand Down Expand Up @@ -572,9 +580,9 @@ end = struct
sort : Sort.t;
definition : definition; }

let base origin id desc deprecated =
let base origin id desc visibility =
let path = Path.Pident id in
let hidden = hidden_base_definition deprecated id in
let hidden = hidden_base_definition visibility id in
let sort = Sort.Defined in
let definition =
match desc with
Expand All @@ -584,11 +592,11 @@ end = struct
in
Definition { origin; path; hidden; sort; definition }

let child md name desc deprecated =
let child md name desc visibility =
let origin = Module.raw_origin md in
let sort = Module.raw_sort md in
let path = Path.Pdot (Module.raw_path md, name) in
let hidden = hidden_definition deprecated name in
let hidden = hidden_definition visibility name in
let definition =
match desc with
| None -> Unknown
Expand Down Expand Up @@ -662,10 +670,10 @@ and Module : sig
type normalized

val base :
Origin.t -> Ident.t -> Desc.Module.t option -> Desc.deprecated -> t
Origin.t -> Ident.t -> Desc.Module.t option -> Desc.visibility -> t

val child :
normalized -> string -> Desc.Module.t option -> Desc.deprecated -> t
normalized -> string -> Desc.Module.t option -> Desc.visibility -> t

val application : normalized -> t -> Desc.Module.t option -> t

Expand Down Expand Up @@ -742,9 +750,9 @@ end = struct
sort : Sort.t;
definition : definition; }

let base origin id desc deprecated =
let base origin id desc visibility =
let path = Path.Pident id in
let hidden = hidden_base_definition deprecated id in
let hidden = hidden_base_definition visibility id in
let sort = Sort.Defined in
let definition =
match desc with
Expand All @@ -760,11 +768,11 @@ end = struct
in
Definition { origin; path; hidden; sort; definition }

let child md name desc deprecated =
let child md name desc visibility =
let origin = Module.raw_origin md in
let sort = Module.raw_sort md in
let path = Path.Pdot(Module.raw_path md, name) in
let hidden = hidden_definition deprecated name in
let hidden = hidden_definition visibility name in
let definition =
match desc with
| None -> Unknown
Expand Down Expand Up @@ -880,19 +888,23 @@ end = struct
let rec loop types class_types module_types modules = function
| [] -> Forced { types; class_types; module_types; modules }
| Type(name, desc, dpr) :: rest ->
let typ = Type.child t name (Some desc) dpr in
let visibility = Desc.visibility_of_deprecated dpr in
let typ = Type.child t name (Some desc) visibility in
let types = String_map.add name typ types in
loop types class_types module_types modules rest
| Class_type(name, desc, dpr) :: rest ->
let clty = Class_type.child t name (Some desc) dpr in
let visibility = Desc.visibility_of_deprecated dpr in
let clty = Class_type.child t name (Some desc) visibility in
let class_types = String_map.add name clty class_types in
loop types class_types module_types modules rest
| Module_type(name, desc, dpr) :: rest ->
let mty = Module_type.child t name (Some desc) dpr in
let visibility = Desc.visibility_of_deprecated dpr in
let mty = Module_type.child t name (Some desc) visibility in
let module_types = String_map.add name mty module_types in
loop types class_types module_types modules rest
| Module(name, desc, dpr) :: rest ->
let md = Module.child t name (Some desc) dpr in
let visibility = Desc.visibility_of_deprecated dpr in
let md = Module.child t name (Some desc) visibility in
let modules = String_map.add name md modules in
loop types class_types module_types modules rest
in
Expand Down Expand Up @@ -949,7 +961,7 @@ end = struct
| Signature { components = Unforced _ } ->
assert false
| Unknown ->
Type.child t name None Not_deprecated
Type.child t name None Visible
| Functor _ ->
raise Not_found
| Signature { components = Forced { types; _ }; _ } ->
Expand All @@ -962,7 +974,7 @@ end = struct
| Signature { components = Unforced _ } ->
assert false
| Unknown ->
Class_type.child t name None Not_deprecated
Class_type.child t name None Visible
| Functor _ ->
raise Not_found
| Signature { components = Forced { class_types; _ }; _ } ->
Expand All @@ -975,7 +987,7 @@ end = struct
| Signature { components = Unforced _ } ->
assert false
| Unknown ->
Module_type.child t name None Not_deprecated
Module_type.child t name None Visible
| Functor _ ->
raise Not_found
| Signature { components = Forced { module_types; _ }; _ } ->
Expand All @@ -988,7 +1000,7 @@ end = struct
| Signature { components = Unforced _ } ->
assert false
| Unknown ->
Module.child t name None Not_deprecated
Module.child t name None Visible
| Functor _ ->
raise Not_found
| Signature { components = Forced { modules; _ }; _ } ->
Expand Down Expand Up @@ -1077,13 +1089,13 @@ and Component : sig

type t =
| Type of
Origin.t * Ident.t * Desc.Type.t * source * Desc.deprecated
Origin.t * Ident.t * Desc.Type.t * source * Desc.visibility
| Class_type of
Origin.t * Ident.t * Desc.Class_type.t * source * Desc.deprecated
Origin.t * Ident.t * Desc.Class_type.t * source * Desc.visibility
| Module_type of
Origin.t * Ident.t * Desc.Module_type.t * source * Desc.deprecated
Origin.t * Ident.t * Desc.Module_type.t * source * Desc.visibility
| Module of
Origin.t * Ident.t * Desc.Module.t * source * Desc.deprecated
Origin.t * Ident.t * Desc.Module.t * source * Desc.visibility
| Declare_type of Origin.t * Ident.t
| Declare_class_type of Origin.t * Ident.t
| Declare_module_type of Origin.t * Ident.t
Expand Down Expand Up @@ -1239,9 +1251,9 @@ end = struct
let diff = item :: diff in
let acc = { acc with module_types; module_type_names } in
loop acc diff declarations rest
| Component.Module(origin,id, desc, source, dpr) :: rest ->
| Component.Module(origin,id, desc, source, visibility) :: rest ->
let prev = previous_module acc id in
let md = Module.base origin id (Some desc) dpr in
let md = Module.base origin id (Some desc) visibility in
let modules = Ident_map.add id md acc.modules in
let module_names = add_name source id acc.module_names in
let item = Diff.Item.Module(id, md, prev) in
Expand Down
14 changes: 10 additions & 4 deletions src/ocaml/typing/short_paths_graph.mli
Original file line number Diff line number Diff line change
Expand Up @@ -54,6 +54,12 @@ module Desc : sig
| Deprecated
| Not_deprecated

type visibility =
| Visible
| Hidden

val visibility_of_deprecated : deprecated -> visibility

module Type : sig

type t =
Expand Down Expand Up @@ -258,13 +264,13 @@ module Component : sig

type t =
| Type of
Origin.t * Ident.t * Desc.Type.t * source * Desc.deprecated
Origin.t * Ident.t * Desc.Type.t * source * Desc.visibility
| Class_type of
Origin.t * Ident.t * Desc.Class_type.t * source * Desc.deprecated
Origin.t * Ident.t * Desc.Class_type.t * source * Desc.visibility
| Module_type of
Origin.t * Ident.t * Desc.Module_type.t * source * Desc.deprecated
Origin.t * Ident.t * Desc.Module_type.t * source * Desc.visibility
| Module of
Origin.t * Ident.t * Desc.Module.t * source * Desc.deprecated
Origin.t * Ident.t * Desc.Module.t * source * Desc.visibility
| Declare_type of Origin.t * Ident.t
| Declare_class_type of Origin.t * Ident.t
| Declare_module_type of Origin.t * Ident.t
Expand Down
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
type t
type u
Loading
Loading