From 0a4416860c1a9a18a4451a114f7d607a0c0e04ba Mon Sep 17 00:00:00 2001 From: lubegasimon Date: Fri, 19 Feb 2021 20:14:53 +0300 Subject: [PATCH] change from 'of_string' -> 'make_std' Signed-off-by: lubegasimon --- src/loader/cmi.ml | 16 ++++---- src/loader/cmt.ml | 12 +++--- src/loader/cmti.ml | 18 ++++----- src/loader/odoc_loader.ml | 4 +- src/model/ident_env.cppo.ml | 12 +++--- src/model/names.ml | 12 +++--- src/model/names.mli | 4 +- src/model/paths.ml | 4 +- src/model/predefined.ml | 74 +++++++++++++++++------------------ src/odoc/compile.ml | 6 +-- src/odoc/html_fragment.ml | 2 +- src/parser/reference.ml | 56 +++++++++++++------------- src/parser/semantics.ml | 2 +- src/xref2/cfrag.ml | 2 +- src/xref2/env.ml | 6 +-- src/xref2/lang_of.ml | 6 +-- src/xref2/ref_tools.ml | 6 +-- src/xref2/tools.ml | 6 +-- test/parser/test.ml | 2 +- test/xref2/lib/common.cppo.ml | 6 +-- 20 files changed, 128 insertions(+), 128 deletions(-) diff --git a/src/loader/cmi.ml b/src/loader/cmi.ml index e2e6adabdb..4040085882 100644 --- a/src/loader/cmi.ml +++ b/src/loader/cmi.ml @@ -526,7 +526,7 @@ let read_value_description env parent id vd = let read_label_declaration env parent ld = let open TypeDecl.Field in let name = Ident.name ld.ld_id in - let id = `Field(parent, Odoc_model.Names.FieldName.of_string name) 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 @@ -552,7 +552,7 @@ let read_constructor_declaration_arguments env parent arg = let read_constructor_declaration env parent cd = let open TypeDecl.Constructor in let name = Ident.name cd.cd_id in - let id = `Constructor(parent, Odoc_model.Names.ConstructorName.of_string name) 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 = @@ -642,7 +642,7 @@ let read_type_declaration env parent id decl = let read_extension_constructor env parent id ext = let open Extension.Constructor in let name = Ident.name id in - let id = `Extension(parent, Odoc_model.Names.ExtensionName.of_string name) 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 = @@ -675,7 +675,7 @@ let read_type_extension env parent id ext rest = let read_exception env parent id ext = let open Exception in let name = Ident.name id in - let id = `Exception(parent, Odoc_model.Names.ExceptionName.of_string name) 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; @@ -688,7 +688,7 @@ let read_exception env parent id ext = let read_method env parent concrete (name, kind, typ) = let open Method 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 @@ -697,7 +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 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 @@ -837,7 +837,7 @@ let rec read_module_type env parent (mty : Odoc_model.Compat.module_type) = | 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 @@ -984,7 +984,7 @@ and read_signature env parent (items : Odoc_model.Compat.signature) = 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) diff --git a/src/loader/cmt.ml b/src/loader/cmt.ml index 0d709c44ab..10bb8120b3 100644 --- a/src/loader/cmt.ml +++ b/src/loader/cmt.ml @@ -127,14 +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 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 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 @@ -207,7 +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 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 @@ -219,7 +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 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 @@ -348,7 +348,7 @@ let rec read_module_expr env parent label_parent mexpr = | 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 @@ -551,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 diff --git a/src/loader/cmti.ml b/src/loader/cmti.ml index ff52d11aa7..6fe03b400e 100644 --- a/src/loader/cmti.ml +++ b/src/loader/cmti.ml @@ -188,7 +188,7 @@ let read_label_declaration env parent label_parent ld = let open TypeDecl.Field in let open Odoc_model.Names in let name = Ident.name ld.ld_id in - let id = `Field(parent, FieldName.of_string name) 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 @@ -210,7 +210,7 @@ let read_constructor_declaration env parent cd = let open TypeDecl.Constructor in let open Odoc_model.Names in let name = Ident.name cd.cd_id in - let id = `Constructor(parent, ConstructorName.of_string name) 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 @@ -283,7 +283,7 @@ let read_extension_constructor env parent ext = let open Extension.Constructor in let open Odoc_model.Names in let name = Ident.name ext.ext_id in - let id = `Extension(parent, ExtensionName.of_string name) 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 @@ -313,7 +313,7 @@ let read_exception env parent (ext : extension_constructor) = let open Exception in let open Odoc_model.Names in let name = Ident.name ext.ext_id in - let id = `Exception(parent, ExceptionName.of_string name) 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 @@ -336,14 +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 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 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 @@ -487,7 +487,7 @@ and read_module_type env parent label_parent mty = 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 @@ -500,7 +500,7 @@ and read_module_type env parent label_parent mty = | None -> Odoc_model.Lang.FunctorParameter.Unit | Some arg -> let name = Ident.name id 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 label_parent arg in Named { FunctorParameter. id; expr = arg } in @@ -719,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 diff --git a/src/loader/odoc_loader.ml b/src/loader/odoc_loader.ml index b290ffd388..67ace6dfdc 100644 --- a/src/loader/odoc_loader.ml +++ b/src/loader/odoc_loader.ml @@ -113,7 +113,7 @@ let read_cmt ~make_root ~parent ~filename () = | Ok root -> root | Error (`Msg m) -> error_msg filename m in - let id = `Root(parent, Odoc_model.Names.ModuleName.of_string name) in + let id = `Root(parent, Odoc_model.Names.ModuleName.make_std name) in let items = List.map (fun file -> let pref = Misc.chop_extensions file in @@ -123,7 +123,7 @@ let read_cmt ~make_root ~parent ~filename () = let items = List.sort String.compare items in let items = List.map (fun name -> - let id = `Module(id, Odoc_model.Names.ModuleName.of_string name) in + let id = `Module(id, Odoc_model.Names.ModuleName.make_std name) in let path = `Root name in {Odoc_model.Lang.Compilation_unit.Packed.id; path}) items diff --git a/src/model/ident_env.cppo.ml b/src/model/ident_env.cppo.ml index cf4767fa33..ce415b8f96 100644 --- a/src/model/ident_env.cppo.ml +++ b/src/model/ident_env.cppo.ml @@ -359,7 +359,7 @@ let env_of_items parent items env = let identifier, shadowed = if is_shadowed then `Type(parent, TypeName.internal_of_string name), t :: env.shadowed - else `Type(parent, TypeName.of_string name), env.shadowed + else `Type(parent, TypeName.make_std name), env.shadowed in let types = Ident.add t identifier env.types in inner rest { env with types; shadowed } @@ -370,7 +370,7 @@ let env_of_items parent items env = let identifier, shadowed = if is_shadowed then `Value(parent, ValueName.internal_of_string name), t :: env.shadowed - else `Value(parent, ValueName.of_string name), env.shadowed + else `Value(parent, ValueName.make_std name), env.shadowed in let values = Ident.add t identifier env.values in inner rest { env with values; shadowed } @@ -381,7 +381,7 @@ let env_of_items parent items env = let identifier, shadowed = if is_shadowed then `ModuleType(parent, ModuleTypeName.internal_of_string name), t :: env.shadowed - else `ModuleType(parent, ModuleTypeName.of_string name), env.shadowed + else `ModuleType(parent, ModuleTypeName.make_std name), env.shadowed in let module_types = Ident.add t identifier env.module_types in inner rest { env with module_types; shadowed } @@ -391,7 +391,7 @@ let env_of_items parent items env = let identifier, shadowed = if is_shadowed then `Module(parent, ModuleName.internal_of_string name), t :: env.shadowed - else `Module(parent, ModuleName.of_string name), env.shadowed + else `Module(parent, ModuleName.make_std name), env.shadowed in let path = `Identifier(identifier, is_shadowed) in let modules = Ident.add t identifier env.modules in @@ -403,7 +403,7 @@ let env_of_items parent items env = let identifier, shadowed = if is_shadowed then `Class(parent, ClassName.internal_of_string name), t :: t2 :: t3 :: t4 :: env.shadowed - else `Class(parent, ClassName.of_string name), env.shadowed + else `Class(parent, ClassName.make_std name), env.shadowed in let classes = List.fold_right (fun id classes -> Ident.add id identifier classes) @@ -415,7 +415,7 @@ let env_of_items parent items env = let identifier, shadowed = if is_shadowed then `ClassType(parent, ClassTypeName.internal_of_string name), t :: t2 :: t3 :: env.shadowed - else `ClassType(parent, ClassTypeName.of_string name), env.shadowed + else `ClassType(parent, ClassTypeName.make_std name), env.shadowed in let class_types = List.fold_right (fun id class_types -> Ident.add id identifier class_types) diff --git a/src/model/names.ml b/src/model/names.ml index 6afddc94b3..99663ac8ad 100644 --- a/src/model/names.ml +++ b/src/model/names.ml @@ -22,7 +22,7 @@ module type Name = sig val to_string_unsafe : t -> string - val of_string : string -> t + val make_std : string -> t val of_ident : Ident.t -> t @@ -52,12 +52,12 @@ module Name : Name = struct let to_string_unsafe = function Std s -> s | Internal (s, _i) -> s - let of_string s = + let make_std s = let s = parenthesise s in if String.length s > 0 && s.[0] = '{' then raise (Invalid_argument s) else Std s - let of_ident id = of_string (Ident.name id) + let of_ident id = make_std (Ident.name id) let internal_of_string id = incr internal_counter; @@ -95,7 +95,7 @@ module type SimpleName = sig val to_string : t -> string - val of_string : string -> t + val make_std : string -> t val of_ident : Ident.t -> t @@ -113,9 +113,9 @@ module SimpleName : SimpleName = struct let to_string s = s - let of_string s = s + let make_std s = s - let of_ident id = of_string (Ident.name id) + let of_ident id = make_std (Ident.name id) let equal (x : t) (y : t) = x = y diff --git a/src/model/names.mli b/src/model/names.mli index fdeb07c0da..1fa3d10aab 100644 --- a/src/model/names.mli +++ b/src/model/names.mli @@ -27,7 +27,7 @@ module type Name = sig (** [to_string_unsafe] will allow even internal names to be turned into strings. Use with caution. *) - val of_string : string -> t + val make_std : string -> t val of_ident : Ident.t -> t @@ -55,7 +55,7 @@ module type SimpleName = sig val to_string : t -> string - val of_string : string -> t + val make_std : string -> t val of_ident : Ident.t -> t diff --git a/src/model/paths.ml b/src/model/paths.ml index 4f2df88889..0163f1804d 100644 --- a/src/model/paths.ml +++ b/src/model/paths.ml @@ -858,9 +858,9 @@ module Fragment = struct | Resolved.Branch (base, m) -> Branch (base, `Resolved m) ) | `Dot (m, name) -> ( match split_parent m with - | Base None -> Branch (ModuleName.of_string name, `Root) + | Base None -> Branch (ModuleName.make_std name, `Root) | Base (Some i) -> - Branch (ModuleName.of_string name, `Resolved (`Root i)) + Branch (ModuleName.make_std name, `Resolved (`Root i)) | Branch (base, m) -> Branch (base, `Dot (m, name)) ) module Signature = struct diff --git a/src/model/predefined.ml b/src/model/predefined.ml index 973eb16999..b388c99dd1 100644 --- a/src/model/predefined.ml +++ b/src/model/predefined.ml @@ -51,94 +51,94 @@ let invariant_equation = let constraints = [] in { params; private_; manifest; constraints } -let bool_identifier = `CoreType (TypeName.of_string "bool") +let bool_identifier = `CoreType (TypeName.make_std "bool") -let int_identifier = `CoreType (TypeName.of_string "int") +let int_identifier = `CoreType (TypeName.make_std "int") -let char_identifier = `CoreType (TypeName.of_string "char") +let char_identifier = `CoreType (TypeName.make_std "char") -let bytes_identifier = `CoreType (TypeName.of_string "bytes") +let bytes_identifier = `CoreType (TypeName.make_std "bytes") -let string_identifier = `CoreType (TypeName.of_string "string") +let string_identifier = `CoreType (TypeName.make_std "string") -let float_identifier = `CoreType (TypeName.of_string "float") +let float_identifier = `CoreType (TypeName.make_std "float") -let unit_identifier = `CoreType (TypeName.of_string "unit") +let unit_identifier = `CoreType (TypeName.make_std "unit") -let exn_identifier = `CoreType (TypeName.of_string "exn") +let exn_identifier = `CoreType (TypeName.make_std "exn") -let array_identifier = `CoreType (TypeName.of_string "array") +let array_identifier = `CoreType (TypeName.make_std "array") -let list_identifier = `CoreType (TypeName.of_string "list") +let list_identifier = `CoreType (TypeName.make_std "list") -let option_identifier = `CoreType (TypeName.of_string "option") +let option_identifier = `CoreType (TypeName.make_std "option") -let int32_identifier = `CoreType (TypeName.of_string "int32") +let int32_identifier = `CoreType (TypeName.make_std "int32") -let int64_identifier = `CoreType (TypeName.of_string "int64") +let int64_identifier = `CoreType (TypeName.make_std "int64") -let nativeint_identifier = `CoreType (TypeName.of_string "nativeint") +let nativeint_identifier = `CoreType (TypeName.make_std "nativeint") -let lazy_t_identifier = `CoreType (TypeName.of_string "lazy_t") +let lazy_t_identifier = `CoreType (TypeName.make_std "lazy_t") let extension_constructor_identifier = - `CoreType (TypeName.of_string "extension_constructor") + `CoreType (TypeName.make_std "extension_constructor") -let floatarray_identifier = `CoreType (TypeName.of_string "floatarray") +let floatarray_identifier = `CoreType (TypeName.make_std "floatarray") let false_identifier = - `Constructor (bool_identifier, ConstructorName.of_string "false") + `Constructor (bool_identifier, ConstructorName.make_std "false") let true_identifier = - `Constructor (bool_identifier, ConstructorName.of_string "true") + `Constructor (bool_identifier, ConstructorName.make_std "true") let void_identifier = - `Constructor (unit_identifier, ConstructorName.of_string "()") + `Constructor (unit_identifier, ConstructorName.make_std "()") let nil_identifier = - `Constructor (list_identifier, ConstructorName.of_string "([])") + `Constructor (list_identifier, ConstructorName.make_std "([])") let cons_identifier = - `Constructor (list_identifier, ConstructorName.of_string "(::)") + `Constructor (list_identifier, ConstructorName.make_std "(::)") let none_identifier = - `Constructor (option_identifier, ConstructorName.of_string "None") + `Constructor (option_identifier, ConstructorName.make_std "None") let some_identifier = - `Constructor (option_identifier, ConstructorName.of_string "Some") + `Constructor (option_identifier, ConstructorName.make_std "Some") let match_failure_identifier = - `CoreException (ExceptionName.of_string "Match_failure") + `CoreException (ExceptionName.make_std "Match_failure") let assert_failure_identifier = - `CoreException (ExceptionName.of_string "Assert_failure") + `CoreException (ExceptionName.make_std "Assert_failure") let invalid_argument_identifier = - `CoreException (ExceptionName.of_string "Invalid_argument") + `CoreException (ExceptionName.make_std "Invalid_argument") -let failure_identifier = `CoreException (ExceptionName.of_string "Failure") +let failure_identifier = `CoreException (ExceptionName.make_std "Failure") -let not_found_identifier = `CoreException (ExceptionName.of_string "Not_found") +let not_found_identifier = `CoreException (ExceptionName.make_std "Not_found") let out_of_memory_identifier = - `CoreException (ExceptionName.of_string "Out_of_memory") + `CoreException (ExceptionName.make_std "Out_of_memory") let stack_overflow_identifier = - `CoreException (ExceptionName.of_string "Stack_overflow") + `CoreException (ExceptionName.make_std "Stack_overflow") -let sys_error_identifier = `CoreException (ExceptionName.of_string "Sys_error") +let sys_error_identifier = `CoreException (ExceptionName.make_std "Sys_error") let end_of_file_identifier = - `CoreException (ExceptionName.of_string "End_of_file") + `CoreException (ExceptionName.make_std "End_of_file") let division_by_zero_identifier = - `CoreException (ExceptionName.of_string "Division_by_zero") + `CoreException (ExceptionName.make_std "Division_by_zero") let sys_blocked_io_identifier = - `CoreException (ExceptionName.of_string "Sys_blocked_io") + `CoreException (ExceptionName.make_std "Sys_blocked_io") let undefined_recursive_module_identifier = - `CoreException (ExceptionName.of_string "Undefined_recursive_module") + `CoreException (ExceptionName.make_std "Undefined_recursive_module") let core_type_identifier = function | "int" -> Some int_identifier @@ -583,7 +583,7 @@ let floatarray_decl = `Reference ( `Module ( `Root ("Array", `TModule), - ModuleName.of_string "Floatarray" ), + ModuleName.make_std "Floatarray" ), [] ); `Space; ] diff --git a/src/odoc/compile.ml b/src/odoc/compile.ml index 53d97afb07..1cf8d0c5ea 100644 --- a/src/odoc/compile.ml +++ b/src/odoc/compile.ml @@ -53,7 +53,7 @@ let parent directories parent_cli_spec = find_parent r >>= fun r -> extract_parent r.id >>= fun parent -> Env.fetch_page ap r >>= fun page -> Ok (Explicit (parent, page.children)) - | CliPackage package -> Ok (Package (`RootPage (PageName.of_string package))) + | CliPackage package -> Ok (Package (`RootPage (PageName.make_std package))) | CliNoparent -> Ok Noparent let resolve_and_substitute ~env ~output ~warn_error parent input_file read_file @@ -95,7 +95,7 @@ let root_of_compilation_unit ~parent_spec ~hidden ~output ~module_name ~digest = in Ok { - id = `Root (parent, ModuleName.of_string module_name); + id = `Root (parent, ModuleName.make_std module_name); file = file_representation; digest; } @@ -134,7 +134,7 @@ let mld ~parent_spec ~output ~children ~warn_error input = in let input_s = Fs.File.to_string input in let digest = Digest.file input_s in - let page_name = PageName.of_string root_name in + let page_name = PageName.make_std root_name in let check_child : Odoc_model.Paths.Reference.t -> bool = fun c -> match c with diff --git a/src/odoc/html_fragment.ml b/src/odoc/html_fragment.ml index 78692fd8ce..69e6ac0407 100644 --- a/src/odoc/html_fragment.ml +++ b/src/odoc/html_fragment.ml @@ -3,7 +3,7 @@ open Or_error let from_mld ~xref_base_uri ~env ~output ~warn_error input = (* Internal names, they don't have effect on the output. *) let page_name = "__fragment_page__" in - let id = `RootPage (Odoc_model.Names.PageName.of_string page_name) in + let id = `RootPage (Odoc_model.Names.PageName.make_std page_name) in let input_s = Fs.File.to_string input in let digest = Digest.file input_s in let root = diff --git a/src/parser/reference.ml b/src/parser/reference.ml index 6af952a56f..4f9b1a5e5d 100644 --- a/src/parser/reference.ml +++ b/src/parser/reference.ml @@ -172,10 +172,10 @@ let parse warnings whole_reference_location s : `Dot ((parent next_token tokens :> LabelParent.t), identifier) | `TModule -> `Module - (signature next_token tokens, ModuleName.of_string identifier) + (signature next_token tokens, ModuleName.make_std identifier) | `TModuleType -> `ModuleType - (signature next_token tokens, ModuleTypeName.of_string identifier) + (signature next_token tokens, ModuleTypeName.make_std identifier) | _ -> expected [ "module"; "module-type" ] location |> Error.raise_exception ) @@ -198,17 +198,17 @@ let parse warnings whole_reference_location s : `Dot ((parent next_token tokens :> LabelParent.t), identifier) | `TModule -> `Module - (signature next_token tokens, ModuleName.of_string identifier) + (signature next_token tokens, ModuleName.make_std identifier) | `TModuleType -> `ModuleType - (signature next_token tokens, ModuleTypeName.of_string identifier) + (signature next_token tokens, ModuleTypeName.make_std identifier) | `TType -> - `Type (signature next_token tokens, TypeName.of_string identifier) + `Type (signature next_token tokens, TypeName.make_std identifier) | `TClass -> - `Class (signature next_token tokens, ClassName.of_string identifier) + `Class (signature next_token tokens, ClassName.make_std identifier) | `TClassType -> `ClassType - (signature next_token tokens, ClassTypeName.of_string identifier) + (signature next_token tokens, ClassTypeName.make_std identifier) | _ -> expected [ "module"; "module-type"; "type"; "class"; "class-type" ] @@ -230,10 +230,10 @@ let parse warnings whole_reference_location s : | `TUnknown -> `Dot ((parent next_token tokens :> LabelParent.t), identifier) | `TClass -> - `Class (signature next_token tokens, ClassName.of_string identifier) + `Class (signature next_token tokens, ClassName.make_std identifier) | `TClassType -> `ClassType - (signature next_token tokens, ClassTypeName.of_string identifier) + (signature next_token tokens, ClassTypeName.make_std identifier) | _ -> expected [ "class"; "class-type" ] location |> Error.raise_exception ) @@ -251,7 +251,7 @@ let parse warnings whole_reference_location s : | `TUnknown -> `Dot ((parent next_token tokens :> LabelParent.t), identifier) | `TType -> - `Type (signature next_token tokens, TypeName.of_string identifier) + `Type (signature next_token tokens, TypeName.make_std identifier) | _ -> expected [ "type" ] location |> Error.raise_exception ) in @@ -273,17 +273,17 @@ let parse warnings whole_reference_location s : | `TUnknown -> `Dot (label_parent next_token tokens, identifier) | `TModule -> `Module - (signature next_token tokens, ModuleName.of_string identifier) + (signature next_token tokens, ModuleName.make_std identifier) | `TModuleType -> `ModuleType - (signature next_token tokens, ModuleTypeName.of_string identifier) + (signature next_token tokens, ModuleTypeName.make_std identifier) | `TType -> - `Type (signature next_token tokens, TypeName.of_string identifier) + `Type (signature next_token tokens, TypeName.make_std identifier) | `TClass -> - `Class (signature next_token tokens, ClassName.of_string identifier) + `Class (signature next_token tokens, ClassName.make_std identifier) | `TClassType -> `ClassType - (signature next_token tokens, ClassTypeName.of_string identifier) + (signature next_token tokens, ClassTypeName.make_std identifier) | _ -> expected [ "module"; "module-type"; "type"; "class"; "class-type" ] @@ -321,41 +321,41 @@ let parse warnings whole_reference_location s : | `TUnknown -> `Dot (label_parent next_token tokens, identifier) | `TModule -> `Module - (signature next_token tokens, ModuleName.of_string identifier) + (signature next_token tokens, ModuleName.make_std identifier) | `TModuleType -> `ModuleType - (signature next_token tokens, ModuleTypeName.of_string identifier) + (signature next_token tokens, ModuleTypeName.make_std identifier) | `TType -> - `Type (signature next_token tokens, TypeName.of_string identifier) + `Type (signature next_token tokens, TypeName.make_std identifier) | `TConstructor -> `Constructor - (datatype next_token tokens, ConstructorName.of_string identifier) + (datatype next_token tokens, ConstructorName.make_std identifier) | `TField -> - `Field (parent next_token tokens, FieldName.of_string identifier) + `Field (parent next_token tokens, FieldName.make_std identifier) | `TExtension -> `Extension - (signature next_token tokens, ExtensionName.of_string identifier) + (signature next_token tokens, ExtensionName.make_std identifier) | `TException -> `Exception - (signature next_token tokens, ExceptionName.of_string identifier) + (signature next_token tokens, ExceptionName.make_std identifier) | `TValue -> - `Value (signature next_token tokens, ValueName.of_string identifier) + `Value (signature next_token tokens, ValueName.make_std identifier) | `TClass -> - `Class (signature next_token tokens, ClassName.of_string identifier) + `Class (signature next_token tokens, ClassName.make_std identifier) | `TClassType -> `ClassType - (signature next_token tokens, ClassTypeName.of_string identifier) + (signature next_token tokens, ClassTypeName.make_std identifier) | `TMethod -> `Method ( class_signature next_token tokens, - MethodName.of_string identifier ) + MethodName.make_std identifier ) | `TInstanceVariable -> `InstanceVariable ( class_signature next_token tokens, - InstanceVariableName.of_string identifier ) + InstanceVariableName.make_std identifier ) | `TLabel -> `Label - (label_parent next_token tokens, LabelName.of_string identifier) + (label_parent next_token tokens, LabelName.make_std identifier) | `TChildPage | `TChildModule -> let suggestion = Printf.sprintf "'child-%s' should be first." identifier diff --git a/src/parser/semantics.ml b/src/parser/semantics.ml index c2d25bbfac..f3de3a7748 100644 --- a/src/parser/semantics.ml +++ b/src/parser/semantics.ml @@ -238,7 +238,7 @@ let section_heading : in let label = `Label - (status.parent_of_sections, Odoc_model.Names.LabelName.of_string label) + (status.parent_of_sections, Odoc_model.Names.LabelName.make_std label) in match (status.sections_allowed, level) with diff --git a/src/xref2/cfrag.ml b/src/xref2/cfrag.ml index 9b9bfff1c3..df3272249a 100644 --- a/src/xref2/cfrag.ml +++ b/src/xref2/cfrag.ml @@ -59,7 +59,7 @@ let rec signature_split_parent : signature -> base_name = function | RBranch (base, m) -> Branch (base, `Resolved m) ) | `Dot (m, name) -> ( match signature_split_parent m with - | Base _ -> Branch (ModuleName.of_string name, `Root) + | Base _ -> Branch (ModuleName.make_std name, `Root) | Branch (base, m) -> Branch (base, `Dot (m, name)) ) let rec resolved_module_split : diff --git a/src/xref2/env.ml b/src/xref2/env.ml index 5b37dfec80..a648cd744b 100644 --- a/src/xref2/env.ml +++ b/src/xref2/env.ml @@ -187,7 +187,7 @@ let add_type identifier t env = let open_typedecl cs = let add_cons elts (cons : TypeDecl.Constructor.t) = let ident = - `Constructor (identifier, ConstructorName.of_string cons.name) + `Constructor (identifier, ConstructorName.make_std cons.name) in add_to_elts (Odoc_model.Paths.Identifier.name ident) @@ -197,7 +197,7 @@ let add_type identifier t env = let ident = `Field ( (identifier :> Odoc_model.Paths_types.Identifier.parent), - FieldName.of_string field.name ) + FieldName.make_std field.name ) in add_to_elts (Odoc_model.Paths.Identifier.name ident) @@ -746,7 +746,7 @@ let initial_env : match resolver.lookup_unit str with | Forward_reference -> (import :: imports, env) | Found x -> - let name = Names.ModuleName.of_string str in + let name = Names.ModuleName.make_std str in (Import.Resolved (x.root, name) :: imports, env) | Not_found -> (import :: imports, env) )) t.imports ([], initial_env) diff --git a/src/xref2/lang_of.ml b/src/xref2/lang_of.ml index 549ae56210..8ed88f5d7e 100644 --- a/src/xref2/lang_of.ml +++ b/src/xref2/lang_of.ml @@ -618,7 +618,7 @@ and typ_ext map parent t = and extension_constructor map parent c = let open Component.Extension.Constructor in - let identifier = `Extension (parent, ExtensionName.of_string c.name) in + let identifier = `Extension (parent, ExtensionName.make_std c.name) in { id = identifier; doc = docs (parent :> Identifier.LabelParent.t) c.doc; @@ -793,7 +793,7 @@ and type_decl_field : Component.TypeDecl.Field.t -> Odoc_model.Lang.TypeDecl.Field.t = fun map parent f -> - let identifier = `Field (parent, FieldName.of_string f.name) in + let identifier = `Field (parent, FieldName.make_std f.name) in { id = identifier; doc = docs (parent :> Identifier.LabelParent.t) f.doc; @@ -843,7 +843,7 @@ and type_decl_constructor : Component.TypeDecl.Constructor.t -> Odoc_model.Lang.TypeDecl.Constructor.t = fun map id t -> - let identifier = `Constructor (id, ConstructorName.of_string t.name) in + let identifier = `Constructor (id, ConstructorName.make_std t.name) in { id = identifier; doc = docs (id :> Identifier.LabelParent.t) t.doc; diff --git a/src/xref2/ref_tools.ml b/src/xref2/ref_tools.ml index 9b3a77de59..19073ee7bc 100644 --- a/src/xref2/ref_tools.ml +++ b/src/xref2/ref_tools.ml @@ -348,7 +348,7 @@ module EC = struct Some (`Identifier id :> t) let of_component _env ~parent_ref name : t option = - Some (`Extension (parent_ref, ExtensionName.of_string name)) + Some (`Extension (parent_ref, ExtensionName.make_std name)) let in_signature _env ((parent', parent_cp, sg) : signature_lookup_result) name : t option = @@ -390,7 +390,7 @@ module CS = struct | `FField _ -> None let of_component _env parent name : t option = - Some (`Constructor (parent, ConstructorName.of_string name)) + Some (`Constructor (parent, ConstructorName.make_std name)) end module F = struct @@ -421,7 +421,7 @@ module F = struct Some (`Field ( (parent : Resolved.DataType.t :> Resolved.Parent.t), - FieldName.of_string name )) + FieldName.make_std name )) end module MM = struct diff --git a/src/xref2/tools.ml b/src/xref2/tools.ml index 01d5657ae5..301b6c9538 100644 --- a/src/xref2/tools.ml +++ b/src/xref2/tools.ml @@ -1431,7 +1431,7 @@ and resolve_signature_fragment : resolve_signature_fragment env (p, sg) parent >>= fun (pfrag, ppath, sg) -> of_result (find_module_with_replacement env sg name) >>= fun m' -> - let mname = ModuleName.of_string name in + let mname = ModuleName.make_std name in let new_path = `Module (ppath, mname) in let new_frag = `Module (pfrag, mname) in let m' = Component.Delayed.get m' in @@ -1469,7 +1469,7 @@ and resolve_module_fragment : resolve_signature_fragment env (p, sg) parent >>= fun (pfrag, _ppath, sg) -> of_result (find_module_with_replacement env sg name) >>= fun m' -> - let mname = ModuleName.of_string name in + let mname = ModuleName.make_std name in let new_frag = `Module (pfrag, mname) in let m' = Component.Delayed.get m' in let modifier = get_module_path_modifiers env ~add_canonical:false m' in @@ -1501,7 +1501,7 @@ and resolve_type_fragment : let open OptionMonad in resolve_signature_fragment env (p, sg) parent >>= fun (pfrag, _ppath, _sg) -> - let result = fixup_type_cfrag (`Type (pfrag, TypeName.of_string name)) in + let result = fixup_type_cfrag (`Type (pfrag, TypeName.make_std name)) in (* Format.fprintf Format.err_formatter "resolve_type_fragment: fragment=%a\n%!" Component.Fmt.resolved_type_fragment result; *) Some result diff --git a/test/parser/test.ml b/test/parser/test.ml index 20061bd74d..4b8f61159b 100644 --- a/test/parser/test.ml +++ b/test/parser/test.ml @@ -1123,7 +1123,7 @@ let () = let dummy_filename = "f.ml" in let dummy_page = - `RootPage (Odoc_model.Names.PageName.of_string dummy_filename) + `RootPage (Odoc_model.Names.PageName.make_std dummy_filename) in let location = diff --git a/test/xref2/lib/common.cppo.ml b/test/xref2/lib/common.cppo.ml index 422a2979e6..3b7c40ac9c 100644 --- a/test/xref2/lib/common.cppo.ml +++ b/test/xref2/lib/common.cppo.ml @@ -34,8 +34,8 @@ let cmt_of_string s = let p = Parse.implementation l in Typemod.type_implementation "" "" "" env p -let parent = `RootPage (Odoc_model.Names.PageName.of_string "None") -let id = `Root (parent, Odoc_model.Names.ModuleName.of_string "Root") +let parent = `RootPage (Odoc_model.Names.PageName.make_std "None") +let id = `Root (parent, Odoc_model.Names.ModuleName.make_std "Root") let root_of_compilation_unit ~package ~hidden ~module_name ~digest = ignore(package); @@ -57,7 +57,7 @@ let root = let root_identifier = `Identifier id -let root_module name = `Module (id, Odoc_model.Names.ModuleName.of_string name) +let root_module name = `Module (id, Odoc_model.Names.ModuleName.make_std name) let root_pp fmt (_ : Odoc_model.Root.t) = Format.fprintf fmt "Common.root"