Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

stop rendering overridden module vals #580

Merged
Merged
Show file tree
Hide file tree
Changes from 2 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
7 changes: 7 additions & 0 deletions src/document/generator.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1018,6 +1018,12 @@ module Make (Syntax : SYNTAX) = struct
| `Type (_, name) when TypeName.is_internal name -> true
| _ -> false

let internal_value v =
let open Lang.Value in
match v.id with
| `Value (_, name) when ValueName.is_internal name -> true
| _ -> false

let internal_module_type t =
let open Lang.ModuleType in
match t.id with
Expand All @@ -1041,6 +1047,7 @@ module Make (Syntax : SYNTAX) = struct
match (item : Lang.Signature.item) with
| Module (_, m) when internal_module m -> loop rest acc_items
| Type (_, t) when internal_type t -> loop rest acc_items
| Value v when internal_value v -> loop rest acc_items
| ModuleType m when internal_module_type m -> loop rest acc_items
| ModuleSubstitution m when internal_module_substitution m ->
loop rest acc_items
Expand Down
50 changes: 20 additions & 30 deletions src/loader/cmi.ml
Original file line number Diff line number Diff line change
Expand Up @@ -35,18 +35,6 @@ let opt_iter f = function
| None -> ()
| Some x -> f x

let parenthesise name =
match name with
| "asr" | "land" | "lor" | "lsl" | "lsr"
| "lxor" | "mod" -> "(" ^ name ^ ")"
| _ ->
if (String.length name > 0) then
match name.[0] with
| 'a' .. 'z' | '\223' .. '\246' | '\248' .. '\255' | '_'
| 'A' .. 'Z' | '\192' .. '\214' | '\216' .. '\222' -> name
| _ -> "(" ^ name ^ ")"
else name

let read_label lbl =
let open TypeExpr in
#if OCAML_MAJOR = 4 && OCAML_MINOR = 02
Expand Down Expand Up @@ -516,8 +504,7 @@ and read_object env fi nm =

let read_value_description env parent id vd =
let open Signature in
let name = parenthesise (Ident.name id) in
let id = `Value(parent, Odoc_model.Names.ValueName.of_string name) in
let id = Env.find_value_identifier env id in
let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
let doc = Doc_attr.attached container vd.val_attributes in
mark_value_description vd;
Expand All @@ -538,8 +525,8 @@ let read_value_description env parent id vd =

let read_label_declaration env parent ld =
let open TypeDecl.Field in
let name = parenthesise (Ident.name ld.ld_id) in
let id = `Field(parent, Odoc_model.Names.FieldName.of_string name) in
let name = Ident.name ld.ld_id in
let id = `Field(parent, Odoc_model.Names.FieldName.make_std name) in
let doc =
Doc_attr.attached
(parent :> Identifier.LabelParent.t) ld.ld_attributes
Expand All @@ -564,8 +551,8 @@ let read_constructor_declaration_arguments env parent arg =

let read_constructor_declaration env parent cd =
let open TypeDecl.Constructor in
let name = parenthesise (Ident.name cd.cd_id) in
let id = `Constructor(parent, Odoc_model.Names.ConstructorName.of_string name) in
let name = Ident.name cd.cd_id in
let id = `Constructor(parent, Odoc_model.Names.ConstructorName.make_std name) in
let container = (parent : Identifier.DataType.t :> Identifier.LabelParent.t) in
let doc = Doc_attr.attached container cd.cd_attributes in
let args =
Expand Down Expand Up @@ -654,8 +641,8 @@ let read_type_declaration env parent id decl =

let read_extension_constructor env parent id ext =
let open Extension.Constructor in
let name = parenthesise (Ident.name id) in
let id = `Extension(parent, Odoc_model.Names.ExtensionName.of_string name) in
let name = Ident.name id in
let id = `Extension(parent, Odoc_model.Names.ExtensionName.make_std name) in
let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
let doc = Doc_attr.attached container ext.ext_attributes in
let args =
Expand Down Expand Up @@ -687,8 +674,8 @@ let read_type_extension env parent id ext rest =

let read_exception env parent id ext =
let open Exception in
let name = parenthesise (Ident.name id) in
let id = `Exception(parent, Odoc_model.Names.ExceptionName.of_string name) in
let name = Ident.name id in
let id = `Exception(parent, Odoc_model.Names.ExceptionName.make_std name) in
let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
let doc = Doc_attr.attached container ext.ext_attributes in
mark_exception ext;
Expand All @@ -701,8 +688,7 @@ let read_exception env parent id ext =

let read_method env parent concrete (name, kind, typ) =
let open Method in
let name = parenthesise name in
let id = `Method(parent, Odoc_model.Names.MethodName.of_string name) in
let id = `Method(parent, Odoc_model.Names.MethodName.make_std name) in
let doc = Doc_attr.empty in
let private_ = (Btype.field_kind_repr kind) <> Fpresent in
let virtual_ = not (Concr.mem name concrete) in
Expand All @@ -711,8 +697,7 @@ let read_method env parent concrete (name, kind, typ) =

let read_instance_variable env parent (name, mutable_, virtual_, typ) =
let open InstanceVariable in
let name = parenthesise name in
let id = `InstanceVariable(parent, Odoc_model.Names.InstanceVariableName.of_string name) in
let id = `InstanceVariable(parent, Odoc_model.Names.InstanceVariableName.make_std name) in
let doc = Doc_attr.empty in
let mutable_ = (mutable_ = Mutable) in
let virtual_ = (virtual_ = Virtual) in
Expand Down Expand Up @@ -849,10 +834,10 @@ let rec read_module_type env parent (mty : Odoc_model.Compat.module_type) =
| Unit -> Odoc_model.Lang.FunctorParameter.Unit, env
| Named (id_opt, arg) ->
let name, env = match id_opt with
| Some id -> parenthesise (Ident.name id), Env.add_parameter parent id (ParameterName.of_ident id) env
| Some id -> Ident.name id, Env.add_parameter parent id (ParameterName.of_ident id) env
| None -> "_", env
in
let id = `Parameter(parent, Odoc_model.Names.ParameterName.of_string name) in
let id = `Parameter(parent, Odoc_model.Names.ParameterName.make_std name) in
let arg = read_module_type env id arg in
Odoc_model.Lang.FunctorParameter.Named ({ FunctorParameter. id; expr = arg }), env
in
Expand Down Expand Up @@ -914,6 +899,11 @@ and read_signature_noenv env parent (items : Odoc_model.Compat.signature) =
match items with
| Sig_value(id, v, _) :: rest ->
let vd = read_value_description env parent id v in
let shadowed =
if Env.is_shadowed env id
then { shadowed with s_values = (Ident.name id, (Env.find_value_identifier env id)) :: shadowed.s_values }
else shadowed
in
loop (vd :: acc, shadowed) rest
| Sig_type(id, _, _, _) :: rest
when Btype.is_row_name (Ident.name id) ->
Expand Down Expand Up @@ -986,15 +976,15 @@ and read_signature_noenv env parent (items : Odoc_model.Compat.signature) =

| [] -> ({items = List.rev acc; compiled=false}, shadowed)
in
loop ([],{s_modules=[]; s_module_types=[]; s_types=[]; s_classes=[]; s_class_types=[]}) items
loop ([],{s_modules=[]; s_module_types=[]; s_values=[];s_types=[]; s_classes=[]; s_class_types=[]}) items

and read_signature env parent (items : Odoc_model.Compat.signature) =
let env = Env.handle_signature_type_items parent items env in
fst @@ read_signature_noenv env parent items


let read_interface root name intf =
let id = `Root(root, Odoc_model.Names.ModuleName.of_string name) in
let id = `Root(root, Odoc_model.Names.ModuleName.make_std name) in
let doc = Doc_attr.empty in
let items = read_signature Env.empty id intf in
(id, doc, items)
40 changes: 11 additions & 29 deletions src/loader/cmt.ml
Original file line number Diff line number Diff line change
Expand Up @@ -25,37 +25,23 @@ open Odoc_model.Lang

module Env = Odoc_model.Ident_env

let parenthesise name =
match name with
| "asr" | "land" | "lor" | "lsl" | "lsr"
| "lxor" | "mod" -> "(" ^ name ^ ")"
| _ ->
if (String.length name > 0) then
match name.[0] with
| 'a' .. 'z' | '\223' .. '\246' | '\248' .. '\255' | '_'
| 'A' .. 'Z' | '\192' .. '\214' | '\216' .. '\222' -> name
| _ -> "(" ^ name ^ ")"
else name

let read_core_type env ctyp =
Cmi.read_type_expr env ctyp.ctyp_type

let rec read_pattern env parent doc pat =
let open Odoc_model.Names in
let open Signature in
match pat.pat_desc with
| Tpat_any -> []
| Tpat_var(id, _) ->
let open Value in
let name = parenthesise (Ident.name id) in
let id = `Value(parent, ValueName.of_string name) in
let id = Env.find_value_identifier env id in
Cmi.mark_type_expr pat.pat_type;
let type_ = Cmi.read_type_expr env pat.pat_type in
[Value {id; doc; type_}]
| Tpat_alias(pat, id, _) ->
let open Value in
let name = parenthesise (Ident.name id) in
let id = `Value(parent, ValueName.of_string name) in
let id = Env.find_value_identifier env id in
Cmi.mark_type_expr pat.pat_type;
let type_ = Cmi.read_type_expr env pat.pat_type in
Value {id; doc; type_} :: read_pattern env parent doc pat
Expand Down Expand Up @@ -141,16 +127,14 @@ let rec read_class_type_field env parent ctf =
match ctf.ctf_desc with
| Tctf_val(name, mutable_, virtual_, typ) ->
let open InstanceVariable in
let name = parenthesise name in
let id = `InstanceVariable(parent, InstanceVariableName.of_string name) in
let id = `InstanceVariable(parent, InstanceVariableName.make_std name) in
let mutable_ = (mutable_ = Mutable) in
let virtual_ = (virtual_ = Virtual) in
let type_ = read_core_type env typ in
Some (InstanceVariable {id; doc; mutable_; virtual_; type_})
| Tctf_method(name, private_, virtual_, typ) ->
let open Method in
let name = parenthesise name in
let id = `Method(parent, MethodName.of_string name) in
let id = `Method(parent, MethodName.make_std name) in
let private_ = (private_ = Private) in
let virtual_ = (virtual_ = Virtual) in
let type_ = read_core_type env typ in
Expand Down Expand Up @@ -223,8 +207,7 @@ let rec read_class_field env parent cf =
match cf.cf_desc with
| Tcf_val({txt = name; _}, mutable_, _, kind, _) ->
let open InstanceVariable in
let name = parenthesise name in
let id = `InstanceVariable(parent, InstanceVariableName.of_string name) in
let id = `InstanceVariable(parent, InstanceVariableName.make_std name) in
let mutable_ = (mutable_ = Mutable) in
let virtual_, type_ =
match kind with
Expand All @@ -236,8 +219,7 @@ let rec read_class_field env parent cf =
Some (InstanceVariable {id; doc; mutable_; virtual_; type_})
| Tcf_method({txt = name; _}, private_, kind) ->
let open Method in
let name = parenthesise name in
let id = `Method(parent, MethodName.of_string name) in
let id = `Method(parent, MethodName.make_std name) in
let private_ = (private_ = Private) in
let virtual_, type_ =
match kind with
Expand Down Expand Up @@ -363,10 +345,10 @@ let rec read_module_expr env parent label_parent mexpr =
| Named (id_opt, _, arg) ->
let name, env =
match id_opt with
| Some id -> parenthesise (Ident.name id), Env.add_parameter parent id (ParameterName.of_ident id) env
| Some id -> Ident.name id, Env.add_parameter parent id (ParameterName.of_ident id) env
| None -> "_", env
in
let id = `Parameter(parent, Odoc_model.Names.ParameterName.of_string name) in
let id = `Parameter(parent, Odoc_model.Names.ParameterName.make_std name) in
let arg = Cmti.read_module_type env id label_parent arg in

Named { id; expr=arg }, env
Expand All @@ -379,8 +361,8 @@ let rec read_module_expr env parent label_parent mexpr =
match arg with
| None -> FunctorParameter.Unit
| Some arg ->
let name = parenthesise (Ident.name id) in
let id = `Parameter(parent, ParameterName.of_string name) in
let name = Ident.name id in
let id = `Parameter(parent, ParameterName.make_std name) in
let arg = Cmti.read_module_type env id label_parent arg in
Named { FunctorParameter. id; expr = arg; }
in
Expand Down Expand Up @@ -569,7 +551,7 @@ and read_structure env parent str =
{ items = List.rev items; compiled=false }

let read_implementation root name impl =
let id = `Root(root, Odoc_model.Names.ModuleName.of_string name) in
let id = `Root(root, Odoc_model.Names.ModuleName.make_std name) in
let sg = read_structure Env.empty id impl in
let doc, sg =
let open Signature in
Expand Down
48 changes: 16 additions & 32 deletions src/loader/cmti.ml
Original file line number Diff line number Diff line change
Expand Up @@ -33,18 +33,6 @@ let opt_map f = function
| None -> None
| Some x -> Some (f x)

let parenthesise name =
match name with
| "asr" | "land" | "lor" | "lsl" | "lsr"
| "lxor" | "mod" -> "(" ^ name ^ ")"
| _ ->
if (String.length name > 0) then
match name.[0] with
| 'a' .. 'z' | '\223' .. '\246' | '\248' .. '\255' | '_'
| 'A' .. 'Z' | '\192' .. '\214' | '\216' .. '\222' -> name
| _ -> "(" ^ name ^ ")"
else name

let read_label = Cmi.read_label

let rec read_core_type env container ctyp =
Expand Down Expand Up @@ -158,9 +146,7 @@ let rec read_core_type env container ctyp =

let read_value_description env parent vd =
let open Signature in
let open Odoc_model.Names in
let name = parenthesise (Ident.name vd.val_id) in
let id = `Value(parent, ValueName.of_string name) in
let id = Env.find_value_identifier env vd.val_id in
let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
let doc = Doc_attr.attached container vd.val_attributes in
let type_ = read_core_type env container vd.val_desc in
Expand Down Expand Up @@ -201,8 +187,8 @@ let read_type_parameter (ctyp, var_and_injectivity) =
let read_label_declaration env parent label_parent ld =
let open TypeDecl.Field in
let open Odoc_model.Names in
let name = parenthesise (Ident.name ld.ld_id) in
let id = `Field(parent, FieldName.of_string name) in
let name = Ident.name ld.ld_id in
let id = `Field(parent, FieldName.make_std name) in
let doc = Doc_attr.attached label_parent ld.ld_attributes in
let mutable_ = (ld.ld_mutable = Mutable) in
let type_ = read_core_type env label_parent ld.ld_type in
Expand All @@ -223,8 +209,8 @@ let read_constructor_declaration_arguments env parent label_parent arg =
let read_constructor_declaration env parent cd =
let open TypeDecl.Constructor in
let open Odoc_model.Names in
let name = parenthesise (Ident.name cd.cd_id) in
let id = `Constructor(parent, ConstructorName.of_string name) in
let name = Ident.name cd.cd_id in
let id = `Constructor(parent, ConstructorName.make_std name) in
let container = (parent : Identifier.DataType.t :> Identifier.Parent.t) in
let label_container = (container :> Identifier.LabelParent.t) in
let doc = Doc_attr.attached label_container cd.cd_attributes in
Expand Down Expand Up @@ -296,8 +282,8 @@ let read_type_substitutions env parent decls =
let read_extension_constructor env parent ext =
let open Extension.Constructor in
let open Odoc_model.Names in
let name = parenthesise (Ident.name ext.ext_id) in
let id = `Extension(parent, ExtensionName.of_string name) in
let name = Ident.name ext.ext_id in
let id = `Extension(parent, ExtensionName.make_std name) in
let container = (parent : Identifier.Signature.t :> Identifier.Parent.t) in
let label_container = (container :> Identifier.LabelParent.t) in
let doc = Doc_attr.attached label_container ext.ext_attributes in
Expand Down Expand Up @@ -326,8 +312,8 @@ let read_type_extension env parent tyext =
let read_exception env parent (ext : extension_constructor) =
let open Exception in
let open Odoc_model.Names in
let name = parenthesise (Ident.name ext.ext_id) in
let id = `Exception(parent, ExceptionName.of_string name) in
let name = Ident.name ext.ext_id in
let id = `Exception(parent, ExceptionName.make_std name) in
let container = (parent : Identifier.Signature.t :> Identifier.Parent.t) in
let label_container = (container :> Identifier.LabelParent.t) in
let doc = Doc_attr.attached label_container ext.ext_attributes in
Expand All @@ -350,16 +336,14 @@ let rec read_class_type_field env parent ctf =
match ctf.ctf_desc with
| Tctf_val(name, mutable_, virtual_, typ) ->
let open InstanceVariable in
let name = parenthesise name in
let id = `InstanceVariable(parent, InstanceVariableName.of_string name) in
let id = `InstanceVariable(parent, InstanceVariableName.make_std name) in
let mutable_ = (mutable_ = Mutable) in
let virtual_ = (virtual_ = Virtual) in
let type_ = read_core_type env container typ in
Some (InstanceVariable {id; doc; mutable_; virtual_; type_})
| Tctf_method(name, private_, virtual_, typ) ->
let open Method in
let name = parenthesise name in
let id = `Method(parent, MethodName.of_string name) in
let id = `Method(parent, MethodName.make_std name) in
let private_ = (private_ = Private) in
let virtual_ = (virtual_ = Virtual) in
let type_ = read_core_type env container typ in
Expand Down Expand Up @@ -500,10 +484,10 @@ and read_module_type env parent label_parent mty =
let name, env =
match id_opt with
| Some id ->
parenthesise (Ident.name id), Env.add_parameter parent id (ParameterName.of_ident id) env
Ident.name id, Env.add_parameter parent id (ParameterName.of_ident id) env
| None -> "_", env
in
let id = `Parameter(parent, ParameterName.of_string name) in
let id = `Parameter(parent, ParameterName.make_std name) in
let arg = read_module_type env id label_parent arg in
Named { id; expr = arg; }, env
in
Expand All @@ -515,8 +499,8 @@ and read_module_type env parent label_parent mty =
match arg with
| None -> Odoc_model.Lang.FunctorParameter.Unit
| Some arg ->
let name = parenthesise (Ident.name id) in
let id = `Parameter(parent, Odoc_model.Names.ParameterName.of_string name) in
let name = Ident.name id in
let id = `Parameter(parent, Odoc_model.Names.ParameterName.make_std name) in
let arg = read_module_type env id label_parent arg in
Named { FunctorParameter. id; expr = arg }
in
Expand Down Expand Up @@ -735,7 +719,7 @@ and read_signature env parent sg =
{ items = List.rev items; compiled=false }

let read_interface root name intf =
let id = `Root(root, Odoc_model.Names.ModuleName.of_string name) in
let id = `Root(root, Odoc_model.Names.ModuleName.make_std name) in
let sg = read_signature Env.empty id intf in
let doc, sg =
let open Signature in
Expand Down
Loading